clips-6.24/0000755000175000017500000000000010604005703010700 5ustar jfsjfsclips-6.24/clips.hlp0000644000175000017500000026071310444352036012536 0ustar jfsjfs 0MBEGIN-ENTRY-MAIN HELP_USAGE FUNCTION_SUMMARY RELEASE_NOTES COMMAND_SUMMARY CONSTRUCT_SUMMARY INTEGRATED_EDITOR END-ENTRY 1IBEGIN-ENTRY-HELP_USAGE HELP_USAGE H.2 Using the Help Facility The help facility displays menus of topics and prompts the user for a choice. It then references the help file for that information. The help facility can be called with or without a command-line topic. Syntax: (help []) where is the full path leading to a topic in the help tree. For example, for information on defrule syntax, the user would type: (help construct_summary defrule). The help function has no return value. Each element or field in the path is delimited by white space, and the help facility is not case sensitive. In addition, the entire name of a field does not need to be specified. Only enough characters to distinguish the field from other choices in the menu are necessary (if there is a conflict, the help facility will pick the first one in the list). For instance, (help con def) would be sufficient for the above example. A few special fields can be used while in the help facility. ^ Branch up one level. ? When specified at the end of a path, this forces a display of the current menu, even on branch-ups. Giving no topic field will branch up one level. A branch-up from the MAIN topic root node implies an exit from help. By default, the help facility comes up in the MAIN topic root menu and the user may make a choice as described above. The prompt line always displays the name of the current menu. The help facility will branch through the help- tree until instructed to exit by a branch-up from the top level. The level always is reset to the MAIN topic upon exit from the help facility. The first call to the help facility will take longer than successive calls while the system loads help information into an internal lookup table. All other calls to the help facility are very fast. The help facility reads help information from a file during execution. Users may wish to change the location of the help file to meet the configuration of their system. The help-path function was provided to allow this. Syntax: (help-path []) If no argument is specified, the function displays the name of the current help file. If an argument is specified, the help facility will use the new file name for future help references during this CLIPS session. To change the location of the help file permanently, a change must be made in the setup.h file, then CLIPS must be recompiled. The help-path function has no return value. END-ENTRY 1MBEGIN-ENTRY-RELEASE_NOTES RELEASE_NOTES The release notes help section contains information about new features and where to get technical support. Subtopics: NEW_FEATURES SUPPORT_INFORMATION V6.24 V6.23 V6.22 V6.21 END-ENTRY 2IBEGIN-ENTRY-NEW_FEATURES RELEASE_NOTES NEW_FEATURES Version 6.2 of CLIPS contains two major enhancements. First, CLIPS now provides a mechanism which allows an embedded application to create multiple environments into which programs can be loaded. Second, an improved Windows 2000/XP CLIPS interface is now available and the Macintosh CLIPS interface has been enhanced to support MacOS X. For a detailed listing of differences between the 6.x releases of CLIPS, refer to appendix B of the Basic Programming Guide and appendix C of the Advanced Programming Guide. END-ENTRY 2IBEGIN-ENTRY-V6.21 RELEASE_NOTES V6.21 * Bug Fixes - The following bugs were fixed by the 6.21 release: * The C GetDefglobalValue macro did not have the correct number of arguments. * The C RtnArgCount macro did not have the correct number of arguments. * Erroneous error generated for object pattern under some circumstances. * The C Save macro did not have the correct number of arguments. * The C Eval and Build functions did not have the correct number of arguments. * The progn$ index variable did not always return the correct value. * The member$ function did not always return the correct value. * C++ style comments in the code caused errors when using strict ANSI C compilation. * The C LoadFactsFromString function did not have the correct number of arguments. * Prior bug fix to the PutFactSlot C function prevented memory associated with the fact to be garbage collected after the fact had been retracted. The original bug is now fixed through a new API which allows embedded programs to temporarily disable garbage collection. See section 1.4 of The Advanced Programming Guide for more details. END-ENTRY 2IBEGIN-ENTRY-V6.22 RELEASE_NOTES V6.22 * Bug Fixes - The following bugs were fixed by the 6.22 release: * Numerous fixes for functions and macros that did not accept the correct number of arguments as specified in the Advanced Programming Guide. The following functions and macros were corrected: Agenda, BatchStar, EnvGetActivationSalience, EnvBatchStar, EnvFactDeftemplate, EnvFactExistp, EnvFactList, EnvFactSlotNames, EnvGetNextInstanceInClassAndSubclasses, EnvLoadInstancesFromString, EnvRestoreInstancesFromString, EnvSetOutOfMemoryFunction, FactDeftemplate, FactExistp, FactList, FactSlotNames, GetNextInstanceInClassAndSubclasses, LoadInstancesFromString, RestoreInstancesFromString, and SetOutOfMemoryFunction. END-ENTRY 2IBEGIN-ENTRY-V6.23 RELEASE_NOTES V6.23 * Fact-Set Query Functions - Six new functions similar to the instance set query functions have been added for determining and performing actions on sets of facts that satisfy user-defined queries (see section 12.9.12 of the Basic Programming Guide): any-factp, find-fact, find-all-facts, do-for-fact, do-for-all-facts, and delayed-do-for-all-facts. The GetNextFactInTemplate function (see section 4.4.17 of the Advanced Programming Guide) allows iteration from C over the facts belonging to a specific deftemplate. * Bug Fixes - The following bugs were fixed by the 6.23 release: * Passing the wrong number of arguments to a deffunction through the funcall function could cause unpredictable behavior including memory corruption. * A large file name (at least 60 characters) passed into the fetch command causes a buffer overrun. * A large file name (at least 60 characters) passed into the constructs-to-c command causes a buffer overrun. * A large defclass or defgeneric name (at least 500 characters) causes a buffer overrun when the profile-info command is called. * A large module or construct name (at least 500 characters) causes a buffer overrun when the get--list command is called. * The FalseSymbol and TrueSymbol constants were not defined as described in the Advanced Programming Guide. These constants have have now been defined as macros so that their corresponding environment companion functions (EnvFalseSymbol and EnvTrueSymbol) could be defined. See the Advanced Programming Guide for more details. * The slot-writablep function returns TRUE for slots having initialize-only access. * Files created by the constructs-to-c function for use in a run-time program generate compilation errors. * Command and Function Changes - The following commands and functions have been enhanced: * funcall (see section 12.7.10 of the Basic Programming Guide). Multifield arguments are no longer expanded into multiple arguments before being passed to the target function of the funcall. The expand$ function can be placed around an argument to revert to the old behavior. * Compiler Support - The following compilers are now supported. See the Interfaces Guide for more details. * Metrowerks CodeWarrior 9.4 for Mac OS X and Windows. * Xcode 1.2 for Mac OS X. END-ENTRY 2IBEGIN-ENTRY-V6.24 RELEASE_NOTES V6.24 * Allowed Classes Constraint Attribute - The allowed-classes constraint attribute allows a slot containing an instance value to be restricted to the specified list of classes (see section 11.2 of the Basic Programming Guide). * New Functions and Commands - Several new functions and commands have been added. They are: * deftemplate-slot-allowed-values (see section 12.8.2 of the BPG) * deftemplate-slot-cardinality (see section 12.8.3 of the BPG) * deftemplate-slot-defaultp (see section 12.8.4 of the BPG) * deftemplate-slot-default-value (see section 12.8.5 of the BPG) * deftemplate-slot-existp (see section 12.8.6 of the BPG) * deftemplate-slot-multip (see section 12.8.7 of the BPG) * deftemplate-slot-names (see section 12.8.8 of the BPG) * deftemplate-slot-range (see section 12.8.9 of the BPG) * deftemplate-slot-singlep (see section 12.8.10 of the BPG) * deftemplate-slot-type (see section 12.8.11 of the BPG) * get-char (see section 12.4.2.9 of the BPG) * get-region (see section 13.15.2.3 of the BPG) * ppfact (see section 13.4.6 of the BPG) * read-number (see section 12.4.2.10 of the BPG) * set-locale (see section 12.4.2.11 of the BPG) * slot-allowed-classes (see section 12.16.1.27 of the BPG) * Command and Function Changes The following commands and functions have been enhanced: * format (see section 12.4.2.6 of the Basic Programming Guide). The formatting of printed numbers can be changed to use a native locale with the set-locale function. The documentation has been updated to include the effect of the precision argument on the d, g, o, and x format flags. * Behavior Changes - The following changes have been made to behavior: * The message displayed when a construct is redefined and compilations are being watched is now more prominent. * Bug Fixes - The following bugs were fixed by the 6.24 release: * The DescribeClass macros were incorrectly defined. * The sort function leaks memory when called with a multifield value of length zero. * Link error occurred for the SlotExistError function when OBJECT_SYSTEM is set to 0 in setup.h. * An error when calling the Eval function causes a subsequent call to DeallocateEnvironmentData to fail. * Loading a binary instance file from a run-time program caused a bus error. * Incorrect activations could occur with the exists CE. * Compilation errors occurred when compiling CLIPS source as C++ files. * The AssignFactSlotDefaults function did not correctly handle defaults for multifield slots. * The slot-default-value function crashed when no default existed for a slot (the ?NONE value was specified). * CLIPS crashed on AMD64 processor in the function used to generate hash values for integers. * A syntax error was not generated for the last deffunction or defmethod in a file if it was missing the final closing right parenthesis. * Compiler Support - The following compilers are now supported. See the Interfaces Guide for more details. * Metrowerks CodeWarrior 9.6 for Mac OS X. * Xcode 2.3 for Mac OS X. * Microsoft Visual C++ .NET 2003 for Windows. END-ENTRY 2IBEGIN-ENTRY-SUPPORT_INFORMATION RELEASE_NOTES SUPPORT_INFORMATION CLIPS executables, documentation, and source code are available for download from http://www.ghg.net/clips/download/. Questions regarding CLIPS can be sent via electronic mail to clipsYYYY@ghg.net where YYYY is the current year (for example, 2004). Include the words 'CLIPS USER' in the subject line. An electronic conferencing facility, sponsored by Distributed Computing Systems (http://www.discomsys.com), is also available to CLIPS users. Subscribers to this facility may send questions, observations, answers, editorials, etc., in the form of electronic mail to the conference. All subscribers will have a copy of these messages reflected back to them at their respective electronic mail addresses. To subscribe, send a single line message to clips-request@discomsys.com containing the word "subscribe". The subject field is ignored but the address found in the Reply:, Reply to:, or From: field will be entered in the distribution list. Upon subscription you will receive a mail message instructing you how to participate in the conference from that point forward. Save this mail message. You may need the instructions later if you wish to unsubscribe from the list server. To send your own messages to members of the conference you need simply address your mail to clips@discomsys.com. Your message will be reflected to all other members of the conference. If you wish to remove yourself from the conference and discontinue receiving mail simply send a message to clips-request@discomsys.com with "unsubscribe" as the message text. If you want to unsubscribe using another email account than the one you subscribed with, then append the original subscribing email account to the text of the message. For example: "unsubscribe john.doe@account.net". Do not send unsubscribe messages to clips@discomsys.com! This sends a mail message to every member of the list. If you need to get in contact with the list administrator (for trouble unsubscribing or other questions about the list), send email to clips-owner@discomsys.com. A CLIPS World Wide Web page can be accessed using the URL http://www.ghg.net/clips/CLIPS.html. Usenet users can also find information and post questions about CLIPS to the comp.ai.shells news group. The CLIPS Developers' Forum, a thread-based message board, is available at http://www.cpbinc.com/clips. This board exists to provide a site for discussion of research, development, and implementation of the CLIPS expert systems and related technologies. The hosting services for this web page are provided by CPB, Inc. Questions pertaining to this forum can be sent to clips@cpbinc.com. END-ENTRY 1MBEGIN-ENTRY-CONSTRUCT_SUMMARY CONSTRUCT_SUMMARY This section gives a general overview of the available CLIPS constructs. Subtopics: DEFRULE DEFCLASS DEFFACTS DEFINSTANCES DEFTEMPLATE DEFMESSAGE-HANDLER DEFGLOBAL DEFMODULE DEFFUNCTION CONSTRAINT_ATTRIBUTES DEFGENERIC/DEFMETHOD END-ENTRY 2IBEGIN-ENTRY-DEFRULE CONSTRUCT_SUMMARY DEFRULE One of the primary methods of representing knowledge in CLIPS is a rule. A rule is a collection of conditions and the actions to be taken if the conditions are met. The developer of an expert system defines the rules which describe how to solve a problem. Rules execute (or fire) based on the existence or non-existence of facts. CLIPS provides the mechanism (the inference engine) which attempts to match the rules to the current state of the system (as represented by the fact-list) and applies the actions. (defrule [] [] * => *) DECLARATIONS ------------------------------------------------------------------ ::= (declare +) ::= (salience ) | (auto-focus ) CONDITIONAL ELEMENTS ------------------------------------------------------------------ ::= | | | | | | | | ::= (test ) ::= (not ) ::= (and +) ::= (or +) ::= (exists +) ::= (forall +) ::= (logical +) PATTERN CONDITIONAL ELEMENT ------------------------------------------------------------------ ::= ? <- ::= | | ::= ( *) ::= (*) ::= (object *) ::= (is-a ) | (name ) | ( *) ::= | ::= | ::= ( ) ::= ( *) PATTERN CONSTRAINTS ------------------------------------------------------------------ ::= ? | $? | ::= | & | | ::= | ~ ::= | | | : | = END-ENTRY 2IBEGIN-ENTRY-DEFFACTS CONSTRUCT_SUMMARY DEFFACTS With the deffacts construct, a list of facts can be defined which are automatically asserted whenever the reset command is performed. Facts asserted through deffacts may be retracted or pattern matched like any other fact. The initial fact-list, including any defined deffacts, is always reconstructed after a reset command. The syntax of the deffacts construct is: (deffacts [] *) END-ENTRY 2IBEGIN-ENTRY-DEFTEMPLATE CONSTRUCT_SUMMARY DEFTEMPLATE Ordered facts encode information positionally. To access that information, a user must know not only what data is stored in a fact but which field contains the data. Non-ordered (or deftemplate) facts provide the user with the ability to abstract the structure of a fact by assigning names to each field found within the fact. The deftemplate construct is used to create a template which can then be used by non-ordered facts to access fields of the fact by name. The deftemplate construct is analogous to a record or structure definition in programming languages such as Pascal and C. The syntax of the deftemplate construct is: (deftemplate [] *) ::= | ::= (slot *) ::= (multislot *) ::= | ::= (default ?DERIVE | ?NONE | *) | (default-dynamic *) END-ENTRY 2IBEGIN-ENTRY-DEFGLOBAL CONSTRUCT_SUMMARY DEFGLOBAL With the defglobal construct, global variables can be defined, set, and accessed within the CLIPS environment. Global variables can be accessed as part of the pattern matching process, but changing them does not invoke the pattern matching process. The bind function is used to set the value of global variables. The syntax of the defglobal construct is: ::= (defglobal [] *) ::= = ::= ?** END-ENTRY 2IBEGIN-ENTRY-DEFFUNCTION CONSTRUCT_SUMMARY DEFFUNCTION With the deffunction construct, new functions may be defined directly in CLIPS. Deffunctions are equivalent in use to other functions in CLIPS. The only differences between user-defined external functions and deffunctions are that deffunctions are written in CLIPS and executed by CLIPS interpretively and user-defined external functions are written in an external language, such as C, and executed by CLIPS directly. Also, deffunctions allow the addition of new functions without having to recompile and relink CLIPS. The syntax of the deffunction construct is: (deffunction [] (* []) *) ::= ::= END-ENTRY 2IBEGIN-ENTRY-DEFGENERIC/DEFMETHOD CONSTRUCT_SUMMARY DEFGENERIC/DEFMETHOD With the defgeneric/defmethod constructs, new generic functions may be written directly in CLIPS. Generic functions are similar to deffunctions because they can be used to define new procedural code directly in CLIPS, and they can be called like any other function. However, generic functions are much more powerful because they can do different things depending on the types (or classes) and number of their arguments. For example, a '+' operator could be defined which performs concatenation for strings but still performs arithmetic addition for numbers. Generic functions are comprised of multiple components called methods, where each method handles different cases of arguments for the generic function. A generic function which has more than one method is said to be overloaded. A generic function is comprised of a header (similar to a forward declaration) and zero or more methods. A generic function header can either be explicitly declared by the user or implicitly declared by the definition of at least one method. The defgeneric construct is used to specify the generic function header, and the defmethod construct is used for each of the generic function's methods. The syntax of the defgeneric/defmethod constructs is: (defgeneric []) (defmethod [] [] (* []) *) ::= | ( * []) ::= ::= ::= | END-ENTRY 2IBEGIN-ENTRY-DEFCLASS CONSTRUCT_SUMMARY DEFCLASS A defclass is a construct for specifying the properties (slots) of a class of objects. A defclass consists of four elements: 1) a name, 2) a list of superclasses from which the new class inherits slots and message-handlers, 3) a specifier saying whether or not the creation of direct instances of the new class is allowed and 4) a list of slots specific to the new class. All user-defined classes must inherit from at least one class, and to this end COOL provides predefined system classes for use as a base in the derivation of new classes. Any slots explicitly given in the defclass override those gotten from inheritance. COOL applies rules to the list of superclasses to generate a class precedence list for the new class. Facets further describe slots. Some examples of facets include: default value, cardinality, and types of access allowed. The syntax of the defclass construct is: (defclass [] (is-a +) [] [] * *) ::= (role concrete | abstract) ::= (pattern-match reactive | non-reactive) ::= (slot *) | (single-slot *) | (multislot *) ::= | | | | | | | | ::= (default ?DERIVE | ?NONE | *) | (default-dynamic *) ::= (storage local | shared) ::= (access read-write | read-only | initialize-only) ::= (propagation inherit | no-inherit) ::= (source exclusive | composite) ::= (pattern-match reactive | non-reactive) ::= (visibility private | public) ::= (create-accessor ?NONE | read | write | read-write) ::= (override-message ?DEFAULT | ) ::= (message-handler []) ::= primary | around | before | after END-ENTRY 2IBEGIN-ENTRY-DEFINSTANCES CONSTRUCT_SUMMARY DEFINSTANCES Similar to deffacts, the definstances construct allows the specification of instances which will be created every time the reset command is executed. On every reset all current instances receive a delete message, and the equivalent of a make-instance function call is made for every instance specified in definstances constructs. The syntax of the definstances construct is: ::= (definstances [] *) ::= () ::= of * ::= ( *) END-ENTRY 2IBEGIN-ENTRY-DEFMESSAGE-HANDLER CONSTRUCT_SUMMARY DEFMESSAGE-HANDLER Objects are manipulated by sending them messages via the function send. The result of a message is a useful return-value or side-effect. A defmessage-handler is a construct for specifying the behavior of a class of objects in response to a particular message. The implementation of a message is made up of pieces of procedural code called message-handlers (or handlers for short). Each class in the class precedence list of an object's class can have handlers for a message. In this way, the object's class and all its superclasses share the labor of handling the message. Each class's handlers handle the part of the message which is appropriate to that class. Within a class, the handlers for a particular message can be further subdivided into four types or categories: primary, before, after and around. A defmessage-handler is comprised of seven elements: 1) a class name to which to attach the handler (the class must have been previously defined), 2) a message name to which the handler will respond, 3) an optional type (the default is primary), 4) an optional comment, 5) a list of parameters that will be passed to the handler during execution, 6) an optional wildcard parameter and 7) a series of expressions which are executed in order when the handler is called. The return-value of a message-handler is the evaluation of the last expression in the body. The syntax of the defmessage-handler construct is: (defmessage-handler [] [] (* []) *) ::= around | before | primary | after ::= ::= END-ENTRY 2IBEGIN-ENTRY-DEFMODULE CONSTRUCT_SUMMARY DEFMODULE CLIPS provides support for the modular development and execution of knowledge bases with the defmodule construct. CLIPS modules allow a set of constructs to be grouped together such that explicit control can be maintained over restricting the access of the constructs by other modules. This type of control is similar to global and local scoping used in languages such as C or Ada. By restricting access to deftemplate and defclass constructs, modules can function as blackboards, permitting only certain facts and instances to be seen by other modules. Modules are also used by rules to provide execution control. The syntax of the defmodule construct is: ::= (defmodule [] *) ::= (export ) | (import ) ::= ?ALL | ?NONE | ?ALL | ?NONE | + ::= deftemplate | defclass | defglobal | deffunction | defgeneric END-ENTRY 2IBEGIN-ENTRY-CONSTRAINT_ATTRIBUTES CONSTRUCT_SUMMARY CONSTRAINT_ATTRIBUTES Constraint attributes can be associated with deftemplate and defclass slots so that type checking can be performed on slot values when template facts and instances are created. The constraint information is also analyzed for the patterns on the LHS of a rule to determine if the specified constraints prevent the rule from ever firing. The syntax for constraint attributes is: ::= | | | ::= (type ) ::= + | ?VARIABLE ::= SYMBOL | STRING | LEXEME | INTEGER | FLOAT | NUMBER | INSTANCE-NAME | INSTANCE-ADDRESS | INSTANCE | EXTERNAL-ADDRESS | FACT-ADDRESS ::= (allowed-symbols) | (allowed-strings ) | (allowed-lexemes | (allowed-integers) | (allowed-floats) | (allowed-numbers) | (allowed-instance-names ) | (allowed-values) | ::= + | ?VARIABLE ::= + | ?VARIABLE ::= + | ?VARIABLE ::= + | ?VARIABLE ::= + | ?VARIABLE ::= + | ?VARIABLE ::= + | ?VARIABLE ::= + | ?VARIABLE ::= (range ) ::= | ?VARIABLE ::= (cardinality ) ::= | ?VARIABLE END-ENTRY 1MBEGIN-ENTRY-FUNCTION_SUMMARY FUNCTION_SUMMARY This section gives a general overview of the available CLIPS functions. Subtopics: PREDICATE_FUNCTIONS DEFRULE_FUNCTIONS MULTIFIELD_FUNCTIONS AGENDA_FUNCTIONS STRING_FUNCTIONS DEFGLOBAL_FUNCTIONS IO_FUNCTIONS DEFFUNCTION_FUNCTIONS MATH_FUNCTIONS GENERIC_FUNCTION_FUNCTIONS PROCEDURAL_FUNCTIONS COOL_FUNCTIONS MISCELLANEOUS_FUNCTIONS DEFMODULE_FUNCTIONS DEFTEMPLATE_FUNCTIONS SEQUENCE_EXPANSION_FUNCTIONS FACT_FUNCTIONS END-ENTRY 2IBEGIN-ENTRY-PREDICATE_FUNCTIONS FUNCTION_SUMMARY PREDICATE_FUNCTIONS The following functions perform predicate tests and return either TRUE or FALSE. NUMBERP: Returns TRUE for integers and floats. (numberp ) FLOATP: Returns TRUE for floats. (floatp ) INTEGERP: Returns TRUE for integers. (integerp ) LEXEMEP: Returns TRUE for symbols and strings. (numberp ) STRINGP: Returns TRUE for strings. (stringp ) SYMBOLP: Returns TRUE for symbols. (symbolp ) EVENP: Returns TRUE for even numbers. (evenp ) ODDP: Returns TRUE for odd numbers. (oddp ) MULTIFIELDP: Returns TRUE for multifield values. (multifieldp ) POINTERP: Returns TRUE for external addresses. (pointerp ) EQ: Returns TRUE if the 1st argument is equal in type and value to all subsequent arguments. (eq +) NEQ: Returns TRUE if the 1st argument is not equal in type and value to all subsequent arguments. (neq +) =: Returns TRUE if the 1st argument is equal in value to all subsequent arguments. (= +) <>: Returns TRUE if the 1st argument is not equal in value to all subsequent arguments. (<> +) >: Returns TRUE if each argument is greater in value than the argument following it. (> +) >=: Returns TRUE if each argument is greater than or equal to in value than the argument following it. (>= +) <: Returns TRUE if each argument is less in value than the argument following it. (> +) <=: Returns TRUE if each argument is less than or equal to in value than the argument following it. (<= +) AND: Returns TRUE if all arguments evaluate to a non-FALSE value. (and +) OR: Returns TRUE if any argument evaluates to a non-FALSE value. (or +) NOT: Returns TRUE if its only argument evaluates to FALSE. (not ) END-ENTRY 2IBEGIN-ENTRY-MULTIFIELD_FUNCTIONS FUNCTION_SUMMARY MULTIFIELD_FUNCTIONS The following functions operate on multifield values. CREATE$: Appends its arguments together to create a multifield value. (create$ *) NTH$: Returns the specified field of a multifield value. (nth$ ) MEMBER$: Returns the position of a single-field value within a multifield value. (member$ ) SUBSETP: Returns TRUE if the first argument is a subset of the second argument. (subsetp ) DELETE$: Deletes the specified range from a multifield value. (delete$ ) EXPLODE$: Creates a multifield value from a string. (explode$ ) IMPLODE$: Creates a string from a multifield value. (implode$ ) SUBSEQ$: Extracts the specified range from a multifield value. (subseq$ ) REPLACE$: Replaces the specified range of a multifield value with a set of values. (replace$ +) INSERT$: Inserts one or more values in a multifield. (insert$ +) FIRST$: Returns the first field of a multifield. (first$ ) REST$: Returns all but the first field of a multifield. (rest$ ) LENGTH$: Returns the number of fields in a multifield value. (length$ ) DELETE-MEMBER$: Deletes specific values contained within a multifield value and returns the modified multifield value. (delete-member$ +) REPLACE-MEMBER$: Replaces specific values contained within a multifield value and returns the modified multifield value. (replace-member$ +) END-ENTRY 2IBEGIN-ENTRY-STRING_FUNCTIONS FUNCTION_SUMMARY STRING_FUNCTIONS The following functions perform operations that are related to strings. STR-CAT: Concatenates its arguments to form a single string. (str-cat *) SYM-CAT: Concatenates its arguments to form a single symbol. (sym-cat *) SUB-STRING: Retrieves a subportion from a string. (sub-string ) STR-INDEX: Returns the position of the first argument within the second argument. (str-index ) EVAL: Evaluates a string as though it were entered at the command prompt. Only allows functions to be evaluated. (eval ) BUILD: Evaluates a string as though it were entered at the command prompt. Only allows constructs to be evaluated. (build ) UPCASE: Converts lowercase characters in a string or symbol to uppercase. (upcase ) LOWCASE: Converts uppercase characters in a string or symbol to lowercase. (lowcase ) STR-COMPARE: Lexigraphically compares two strings. (str-compare ) STR-LENGTH: Returns the length of a string. (str-length ) CHECK-SYNTAX: Allows the text representation of a construct or function call to be checked for syntax and semantic errors. (check-syntax ) STRING-TO-FIELD: Parses a string and converts its contents to a primitive data type. (string-to-field ) END-ENTRY 2IBEGIN-ENTRY-IO_FUNCTIONS FUNCTION_SUMMARY IO_FUNCTIONS The following functions perform I/O operations. OPEN: Opens a file. (open []) ::= "r" | "w" | "r+" | "a" | "wb" CLOSE: Closes a file. (close []) PRINTOUT: Sends unformated output to the specified logical name. (printout *) READ: Reads a single-field value from the specified logical name. (read []) READLINE: Reads an entire line as a string from the specified logical name. (readline []) FORMAT: Sends formated output to the specified logical name. (format *) RENAME: Changes the name of a file. (rename ) REMOVE: Deletes a file. (remove ) GET-CHAR: Allows a single character to be retrieved from a logical name. (get-char []) READ-NUMBER: Allows a user to input a single number using the localized format. (read-number []) SET-LOCALE: Allows a locale to be specified for the numeric format behavior of the format and read-number functions. (set-locale []) END-ENTRY 2MBEGIN-ENTRY-MATH_FUNCTIONS FUNCTION_SUMMARY MATH_FUNCTIONS The math functions have been divided into three broad categories. The basic math functions are always provided with CLIPS. The trigonometric and extended math functions are included as part of the extended math package. Subtopics: BASIC_MATH_FUNCTIONS EXTENDED_MATH_FUNCTIONS TRIGONOMETRIC_FUNCTIONS END-ENTRY 3IBEGIN-ENTRY-BASIC_MATH_FUNCTIONS FUNCTION_SUMMARY MATH_FUNCTIONS BASIC_MATH_FUNCTIONS The following functions perform basic mathematical operations. +: Returns the sum of its arguments. (+ +) -: Returns the first argument minus all subsequent arguments. (- +) *: Returns the product of its arguments. (* +) /: Returns the first argument divided by all subsequent arguments. (/ +) DIV: Returns the first argument divided by all subsequent arguments using integer division. (div +) MAX: Returns the value of its largest numeric argument. (max +) MIN: Returns the value of its smallest numeric argument. (min +) ABS: Returns the absolute value of its only argument. (abs ) FLOAT: Converts its only argument to a float. (float ) INTEGER: Converts its only argument to an integer. (integer ) END-ENTRY 3IBEGIN-ENTRY-TRIGONOMETRIC_FUNCTIONS FUNCTION_SUMMARY MATH_FUNCTIONS TRIGONOMETRIC_FUNCTIONS The following trigonometric functions take one numeric argument and return a float. The argument is expected to be in radians. These functions are part of the extended math package. FUNCTION RETURNS ---------------------------------------- acos arccosine acosh hyperbolic arccosine acot arccotangent acoth hyperbolic arccotangent acsc arccosecant acsch hyperbolic arccosecant asec arcsecant asech hyperbolic arcsecant asin arcsine asinh hyperbolic arcsine atan arctangent atanh hyperbolic arctangent cos cosine cosh hyperbolic cosine cot cotangent coth hyperbolic tangent csc cosecant csch hyperbolic cosecant sec secant sech hyperbolic secant sin sine sinh hyperbolic sine tan tangent tanh hyperbolic tangent END-ENTRY 3IBEGIN-ENTRY-EXTENDED_MATH_FUNCTIONS FUNCTION_SUMMARY MATH_FUNCTIONS EXTENDED_MATH_FUNCTIONS The following functions perform extended mathematical operations and are included as part of the extended math package. DEG-GRAD: Converts its only argument from degrees to gradients. (deg-grad ) DEG-RAD: Converts its only argument from degrees to radians. (deg-rad ) GRAD-DEG: Converts its only argument from gradients to degrees. (grad-deg ) RAD-DEG: Converts its only argument from radians to degrees. (rad-deg ) PI: Returns the value of pi. (pi) SQRT: Returns the square root of its only argument. (sqrt ) **: Raises its first argument to the power of its second argument. (** ) EXP: Raises the value e to the power of its only argument. (exp ) LOG: Returns the logarithm base e of its only argument. (log ) LOG10: Returns the logarithm base 10 of its only argument. (log10 ) ROUND: Rounds its argument toward the closest integer or negative infinity if exactly between two integers. (round ) MOD: Returns the remainder of the result of dividing its first argument by its second argument (assuming that the result of division must be an integer). (mod ) END-ENTRY 2IBEGIN-ENTRY-PROCEDURAL_FUNCTIONS FUNCTION_SUMMARY PROCEDURAL_FUNCTIONS The following are functions which provide procedural programming capabilities as found in languages such as Pascal, C, and Ada. BIND: Binds a variable to a new value. (bind *) IF: Allows conditional execution of a group of actions. (if then * [else *]) WHILE: Allows conditional looping. (while [do] *) LOOP-FOR-COUNT: Allows simple iterative looping. (loop-for-count [do] *) ::= | ( [ ]) ::= ::= PROGN: Evaluates all arguments and returns the value of the last argument evaluated. (progn *) PROGN$: Performs a set of actions for each field of a multifield value. (progn$ *) ::= | ( ) RETURN: Immediately terminates the currently executing deffunction, generic function method, message-handler, defrule RHS, or certain instance set query functions and if a value is specified, returns this value as the result of the executing construct. (return []) BREAK: Immediately terminates the currently iterating while loop, progn execution, or certain instance set query functions. (break) SWITCH: Allows a particular group of actions to be performed based on a specified value. (switch * []) ::= (case then *) ::= (default *) END-ENTRY 2IBEGIN-ENTRY-MISCELLANEOUS_FUNCTIONS FUNCTION_SUMMARY MISCELLANEOUS_FUNCTIONS The following are additional functions for use within CLIPS. GENSYM: Returns a special sequenced symbol. (gensym) GENSYM*: Returns a special unique sequenced symbol. (gensym*) SETGEN: Sets the starting number used by gensym and gensym*. (setgen ) RANDOM: Returns a "random" integer value. (random [ ]) SEED: Seeds the random number generator used by random. (seed ) TIME: Returns a float representing the elapsed seconds since the system reference time. (time) LENGTH: Returns an integer for the number of fields in a multifield value or the length in characters of a string or symbol. (length ) GET-FUNCTION_RESTRICTIONS: Returns the restriction string associated with a CLIPS or user defined function. (get-function-restrictions ) SORT: Allows a list of values to be sorted based on a user specified comparison function. (sort *) FUNCALL: Constructs a function call from its arguments and then evaluates the function call. (funcall (function-name> *) TIMER: Returns the number of seconds elapsed evaluating a series of expressions. (timer *) END-ENTRY 2IBEGIN-ENTRY-DEFTEMPLATE_FUNCTIONS The following functions provide ancillary capabilities for the deftemplate construct. DEFTEMPLATE-MODULE: Returns the module in which the specified deftemplate is defined. (deftemplate-module ) DEFTEMPLATE-SLOT-ALLOWED-VALUES: Returns a multifield containing the allowed values for a deftemplate slot. (deftemplate-slot-allowed-values ) DEFTEMPLATE-SLOT-CARDINALITY: Returns a multifield containing the minimum and maximum cardinality allowed for a multifield slot. (deftemplate-slot-cardinality ) DEFTEMPLATE-SLOT-DEFAULTP: Returns either static, dynamic, or FALSE to indicate whether the deftemplate slot has a default. (deftemplate-slot-defaultp ) DEFTEMPLATE-SLOT-DEFAULT-VALUE: Returns the default value for the deftemplate slot. (deftemplate-slot-default-value ) DEFTEMPLATE-SLOT-EXISTP: Returns TRUE if the specified deftemplate slot exists, otherwise FALSE. (deftemplate-slot-existp ) DEFTEMPLATE-SLOT-MULTIP: Returns TRUE if the specified deftemplate slot is a multifield slot, otherwise FALSE. (deftemplate-slot-multip ) DEFTEMPLATE-SLOT-NAMES: Returns the slot names associated with the deftemplate in a multifield value. (deftemplate-slot-names ) DEFTEMPLATE-SLOT-RANGE: Returns a multifield containing the minimum and maximum numeric range allowed for a slot. (deftemplate-slot-range ) DEFTEMPLATE-SLOT-SINGLEP: Returns TRUE if the specified deftemplate slot is a single-field slot, otherwise FALSE. (deftemplate-slot-singlep ) DEFTEMPLATE-SLOT-TYPES: Returns a multifield containing the primitive types allowed for a slot. (deftemplate-slot-types ) GET-DEFTEMPLATE-LIST: Returns the list of all deftemplates in the specified module (or the current module if unspecified). (get-deftemplate-list []) END-ENTRY 2IBEGIN-ENTRY-FACT_FUNCTIONS The following actions are used for assert, retracting, and modifying facts. ASSERT: Adds a fact to the fact-list. (assert +) RETRACT: Removes a fact from the fact-list. (retract + | *) ::= | MODIFY: Modifies a deftemplate fact in the fact-list. (modify *) DUPLICATE: Duplicates a deftemplate fact in the fact-list. (duplicate *) ASSERT-STRING: Converts a string into a fact and asserts it. (assert-string ) FACT-INDEX: Returns the fact index of a fact address. (fact-index ) FACT-EXISTP: Returns TRUE if the fact specified by its fact-index or fact-address arguments exists, otherwise FALSE. (fact-existp ) FACT-RELATION: Returns the deftemplate (relation) name associated with the fact. (fact-relation ) FACT-SLOT-NAMES: Returns the slot names associated with the fact. (fact-slot-names ) FACT-SLOT-VALUE: Returns the value of the specified slot from the specified fact. (fact-slot-value ) GET-FACT-LIST: Returns a multifield containing the list of visible facts. (get-fact-list []) END-ENTRY 2IBEGIN-ENTRY-DEFFACTS_FUNCTIONS The following functions provide ancillary capabilities for the deffacts construct. GET-DEFFACTS-LIST: Returns the list of all deffacts in the specified module (or the current module if unspecified). (get-deffacts-list []) DEFFACTS-MODULE: Returns the module in which the specified deffacts is defined. (deffacts-module ) END-ENTRY 2IBEGIN-ENTRY-DEFRULE_FUNCTIONS The following functions provide ancillary capabilities for the defrule construct. GET-DEFRULE-LIST: Returns the list of all defrules in the specified module (or the current module if unspecified). (get-defrule-list []) DEFRULE-MODULE: Returns the module in which the specified defrule is defined. (defrule-module ) END-ENTRY 2IBEGIN-ENTRY-AGENDA_FUNCTIONS The following functions provide ancillary capabilities for manipulating the agenda. GET-FOCUS: Returns the module name of the current focus. (get-focus) GET-FOCUS-STACK: Returns all of the module names in the focus stack as a multifield value. (get-focus-stack) POP-FOCUS: Removes the current focus from the focus stack and returns the module name of the current focus. (pop-focus) END-ENTRY 2IBEGIN-ENTRY-DEFGLOBAL_FUNCTIONS The following functions provide ancillary capabilities for the defglobal construct. GET-DEFGLOBAL-LIST: Returns the list of all defglobals in the specified module (or the current module if unspecified). (get-defglobal-list []) DEFGLOBAL-MODULE: Returns the module in which the specified defglobal is defined. (defglobal-module ) END-ENTRY 2IBEGIN-ENTRY-DEFFUNCTION_FUNCTIONS The following functions provide ancillary capabilities for the deffunction construct. GET-DEFFUNCTION-LIST: Returns the list of all deffunctions in the specified module (or the current module if unspecified). (get-deffunction-list []) DEFFUNCTION-MODULE: Returns the module in which the specified deffunction is defined. (deffunction-module ) END-ENTRY 2IBEGIN-ENTRY-GENERIC_FUNCTION_FUNCTIONS FUNCTION_SUMMARY GENERIC_FUNCTION_FUNCTIONS The following functions provide ancillary capabilities for generic function methods. GET-DEFGENERIC-LIST: Returns the list of all defgenerics in the specified module (or the current module if unspecified). (get-defgeneric-list []) DEFGENERIC-MODULE: Returns the module in which the specified defgeneric is defined. (defgeneric-module ) GET-DEFMETHOD-LIST: Returns the list of all defmethods in the current module (or just the methods associated with the specified defgeneric). (get-defmethod-list []) TYPE: Returns a symbol which is the name of the type (or class) of its of argument. (type ) NEXT-METHODP: If called from a method for a generic function, the function next-methodp will return the symbol TRUE if there is another method shadowed by the current one. Otherwise, the function will return the symbol FALSE. (next-methodp) CALL-NEXT-METHOD: Calls the next shadowed method. (call-next-method) OVERRIDE-NEXT-METHOD: Calls the next shadowed method allowing new arguments to be provided. (override-next-method *) CALL-SPECIFIC-METHOD: Calls a particular method of a generic function without regards to method precedence. (call-specific-method *) GET-METHOD-RESTRICTIONS: Returns a multifield value containing information about the restrictions for the specified method. (get-method-restrictions ) END-ENTRY 2MBEGIN-ENTRY-COOL_FUNCTIONS FUNCTION_SUMMARY COOL_FUNCTIONS The functions manipulating the CLIPS Object-Oriented Language (COOL) are divided into five categories. Subtopics: CLASS_FUNCTIONS INSTANCE_SLOT_FUNCTIONS INSTANCE_MANIPULATION_FUNCTIONS MESSAGE-HANDLER_FUNCTIONS DEFINSTANCES_FUNCTIONS INSTANCE_PREDICATE_FUNCTIONS END-ENTRY 3IBEGIN-ENTRY-CLASS_FUNCTIONS FUNCTION_SUMMARY COOL_FUNCTIONS CLASS_FUNCTIONS The following functions are used with classes. GET-DEFCLASS-LIST: Returns the list of all defclasses in the specified module (or the current module if unspecified). (get-defclass-list []) DEFCLASS-MODULE: Returns the module in which the specified defclass is defined. (defclass-module ) CLASS-EXISTP: Returns TRUE if the specified class is defined, FALSE otherwise. (class-existp ) SUPERCLASSP: Returns TRUE if the first class is a superclass of the second class, FALSE otherwise. (superclassp ) SUBCLASSP: Returns TRUE if the first class is a subclass of the second class, FALSE otherwise. (subclassp ) SLOT-EXISTP: Returns TRUE if the specified slot is present in the class, FALSE otherwise. If the inherit keyword is specified, then the slot may be inherited. (slot-existp [inherit]) SLOT-WRITABLEP: Returns TRUE if the specified slot is writable, otherwise FALSE. (slot-writablep ) SLOT-INITABLEP: Returns TRUE if the specified slot is initializable, otherwise FALSE. (slot-initablep ) SLOT-PUBLICP: Returns TRUE if the specified slot is public, otherwise FALSE. (slot-initablep ) SLOT-DIRECT-ACCESSP: Returns TRUE if the specified slot can be accessed directly, otherwise FALSE. (slot-direct-accessp ) MESSAGE-HANDLER-EXISTP: Returns TRUE if the specified message-handler is defined (directly, not by inheritance) for the class, FALSE otherwise. (message-handler-existp []) ::= around | before | primary | after CLASS-ABSTRACTP: Returns TRUE if the specified class is abstract, FALSE otherwise. (class-abstractp ) CLASS-REACTIVEP: Returns TRUE if the specified class is reactive, FALSE otherwise. (class-reactivep ) CLASS-SUPERCLASSES: Returns the names of the direct superclasses of a class in a multifield variable. If the optional "inherit" argument is given, indirect superclasses are also included. (class-superclasses [inherit]) CLASS-SUBCLASSES: Returns the names of the direct subclasses of a class in a multifield variable. If the optional "inherit" argument is given, indirect subclasses are also included. (class-subclasses [inherit]) CLASS-SLOTS: Returns the names of the explicitly defined slots of a class in a multifield variable. If the optional inherit keyword is given, inherited slots are also included. (class-slots [inherit]) GET-DEFMESSAGE-HANDLER-LIST: Returns the class names, message names, and message types of the message-handlers directly attached to a class in a multifield variable. If the optional inherit keyword is given, inherited message-handlers are also included. (get-defmessage-handler-list [inherit]) SLOT-FACETS: Returns the facet values for the specified slot of a class in a multifield value. (slot-facets ) SLOT-SOURCES: Returns the names of the classes which provide facets for a slot of a class in a multifield variable. (slot-sources ) SLOT-TYPES: Returns the names of the primitive types allowed for a slot in a multifield variable. (slot-types ) SLOT-CARDINALITY: Returns the minimum and maximum number of fields allowed for a multislot in a multifield variable. (slot-cardinality ) SLOT-ALLOWED-VALUES: Returns the allowed values for a slot in a multifield value. (slot-allowed-values ) SLOT-RANGE: Returns the minimum and maximum numeric values allowed for a slot. (slot-range ) SLOT-DEFAULT-VALUE: Returns the default value associated with a slot. (slot-default-value ) SET-CLASS-DEFAULTS-MODE: Sets the defaults mode used when classes are defined. (set-class-defaults-mode ) ::= convenience | conservation GET-CLASS-DEFAULTS-MODE: Returns the current defaults mode used when classes are defined. (get-class-defaults-mode) SLOT-ALLOWED-CLASSES: Returns the allowed classes for a slot in a multifield value. (slot-allowed-classes ) END-ENTRY 3IBEGIN-ENTRY-MESSAGE-HANDLER_FUNCTIONS FUNCTION_SUMMARY COOL_FUNCTIONS MESSAGE-HANDLER_FUNCTIONS The following functions are used with message-handlers. NEXT-HANDLERP: Returns TRUE if there is another message-handler available for execution, FALSE otherwise. (next-handlerp) CALL-NEXT-HANDLER: Calls the next shadowed handler. (call-next-handler) OVERRIDE-NEXT-HANDLER: Calls the next shadowed handler and allows the arguments to be changed. (override-next-handler *) END-ENTRY 3IBEGIN-ENTRY-DEFINSTANCES_FUNCTIONS FUNCTION_SUMMARY COOL_FUNCTIONS DEFINSTANCES_FUNCTIONS The following functions are used with definstances. GET-DEFINSTANCES-LIST: Returns the list of all definstances in the specified module (or the current module if unspecified). (get-definstances-list []) DEFINSTANCES-MODULE: Returns the module in which the specified definstance is defined. (definstances-module ) END-ENTRY 3IBEGIN-ENTRY-INSTANCE_MANIPULATION_FUNCTIONS FUNCTION_SUMMARY COOL_FUNCTIONS INSTANCE_MANIPULATION_FUNCTIONS The following manipulation functions are used with instances. INIT-SLOTS: Implements the init message-handler attached to the class USER. This function should never be called directly unless an init message-handler is being defined such that the one attached to USER will never be called. (init-slots) UNMAKE-INSTANCE: Deletes the specified instance by sending it the delete message. (unmake-instance | *) DELETE-INSTANCE: Deletes the active instance when called from within the body of a message-handler. (delete-instance) CLASS: Returns a symbol which is the name of the class of its argument. (class ) INSTANCE-NAME: Returns a symbol which is the name of its instance argument. (instance-name ) INSTANCE-ADDRESS: Returns the address of its instance argument. (instance-address ) SYMBOL-TO-INSTANCE-NAME: Converts a symbol to an instance name. (symbol-to-instance-name ) INSTANCE-NAME-TO-SYMBOL: Converts an instance name to a symbol. (instance-name-to-symbol ) END-ENTRY 3IBEGIN-ENTRY-INSTANCE_PREDICATE_FUNCTIONS FUNCTION_SUMMARY COOL_FUNCTIONS INSTANCE_PREDICATE_FUNCTIONS The following predicate functions are used with instances. INSTANCEP: Returns TRUE if its argument is an instance name or instance address, FALSE otherwise. (instancep ) INSTANCE-ADDRESSP: Returns TRUE if its argument is an instance address, FALSE otherwise. (instance-addressp ) INSTANCE-NAMEP: Returns TRUE if its argument is an instance name, FALSE otherwise. (instance-namep ) INSTANCE-EXISTP: Returns TRUE if the specified instance exists, FALSE otherwise. (instance-existp ) END-ENTRY 3IBEGIN-ENTRY-INSTANCE_SLOT_FUNCTIONS FUNCTION_SUMMARY COOL_FUNCTIONS INSTANCE_SLOT_FUNCTIONS The following functions are used to manipulate instance slots. DYNAMIC-GET: Returns the value of the specified slot of the active instance. (dynamic-get ) DYNAMIC-PUT: Sets the value of the specified slot of the active instance. (put *) SLOT-REPLACE$: Allows the replacement of a range of fields in a multifield slot value. (slot-replace$ +) DIRECT-SLOT-REPLACE$: Allows the replacement of a range of fields in a multifield slot value of the active instance from within a message-handler. (direct-slot-replace$ +) SLOT-INSERT$: Allows the insertion of one or more values in a multifield slot value. (slot-insert$ +) DIRECT-SLOT-INSERT$: Allows the insertion of one or more values in a multifield slot value of the active instance from within a message-handler. (direct-slot-insert$ +) SLOT-DELETE$: Allows the deletion of a range of fields in a multifield slot value. (slot-delete$ ) DIRECT-SLOT-DELETE$: Allows the deletion of a range of fields in a multifield slot value of the active instance from within a message-handler. (direct-slot-delete$ ) END-ENTRY 2IBEGIN-ENTRY-DEFMODULE_FUNCTIONS The following functions provide ancillary capabilities for the defmodule construct. GET-DEFMODULE-LIST: Returns the list of all defmodules. (get-defmodule-list) END-ENTRY 2IBEGIN-ENTRY-SEQUENCE_EXPANSION_FUNCTIONS The following functions provide ancillary capabilities for the sequence expansion operator. EXPAND$: When used inside of a function call, expands its arguments as separate arguments to the function. The $ operator is merely a shorthand notation for the expand$ function call. (expand$ ) SET-SEQUENCE-OPERATOR-RECOGNITION: Sets the sequence operator recognition behavior. (set-sequence-operator-recognition ) GET-SEQUENCE-OPERATOR-RECOGNITION: Returns the current value of the sequence operator recognition behavior. (get-sequence-operator-recognition) END-ENTRY 1MBEGIN-ENTRY-COMMAND_SUMMARY COMMAND_SUMMARY This section gives a general overview of the available CLIPS commands. Subtopics: ENVIRONMENT_COMMANDS DEFFUNCTION_COMMANDS DEBUGGING_COMMANDS GENERIC_FUNCTION_COMMANDS DEFTEMPLATE_COMMANDS COOL_COMMANDS FACT_COMMANDS DEFMODULE_COMMANDS DEFFACTS_COMMANDS MEMORY_COMMANDS DEFRULE_COMMANDS TEXT_PROCESSING_COMMANDS AGENDA_COMMANDS PROFILING_COMMANDS DEFGLOBAL_COMMANDS END-ENTRY 2IBEGIN-ENTRY-ENVIRONMENT_COMMANDS COMMAND_SUMMARY ENVIRONMENT_COMMANDS The following commands control the CLIPS environment. LOAD: Loads constructs from a file. (load ) LOAD*: Loads constructs from a file without displaying informational messages. (load* ) SAVE: Saves constructs to a file. (save ) BLOAD: Loads a binary image from a file. (bload ) BSAVE: Saves a binary image to a file. (bsave ) CLEAR: Clears the CLIPS environment. (clear) EXIT: Exits the CLIPS environment. (exit) RESET: Resets the CLIPS environment. (reset) BATCH: Executes commands from a file. (batch ) BATCH*: Executes commands from a file. Unlike the batch command, evaluates all of the commands in the specified file before returning rather than replacing standard input. (batch* ) OPTIONS: Lists the settings of CLIPS compiler flags. (options) SYSTEM: Appends its arguments together to form a command which is then sent to the operating system. (system *) SET-AUTO-FLOAT-DIVIDEND: Sets the auto-float dividend behaviour. (set-auto-float-dividend ) GET-AUTO-FLOAT-DIVIDEND: Returns the current value of the auto-float dividend behaviour. (get-auto-float-dividend) SET-DYNAMIC-CONSTRAINT-CHECKING: Sets the dynamic constraint checking behaviour. (set-dynamic-constraint-checking ) GET-DYNAMIC-CONSTRAINT-CHECKING: Returns the current value of the dynamic constraint checking behaviour. (get-dynamic-constraint-checking) SET-STATIC-CONSTRAINT-CHECKING: Sets the static constraint checking behaviour. (set-static-constraint-checking ) GET-STATIC-CONSTRAINT-CHECKING: Returns the current value of the static constraint checking behaviour. (get-static-constraint-checking) APROPOS: Displays all symbols currently defined in CLIPS which contain a specified substring (apropos ) END-ENTRY 2IBEGIN-ENTRY-DEBUGGING_COMMANDS COMMAND_SUMMARY DEBUGGING_COMMANDS The following commands control the CLIPS debugging features. DRIBBLE-ON: Sends trace information to the specified file. (dribble-on ) DRIBBLE-OFF: Closes the trace file. (dribble-off) WATCH: Enables trace information for the specified item. (watch ) ::= all | compilations | statistics | focus | messages | deffunctions * | globals * | rules * | activations * | facts * | instances * | slots * | message-handlers * []) | generic-functions * | methods * [] ::= ::= [ []] ::= ::= [] UNWATCH: Disables trace information for the specified item. (unwatch ) LIST-WATCH-ITEMS: Displays the current state of watch items. (list-watch-items []) END-ENTRY 2IBEGIN-ENTRY-DEFTEMPLATE_COMMANDS COMMAND_SUMMARY DEFTEMPLATE_COMMANDS The following commands manipulate deftemplates. PPDEFTEMPLATE: Displays the text of a given deftemplate. (ppdeftemplate ) LIST-DEFTEMPLATES: Displays the list of all deftemplates in the specified module (or the current module if none specified). (list-deftemplates []) UNDEFTEMPLATE: Deletes a deftemplate. (undeftemplate ) END-ENTRY 2IBEGIN-ENTRY-FACT_COMMANDS COMMAND_SUMMARY FACT_COMMANDS The following commands display information about facts. FACTS: Display the facts in the fact-list. (facts [] [ [ []]]) LOAD-FACTS: Asserts facts loaded from a file. (load-facts ) SAVE-FACTS: Saves facts to a file. (save-facts [ *]) ::= visible | local DEPENDENCIES: Lists the partial matches from which a fact or instance receives logical support. (dependencies ) DEPENDENTS: Lists all facts or instances which receive logical support from a fact or instance. (dependents ) SET-FACT-DUPLICATION: Sets the fact duplication behavior. (set-fact-duplication ) GET-FACT-DUPLICATION: Returns the fact duplication behavior. (get-fact-duplication) PPFACT: Displays the text of a given fact. (ppfact [ []]) END-ENTRY 2IBEGIN-ENTRY-DEFFACTS_COMMANDS COMMAND_SUMMARY DEFFACTS_COMMANDS The following commands manipulate deffacts. PPDEFFACTS: Displays the text of a given deffacts. (ppdeffacts ) LIST-DEFFACTS: Displays the list of all deffacts in the specified module (or the current module if none specified). (list-deffacts []) UNDEFFACTS: Deletes a deffacts. (undeffacts ) END-ENTRY 2IBEGIN-ENTRY-DEFRULE_COMMANDS COMMAND_SUMMARY DEFRULE_COMMANDS The following commands manipulate defrules. PPDEFRULE: Displays the text of a given rule. (ppdefrule ) LIST-DEFRULES: Displays the list of all defrules in the specified module (or the current module if none specified). (list-defrules []) UNDEFRULE: Deletes a defrule. (undefrule ) MATCHES: Displays the facts which match the patterns of a rule. (matches ) SET-BREAK: Sets a breakpoint on a rule. (set-break ) REMOVE-BREAK: Removes a breakpoint on a rule. (remove-break []) SHOW-BREAKS: Displays all rules having breakpoints. (show-breaks []) REFRESH: Places all current activations of a rule on the agenda. (refresh ) SET-INCREMENTAL-RESET: Sets the incremental reset behavior. (set-incremental-reset ) GET-INCREMENTAL-RESET: Returns the incremental reset behavior. (get-incremental-reset) END-ENTRY 2IBEGIN-ENTRY-AGENDA_COMMANDS COMMAND_SUMMARY AGENDA_COMMANDS The following commands manipulate the agenda. AGENDA: Displays all activations on the agenda of the specified module. (agenda []) RUN: Starts execution of rules. Rules fire until agenda is empty or the number of rule firings limit specified by the first argument is reached (infinity if unspecified). (run []) FOCUS: Pushes one or more modules onto the focus stack. (focus +) HALT: Stops rule execution. (halt) SET-STRATEGY: Sets the current conflict resolution strategy. (set-strategy ) ::= depth | breadth | simplicity | complexity | lex | mea | random GET-STRATEGY: Returns the current conflict resolution strategy. (get-strategy) LIST-FOCUS-STACK: Lists all module names on the focus stack. (list-focus-stack) CLEAR-FOCUS-STACK: Removes all modules from the focus stack. (clear-focus-stack) SET-SALIENCE-EVALUATION: Sets the salience evaluation behavior. (set-salience-evaluation ) ::= when-defined | when-activated | every-cycle GET-SALIENCE-EVALUATION: Returns the salience evaluation behavior. (get-salience-evaluation) REFRESH-AGENDA: Forces reevaluation of salience of rules on the agenda of the specified module. (refresh-agenda []) END-ENTRY 2IBEGIN-ENTRY-DEFGLOBAL_COMMANDS COMMAND_SUMMARY DEFGLOBAL_COMMANDS The following commands manipulate defglobals. PPDEFGLOBAL: Displays the text required to define a given global variable. (ppdefglobal ) LIST-DEFGLOBALS: Displays the list of all defglobals in the specified module (or the current module if none specified). (list-defglobals []) UNDEFGLOBAL: Deletes a global variable. (undefglobal ) SHOWS-DEFGLOBALS: Displays the name and current value of all defglobals in the specified module (or the current module if none specified). (show-defglobals []) SET-RESET-GLOBALS: Sets the reset global variables behavior. (set-reset-globals ) GET-RESET-GLOBALS: Returns the reset global variables behavior. (get-reset-globals) END-ENTRY 2IBEGIN-ENTRY-DEFFUNCTION_COMMANDS COMMAND_SUMMARY DEFFUNCTION_COMMANDS The following commands manipulate deffunctions. PPDEFFUNCTION: Displays the text of a given deffunction. (ppdeffunction ) LIST-DEFFUNCTIONS: Displays the list of all deffunctions in the specified module (or the current module if none specified). (list-deffunctions []) UNDEFFUNCTION: Deletes a deffunction. (undeffunction ) END-ENTRY 2IBEGIN-ENTRY-GENERIC_FUNCTION_COMMANDS COMMAND_SUMMARY GENERIC_FUNCTION_COMMANDS The following commands manipulate generic functions. PPDEFGENERIC: Displays the text of a given generic function header. (ppdefgeneric ) PPDEFMETHOD: Displays the text of a given method. (ppdefmethod ) LIST-DEFGENERICS: Displays the names of all generic functions in the specified module (or the current module if none specified). (list-defgenerics []) LIST-DEFMETHODS: Displays a list of generic function methods. (list-defmethods []) UNDEFGENERIC: Deletes a generic function. (undefgeneric ) UNDEFMETHOD: Deletes a generic function method. (undefmethod ) PREVIEW-GENERIC: Lists all applicable methods for a particular generic function call in order of decreasing precedence. (preview-generic *) END-ENTRY 2MBEGIN-ENTRY-COOL_COMMANDS COMMAND_SUMMARY COOL_COMMANDS The commands manipulating the CLIPS Object-Oriented Language (COOL) are divided into four categories. Subtopics: CLASS_COMMANDS MESSAGE-HANDLER_COMMANDS DEFINSTANCES_COMMANDS INSTANCES_COMMANDS END-ENTRY 3IBEGIN-ENTRY-CLASS_COMMANDS COMMAND_SUMMARY COOL_COMMANDS CLASS_COMMANDS The following commands manipulate defclasses. PPDEFCLASS: Displays the text of a given defclass. (ppdefclass ) LIST-DEFCLASSES: Displays the list of all defclasses in the specified module (or the current module if none specified). (list-defclasses []) UNDEFCLASS: Deletes a defclass, all its subclasses, and all associated instances. (undefclass ) DESCRIBE-CLASS: Provides a verbose description of a class. (describe-class ) BROWSE-CLASSES: Provides a rudimentary display of the inheritance relationships between a class and all its subclasses. (browse-classes []) END-ENTRY 3IBEGIN-ENTRY-MESSAGE-HANDLER_COMMANDS COMMAND_SUMMARY COOL_COMMANDS MESSAGE-HANDLER_COMMANDS The following commands manipulate defmessage-handlers. Note that is defined as follows: ::= around | before | primary | after PPDEFMESSAGE-HANDLER: Displays the text of a given defmessage-handler. (ppdefmessage-handler []) LIST-DEFMESSAGE-HANDLERS: Displays a list of all (or some) defmessage- handlers. (list-defmessage-handlers [ [ []]]) UNDEFMESSAGE-HANDLER: Deletes a defmessage-handler. (undefmessage-handler []) PREVIEW-SEND: Displays a list of all the applicable message-handlers for a message sent to an instance of a particular class. (preview-send ) END-ENTRY 3IBEGIN-ENTRY-DEFINSTANCES_COMMANDS COMMAND_SUMMARY COOL_COMMANDS DEFINSTANCES_COMMANDS The following commands manipulate definstances. PPDEFINSTANCES: Displays the text of a given definstances. (ppdefinstances ) LIST-DEFINSTANCES: Displays the list of all definstances in the specified module (or the current module if none specified). (list-definstances []) UNDEFINSTANCES: Deletes a definstances. (undefinstances ) END-ENTRY 3IBEGIN-ENTRY-INSTANCES_COMMANDS COMMAND_SUMMARY COOL_COMMANDS INSTANCES_COMMANDS The following commands manipulate instances of user-defined classes. INSTANCES: Displays a list of instances. (instances [ [ [inherit]]]) PPINSTANCE: Prints the slots of the active instance when called from within the body of a message-handler. (ppinstance) SAVE-INSTANCES: Saves all instances to the specified file. (save-instances ) LOAD-INSTANCES: Loads instances from the specified file. (load-instances ) RESTORE-INSTANCES: Loads instances from the specified file. (restore-instances ) END-ENTRY 2IBEGIN-ENTRY-DEFMODULE_COMMANDS COMMAND_SUMMARY DEFMODULE_COMMANDS The following commands manipulate defmodules. PPDEFMODULE: Displays the text of a given defmodule. (ppdefmodule ) LIST-DEFMODULES: Displays the list of all defmodules. (list-defmodules) SET-CURRENT-MODULE: Sets the current module. (set-current-module ) GET-CURRENT-MODULE: Returns the current module. (get-current-module) END-ENTRY 2IBEGIN-ENTRY-MEMORY_COMMANDS COMMAND_SUMMARY MEMORY_COMMANDS The following commands display CLIPS memory status information. MEM-USED: Returns the number of bytes of memory CLIPS is using. (mem-used) MEM-REQUESTS: Returns the number of times CLIPS has requested memory from the operating system. (mem-requests) RELEASE-MEM: Releases all free memory held internally by CLIPS to the operating system. Returns the amount of memory freed. (release-mem) CONSERVE-MEM: Turns on or off the storage of information used for the save and pretty-print commands. (conserve-mem ) ::= on | off END-ENTRY 2IBEGIN-ENTRY-TEXT_PROCESSING_COMMANDS COMMAND_SUMMARY TEXT_PROCESSING_COMMANDS The following commands can be used by users to maintain their own information system similar to the help facility. FETCH: Loads the named file into the internal lookup table. (fetch ) PRINT-REGION: Looks up the specified entry in a particular file which has been previously loaded into the lookup table and prints the contents of that entry to the specified logical name. (print-region *) GET-REGION: Looks up a specified entry in a particular file which has been loaded previously into the lookup table and returns the contents of that entry as a string. (get region *) TOSS: Unloads the named file from the internal lookup table. (toss ) END-ENTRY 2IBEGIN-ENTRY-PROFILING_COMMANDS COMMAND_SUMMARY PROFILING_COMMANDS The following commands provide the ability to profile CLIPS programs for performance. SET-PROFILE-PERCENT-THRESHOLD: Sets the minimum percentage of time that must be spent executing a construct or user function for it to be displayed by the profile-info command. (set-profile-percent-threshold ) GET-PROFILE-PERCENT-THRESHOLD: Returns the current value of the profile percent threshold. (get-profile-percent-threshold) PROFILE-RESET: Resets all profiling information currently collected for constructs and user functions. (profile-reset) PROFILE-INFO: Displays profiling information currently collected for constructs or user functions. (profile-info) PROFILE: Enables/disables profiling of constructs and user functions. (profile constructs | user-functions | off) END-ENTRY 1MBEGIN-ENTRY-INTEGRATED_EDITOR INTEGRATED_EDITOR CLIPS includes a fully integrated version of the full screen MicroEMACS editor. You may call the editor from CLIPS, compile full buffers or just sections of the editor (incremental compile), temporarily exit the editor back to CLIPS, or permanently exit the editor. Since the editor is full screen, portions of it are highly machine dependent. As it is currently set up, the editor will run on VAX VMS machines using VT100- or VT240-compatible terminals, UNIX systems which support TERMCAP, the IBM PC, and most IBM compatibles. Subtopics: USING_THE_EDITOR EXTENDED_COMMANDS CONTROL_COMMANDS META_COMMANDS END-ENTRY 2IBEGIN-ENTRY-USING_THE_EDITOR INTEGRATED_EDITOR USING_THE_EDITOR The editor may be called from CLIPS with the following command: (edit [""]) The file name is optional. If one is given, that file would be loaded. If no file name is given, the editor is entered without loading a file. Once in the file, all of the EMACS commands listed below are applicable. To exit the editor and clear all buffers, use or . To temporarily exit the editor and retain the information in the buffers, use Q. To compile a rules section, mark a region and type . To compile the entire buffer, use . The editor can use extensive amounts of memory and a flag is available in clips.h to remove all of the editor code. When using the editor on multiuser machines like the VAX or many UNIX environments, be careful with the control S and control Q commands; they could conflict with terminal XON/XOFF communications. All of the control S commands have a work around built into the editor. The save file command, normally , is also Z. The forward search command, normally , is also J. The control Q command is rarely needed in a CLIPS file and, therefore, has no substitute. The following two special characters should be noted when using the editor. Delete previous character. (also on some terminals) Meta command prefix. (also on some terminals) END-ENTRY 2IBEGIN-ENTRY-CONTROL_COMMANDS INTEGRATED_EDITOR CONTROL_COMMANDS These commands are entered by pressing the control key along with the designated character. Set mark at current position. Move cursor to beginning of line. Move cursor BACK one character. Start a new interactive command shell. Be careful! DELETE character under cursor. Move cursor to END of line. Move cursor FORWARD one character. Abort any command. (backspace) delete previous character. Insert a TAB. Insert a CR-LF and indent next line. KILL (delete) to end of line. Redisplay screen. Insert a CR-LF. Move cursor to NEXT line. OPEN a new line. Move to PREVIOUS line. QUOTE the next character (insert the next character typed). Reverse SEARCH. Forward SEARCH (also ). TRANSPOSE characters. Enter repeat count for next command. VIEW the next screen (scroll up one screen). KILL region (all text between cursor and last mark set). Extended command prefix - see below. YANK (undelete) last text killed. Quick save of file in current buffer (only) and exit. END-ENTRY 2IBEGIN-ENTRY-EXTENDED_COMMANDS INTEGRATED_EDITOR EXTENDED_COMMANDS These commands are entered by first pressing the control key along with the 'x' character and then pressing the designated character. ( Begin keyboard Macro. ) End keyboard Macro. ! Execute a single external command. = Show current cursor column and line number. : Go to a specific line number. 1 Display current window only. 2 Split the current window. B Switch to a different BUFFER. E EXECUTE keyboard Macro. F Set FILL column. K KILL a buffer (other than current buffer). M MATCH parenthesis (or {} or []). N Move to NEXT window. P Move to PREVIOUS window. R Global search and REPLACE (backwards). S Global SEARCH and replace (forwards). Z Enlarge current window by repeat count lines. Show active BUFFERS. Exit without saving buffers. FIND file. Load if not already in buffer. Scroll current window up by repeat count lines. Scroll current window down by repeat count lines. RENAME file. Change file name for buffer. SAVE (write) current buffer into its file. VISIT a file. Read file and display in current window. WRITE buffer to file. Option to change name of file. Reduce current window by repeat count lines. END-ENTRY 2IBEGIN-ENTRY-META_COMMANDS INTEGRATED_EDITOR META_COMMANDS These commands are entered by first pressing the meta key (Activated by or ) and then pressing the designated character. ! Move current line to repeat count lines from top of window. > Move cursor to end of buffer. < Move cursor to beginning of buffer. . Set mark. B Move cursor BACK one word. C CAPITALIZE first letter of word. D DELETE next word. F Move cursor FORWARD one word. J SEARCH forward (same as ). L LOWERCASE (lowercase) next word. R Query search and REPLACE (backwards). S Query SEARCH and replace (forwards). U UPPERCASE (uppercase) next word. V VIEW the previous screen (scroll down one screen). W COPY region into kill buffer. Z SAVE current buffer into file (same as ). DELETE previous word. END-ENTRY clips-6.24/.DS_Store0000644000175000017500000001400410444326271012372 0ustar jfsjfsBud1 ssrcIlocclipssrcIlocblob_clipssrcdsclboolclipssrcfwi0blobNlsvclipssrcfwswlongvclipssrcicspblobclipssrclsspblob readme.txtIlocblob  @ @ @ @ E DSDB ` @ @ @clips-6.24/._.DS_Store0000400000175000017500000000012210444326271012571 0ustar jfsjfsMac OS X  2 R@clips-6.24/x-prjct/0000755000175000017500000000000010200477266012300 5ustar jfsjfsclips-6.24/x-prjct/makefile/0000755000175000017500000000000010444324446014056 5ustar jfsjfsclips-6.24/x-prjct/makefile/.DS_Store0000644000175000017500000001400410444324452015535 0ustar jfsjfsBud1%  @ @ @ @ E%DSDB` @ @ @clips-6.24/x-prjct/makefile/._.DS_Store0000400000175000017500000000012210444324452015734 0ustar jfsjfsMac OS X  2 R@clips-6.24/x-prjct/makefile/makefile.x0000755000175000017500000022647010440722665016043 0ustar jfsjfs#------------------------------------------------------- # The paths to the X libs and include files should # be changed to whatever appropriate for the system # that xclips color are made. # ----------------------------------------------------- WHERE_XLIBS_ARE = /usr/X11R6/lib WHERE_INCL_FILES_ARE = /usr/X11R6/include #-------------------------------------------------------------------- # Please! do not have -O on because there is an unresolved bug either # in the interface code or the optimizer that cause xclips to crash #-------------------------------------------------------------------- LDFLAGS = -L$(WHERE_XLIBS_ARE) INCLUDES = -I$(WHERE_INCL_FILES_ARE) LIBS = -lXaw -lXmu -lXt -lXext -lX11 -lm OBJS = agenda.o analysis.o argacces.o bload.o bmathfun.o bsave.o \ classcom.o classexm.o classfun.o classinf.o classini.o \ classpsr.o clsltpsr.o commline.o conscomp.o constrct.o \ constrnt.o crstrtgy.o cstrcbin.o cstrccom.o cstrcpsr.o \ cstrnbin.o cstrnchk.o cstrncmp.o cstrnops.o cstrnpsr.o \ cstrnutl.o default.o defins.o developr.o dffctbin.o dffctbsc.o \ dffctcmp.o dffctdef.o dffctpsr.o dffnxbin.o dffnxcmp.o \ dffnxexe.o dffnxfun.o dffnxpsr.o dfinsbin.o dfinscmp.o drive.o \ edbasic.o edmain.o edmisc.o edstruct.o edterm.o emathfun.o \ engine.o envrnmnt.o evaluatn.o expressn.o exprnbin.o exprnops.o \ exprnpsr.o extnfunc.o factbin.o factbld.o factcmp.o factcom.o \ factfun.o factgen.o facthsh.o factlhs.o factmch.o factmngr.o \ factprt.o factqpsr.o factqury.o factrete.o factrhs.o filecom.o filertr.o \ generate.o genrcbin.o genrccmp.o genrccom.o genrcexe.o genrcfun.o \ genrcpsr.o globlbin.o globlbsc.o globlcmp.o globlcom.o \ globldef.o globlpsr.o immthpsr.o incrrset.o inherpsr.o \ inscom.o insfile.o insfun.o insmngr.o insmoddp.o insmult.o \ inspsr.o insquery.o insqypsr.o iofun.o lgcldpnd.o \ memalloc.o miscfun.o modulbin.o modulbsc.o modulcmp.o moduldef.o \ modulpsr.o modulutl.o msgcom.o msgfun.o msgpass.o msgpsr.o \ multifld.o multifun.o objbin.o objcmp.o objrtbin.o objrtbld.o \ objrtcmp.o objrtfnx.o objrtgen.o objrtmch.o parsefun.o pattern.o \ pprint.o prccode.o prcdrfun.o prcdrpsr.o prdctfun.o prntutil.o \ proflfun.o reorder.o reteutil.o retract.o router.o rulebin.o \ rulebld.o rulebsc.o rulecmp.o rulecom.o rulecstr.o ruledef.o \ ruledlt.o rulelhs.o rulepsr.o scanner.o sortfun.o strngfun.o \ strngrtr.o symblbin.o symblcmp.o symbol.o sysdep.o textpro.o \ tmpltbin.o tmpltbsc.o tmpltcmp.o tmpltdef.o tmpltfun.o tmpltlhs.o \ tmpltpsr.o tmpltrhs.o tmpltutl.o userdata.o userfunctions.o utility.o watch.o \ xclips.o xclipstext.o xedit.o xmain.o xmenu.o xmenu_exec.o \ xmenu_file.o xmenu_opt.o xmenu_watch.o xmenu_wind.o .c.o : gcc -c -Wall -Wundef $(INCLUDES) -Wpointer-arith -Wshadow \ -Wcast-align -Winline -Wmissing-declarations -Wredundant-decls \ -Wmissing-prototypes -Wnested-externs \ -Wstrict-prototypes -Waggregate-return -Wno-implicit $< xclips : $(OBJS) gcc -o xclips $(OBJS) $(LDFLAGS) $(LIBS) agenda.o: agenda.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h crstrtgy.h agenda.h ruledef.h constrnt.h \ cstrccom.h network.h match.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h memalloc.h modulutl.h multifld.h reteutil.h router.h \ prntutil.h rulebsc.h strngrtr.h sysdep.h watch.h analysis.o: analysis.c setup.h envrnmnt.h usrsetup.h constant.h symbol.h \ memalloc.h exprnpsr.h extnfunc.h expressn.h exprnops.h userdata.h \ scanner.h pprint.h reorder.h ruledef.h conscomp.h constrct.h moduldef.h \ modulpsr.h evaluatn.h utility.h symblcmp.h constrnt.h cstrccom.h \ agenda.h match.h network.h pattern.h generate.h router.h prntutil.h \ cstrnchk.h cstrnutl.h cstrnops.h rulecstr.h modulutl.h analysis.h \ globldef.h argacces.o: argacces.c setup.h envrnmnt.h usrsetup.h extnfunc.h symbol.h \ expressn.h exprnops.h exprnpsr.h scanner.h pprint.h userdata.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h evaluatn.h constant.h \ symblcmp.h modulpsr.h utility.h cstrnchk.h constrnt.h insfun.h object.h \ multifld.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h factmngr.h facthsh.h tmpltdef.h factbld.h argacces.h bload.o: bload.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h bsave.h cstrnbin.h constrnt.h memalloc.h router.h \ prntutil.h bload.h exprnbin.h sysdep.h symblbin.h bmathfun.o: bmathfun.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ bmathfun.h bsave.o: bsave.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h bload.h exprnbin.h sysdep.h symblbin.h cstrnbin.h \ constrnt.h memalloc.h router.h prntutil.h bsave.h classcom.o: classcom.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h argacces.h evaluatn.h \ constant.h moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h \ classfun.h object.h constrnt.h multifld.h match.h network.h ruledef.h \ cstrccom.h agenda.h pattern.h reorder.h classini.h modulutl.h msgcom.h \ msgpass.h router.h prntutil.h classcom.h classexm.o: classexm.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h multifld.h match.h network.h ruledef.h agenda.h \ pattern.h reorder.h classfun.h classini.h insfun.h memalloc.h msgcom.h \ msgpass.h msgfun.h router.h prntutil.h strngrtr.h classexm.h classfun.o: classfun.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h classcom.h cstrccom.h \ moduldef.h conscomp.h constrct.h evaluatn.h constant.h symblcmp.h \ modulpsr.h object.h constrnt.h multifld.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classini.h cstrcpsr.h inscom.h insfun.h \ insmngr.h memalloc.h modulutl.h msgfun.h msgpass.h router.h prntutil.h \ classfun.h classinf.o: classinf.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h multifld.h match.h network.h ruledef.h agenda.h \ pattern.h reorder.h classexm.h classfun.h classini.h memalloc.h \ insfun.h msgcom.h msgpass.h msgfun.h prntutil.h classinf.h classini.o: classini.c setup.h envrnmnt.h usrsetup.h classcom.h \ cstrccom.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classexm.h classfun.h classinf.h classpsr.h cstrcpsr.h inscom.h \ insfun.h memalloc.h modulutl.h msgcom.h msgpass.h watch.h defins.h \ insquery.h bload.h exprnbin.h sysdep.h symblbin.h objbin.h objcmp.h \ objrtbld.h classini.h classpsr.o: classpsr.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h classcom.h cstrccom.h \ moduldef.h conscomp.h constrct.h evaluatn.h constant.h symblcmp.h \ modulpsr.h object.h constrnt.h multifld.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h clsltpsr.h cstrcpsr.h \ inherpsr.h memalloc.h modulutl.h msgpsr.h router.h prntutil.h \ classpsr.h clsltpsr.o: clsltpsr.c setup.h envrnmnt.h usrsetup.h classcom.h \ cstrccom.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnchk.h cstrnpsr.h cstrnutl.h default.h insfun.h \ memalloc.h prntutil.h router.h clsltpsr.h commline.o: commline.c setup.h envrnmnt.h usrsetup.h constant.h \ argacces.h expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h \ userdata.h scanner.h pprint.h evaluatn.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h filecom.h \ memalloc.h prcdrfun.h prcdrpsr.h constrnt.h router.h prntutil.h \ strngrtr.h commline.h conscomp.o: conscomp.c setup.h envrnmnt.h usrsetup.h symbol.h memalloc.h \ constant.h exprnpsr.h extnfunc.h expressn.h exprnops.h userdata.h \ scanner.h pprint.h cstrccom.h moduldef.h conscomp.h constrct.h \ evaluatn.h symblcmp.h modulpsr.h utility.h argacces.h cstrncmp.h \ constrnt.h router.h prntutil.h sysdep.h modulcmp.h network.h match.h \ pattern.h reorder.h ruledef.h agenda.h dffnxcmp.h dffnxfun.h tmpltcmp.h \ globlcmp.h genrccmp.h genrcfun.h object.h multifld.h objcmp.h constrct.o: constrct.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h watch.h \ prcdrfun.h prcdrpsr.h constrnt.h argacces.h multifld.h sysdep.h \ commline.h constrnt.o: constrnt.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h multifld.h \ router.h prntutil.h constrnt.h crstrtgy.o: crstrtgy.c setup.h envrnmnt.h usrsetup.h constant.h pattern.h \ evaluatn.h symbol.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ userdata.h scanner.h pprint.h match.h network.h ruledef.h conscomp.h \ constrct.h moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h \ cstrccom.h agenda.h reorder.h reteutil.h argacces.h crstrtgy.h cstrcbin.o: cstrcbin.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h bsave.h moduldef.h conscomp.h \ constrct.h evaluatn.h constant.h symblcmp.h modulpsr.h cstrcbin.h cstrccom.o: cstrccom.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h argacces.h multifld.h \ modulutl.h router.h prntutil.h commline.h bload.h exprnbin.h sysdep.h \ symblbin.h cstrcpsr.h cstrccom.h cstrcpsr.o: cstrcpsr.c setup.h envrnmnt.h usrsetup.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symbol.h userdata.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h watch.h prcdrpsr.h constrnt.h \ modulutl.h sysdep.h cstrcpsr.h cstrnbin.o: cstrnbin.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h bload.h \ exprnbin.h sysdep.h symblbin.h bsave.h cstrnbin.h constrnt.h cstrnchk.o: cstrnchk.c setup.h envrnmnt.h usrsetup.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symbol.h userdata.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h multifld.h cstrnutl.h \ constrnt.h inscom.h object.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h insfun.h classcom.h classexm.h cstrnchk.h cstrncmp.o: cstrncmp.c setup.h envrnmnt.h usrsetup.h constant.h \ conscomp.h constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h \ pprint.h utility.h symblcmp.h memalloc.h router.h prntutil.h sysdep.h \ cstrncmp.h constrnt.h cstrnops.o: cstrnops.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h \ multifld.h constrnt.h cstrnchk.h cstrnutl.h cstrnops.h cstrnpsr.o: cstrnpsr.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h \ cstrnutl.h constrnt.h cstrnchk.h cstrnpsr.h cstrnutl.o: cstrnutl.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h \ multifld.h argacces.h cstrnutl.h constrnt.h default.o: default.c setup.h envrnmnt.h usrsetup.h constant.h constrnt.h \ evaluatn.h symbol.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ userdata.h scanner.h pprint.h cstrnchk.h multifld.h inscom.h object.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ insfun.h router.h prntutil.h factmngr.h facthsh.h tmpltdef.h factbld.h \ cstrnutl.h default.h defins.o: defins.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h dfinsbin.h defins.h \ conscomp.h constrct.h moduldef.h modulpsr.h evaluatn.h constant.h \ symblcmp.h cstrccom.h object.h constrnt.h multifld.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h dfinscmp.h argacces.h classcom.h \ classfun.h cstrcpsr.h insfun.h inspsr.h memalloc.h router.h prntutil.h developr.o: developr.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h inscom.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h insfun.h modulutl.h router.h prntutil.h tmpltdef.h factbld.h \ factmngr.h facthsh.h classcom.h classfun.h objrtmch.h developr.h dffctbin.o: dffctbin.c setup.h envrnmnt.h usrsetup.h memalloc.h \ dffctdef.h conscomp.h constrct.h moduldef.h modulpsr.h symbol.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ userdata.h scanner.h pprint.h utility.h symblcmp.h cstrccom.h bload.h \ exprnbin.h sysdep.h symblbin.h bsave.h dffctbin.h modulbin.h cstrcbin.h dffctbsc.o: dffctbsc.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h multifld.h tmpltdef.h \ factbld.h cstrcpsr.h dffctpsr.h dffctdef.h dffctbin.h modulbin.h \ cstrcbin.h dffctcmp.h dffctbsc.h dffctcmp.o: dffctcmp.c setup.h envrnmnt.h usrsetup.h conscomp.h \ constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h constant.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h \ pprint.h utility.h symblcmp.h dffctdef.h cstrccom.h dffctcmp.h dffctdef.o: dffctdef.c setup.h envrnmnt.h usrsetup.h memalloc.h \ dffctpsr.h dffctbsc.h evaluatn.h constant.h symbol.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h pprint.h bload.h \ utility.h exprnbin.h sysdep.h symblbin.h dffctbin.h modulbin.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h cstrcbin.h \ dffctcmp.h dffctdef.h cstrccom.h dffctpsr.o: dffctpsr.c setup.h envrnmnt.h usrsetup.h memalloc.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h cstrcpsr.h factrhs.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h multifld.h tmpltdef.h factbld.h bload.h \ exprnbin.h sysdep.h symblbin.h dffctdef.h dffctbsc.h dffctpsr.h dffnxbin.o: dffnxbin.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h bsave.h memalloc.h cstrcbin.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h evaluatn.h \ constant.h modulbin.h dffnxbin.h dffnxfun.h cstrccom.h dffnxcmp.o: dffnxcmp.c setup.h envrnmnt.h usrsetup.h conscomp.h \ constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h constant.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h \ pprint.h utility.h symblcmp.h dffnxcmp.h dffnxfun.h cstrccom.h dffnxexe.o: dffnxexe.c setup.h envrnmnt.h usrsetup.h constrct.h \ moduldef.h conscomp.h extnfunc.h symbol.h expressn.h exprnops.h \ exprnpsr.h scanner.h pprint.h userdata.h symblcmp.h modulpsr.h \ evaluatn.h constant.h utility.h prcdrfun.h prccode.h proflfun.h \ router.h prntutil.h watch.h dffnxexe.h dffnxfun.h cstrccom.h dffnxfun.o: dffnxfun.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h dffnxbin.h dffnxfun.h \ conscomp.h constrct.h moduldef.h modulpsr.h evaluatn.h constant.h \ symblcmp.h cstrccom.h dffnxcmp.h cstrcpsr.h dffnxpsr.h dffnxexe.h \ watch.h argacces.h memalloc.h router.h prntutil.h dffnxpsr.o: dffnxpsr.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h network.h match.h evaluatn.h \ constant.h pattern.h reorder.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h symblcmp.h constrnt.h cstrccom.h agenda.h \ genrccom.h genrcfun.h object.h multifld.h cstrcpsr.h dffnxfun.h \ memalloc.h prccode.h router.h prntutil.h dffnxpsr.h dfinsbin.o: dfinsbin.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h bsave.h memalloc.h cstrcbin.h \ constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h evaluatn.h \ constant.h defins.h cstrccom.h object.h constrnt.h multifld.h match.h \ network.h ruledef.h agenda.h pattern.h reorder.h modulbin.h dfinsbin.h dfinscmp.o: dfinscmp.c setup.h envrnmnt.h usrsetup.h conscomp.h \ constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h constant.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h \ pprint.h utility.h symblcmp.h defins.h cstrccom.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ dfinscmp.h drive.o: drive.c setup.h envrnmnt.h usrsetup.h agenda.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h utility.h symblcmp.h constrnt.h cstrccom.h network.h \ match.h pattern.h reorder.h engine.h lgcldpnd.h retract.h memalloc.h \ prntutil.h reteutil.h router.h incrrset.h drive.h edbasic.o: edbasic.c setup.h envrnmnt.h usrsetup.h ed.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h edmain.o: edmain.c setup.h envrnmnt.h usrsetup.h ed.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h sysdep.h edmisc.o: edmisc.c setup.h envrnmnt.h usrsetup.h ed.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrcpsr.h edstruct.o: edstruct.c setup.h envrnmnt.h usrsetup.h ed.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h edterm.o: edterm.c setup.h envrnmnt.h usrsetup.h ed.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h emathfun.o: emathfun.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ emathfun.h engine.o: engine.c setup.h envrnmnt.h usrsetup.h agenda.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h utility.h symblcmp.h constrnt.h cstrccom.h network.h \ match.h pattern.h reorder.h argacces.h factmngr.h facthsh.h multifld.h \ tmpltdef.h factbld.h inscom.h object.h insfun.h memalloc.h modulutl.h \ prccode.h prcdrfun.h proflfun.h reteutil.h retract.h router.h \ prntutil.h ruledlt.h sysdep.h watch.h engine.h lgcldpnd.h envrnmnt.o: envrnmnt.c setup.h envrnmnt.h usrsetup.h memalloc.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h router.h engine.h \ lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ pattern.h reorder.h retract.h sysdep.h evaluatn.o: evaluatn.c setup.h envrnmnt.h usrsetup.h commline.h \ constant.h memalloc.h router.h prntutil.h moduldef.h conscomp.h \ constrct.h symbol.h userdata.h evaluatn.h expressn.h exprnops.h \ exprnpsr.h extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h \ utility.h prcdrfun.h multifld.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h cstrccom.h agenda.h reorder.h tmpltdef.h \ factbld.h proflfun.h sysdep.h dffnxfun.h genrccom.h genrcfun.h object.h expressn.o: expressn.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h memalloc.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h evaluatn.h constant.h \ symblcmp.h modulpsr.h exprnbin.o: exprnbin.c setup.h envrnmnt.h usrsetup.h memalloc.h \ dffctdef.h conscomp.h constrct.h moduldef.h modulpsr.h symbol.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ userdata.h scanner.h pprint.h utility.h symblcmp.h cstrccom.h bload.h \ exprnbin.h sysdep.h symblbin.h bsave.h network.h match.h pattern.h \ reorder.h ruledef.h constrnt.h agenda.h genrcbin.h genrcfun.h object.h \ multifld.h dffnxbin.h dffnxfun.h tmpltbin.h cstrcbin.h modulbin.h \ tmpltdef.h factbld.h factmngr.h facthsh.h globlbin.h globldef.h \ objbin.h insfun.h inscom.h exprnops.o: exprnops.c setup.h envrnmnt.h usrsetup.h memalloc.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h cstrnchk.h \ constrnt.h cstrnutl.h cstrnops.h exprnpsr.o: exprnpsr.c setup.h envrnmnt.h usrsetup.h constant.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h strngrtr.h memalloc.h \ argacces.h cstrnchk.h constrnt.h modulutl.h prcdrfun.h network.h \ match.h pattern.h reorder.h ruledef.h cstrccom.h agenda.h genrccom.h \ genrcfun.h object.h multifld.h dffnxfun.h extnfunc.o: extnfunc.c setup.h envrnmnt.h usrsetup.h constant.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h memalloc.h factbin.o: factbin.c setup.h envrnmnt.h usrsetup.h memalloc.h tmpltdef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h utility.h symblcmp.h constrnt.h factbld.h pattern.h \ match.h network.h ruledef.h cstrccom.h agenda.h reorder.h factmngr.h \ facthsh.h multifld.h bload.h exprnbin.h sysdep.h symblbin.h bsave.h \ reteutil.h rulebin.h modulbin.h cstrcbin.h factbin.h factbld.o: factbld.c setup.h envrnmnt.h usrsetup.h memalloc.h reteutil.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h router.h prntutil.h \ factcmp.h factmch.h factmngr.h facthsh.h multifld.h tmpltdef.h \ factbld.h factgen.h factlhs.h argacces.h modulutl.h factcmp.o: factcmp.c setup.h envrnmnt.h usrsetup.h factbld.h pattern.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h reorder.h factcmp.h tmpltdef.h \ factmngr.h facthsh.h multifld.h factcom.o: factcom.c setup.h envrnmnt.h usrsetup.h memalloc.h exprnpsr.h \ extnfunc.h symbol.h expressn.h exprnops.h userdata.h scanner.h pprint.h \ factmngr.h facthsh.h conscomp.h constrct.h moduldef.h modulpsr.h \ evaluatn.h constant.h utility.h symblcmp.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h multifld.h \ tmpltdef.h factbld.h argacces.h router.h prntutil.h factrhs.h factmch.h \ tmpltpsr.h tmpltutl.h modulutl.h strngrtr.h tmpltfun.h sysdep.h bload.h \ exprnbin.h symblbin.h factcom.h factfun.o: factfun.c setup.h envrnmnt.h usrsetup.h extnfunc.h symbol.h \ expressn.h exprnops.h exprnpsr.h scanner.h pprint.h userdata.h \ argacces.h evaluatn.h constant.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h utility.h prntutil.h tmpltutl.h factmngr.h \ facthsh.h pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h reorder.h multifld.h tmpltdef.h factbld.h router.h factfun.h factgen.o: factgen.c setup.h envrnmnt.h usrsetup.h constant.h memalloc.h \ router.h prntutil.h moduldef.h conscomp.h constrct.h symbol.h \ userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h network.h match.h \ pattern.h reorder.h ruledef.h constrnt.h cstrccom.h agenda.h reteutil.h \ factmch.h factmngr.h facthsh.h multifld.h tmpltdef.h factbld.h \ factrete.h factprt.h tmpltlhs.h factgen.h facthsh.o: facthsh.c setup.h envrnmnt.h usrsetup.h constant.h memalloc.h \ router.h prntutil.h moduldef.h conscomp.h constrct.h symbol.h \ userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h lgcldpnd.h match.h \ network.h ruledef.h constrnt.h cstrccom.h agenda.h pattern.h reorder.h \ facthsh.h factmngr.h multifld.h tmpltdef.h factbld.h factlhs.o: factlhs.c setup.h envrnmnt.h usrsetup.h cstrcpsr.h evaluatn.h \ constant.h symbol.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ userdata.h scanner.h pprint.h constrct.h moduldef.h conscomp.h \ symblcmp.h modulpsr.h utility.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h router.h prntutil.h tmpltpsr.h \ tmpltdef.h factbld.h factmngr.h facthsh.h multifld.h tmpltlhs.h \ tmpltutl.h modulutl.h factlhs.h factmch.o: factmch.c setup.h envrnmnt.h usrsetup.h drive.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ match.h evaluatn.h constant.h network.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h engine.h lgcldpnd.h retract.h factgen.h \ factrete.h incrrset.h memalloc.h reteutil.h router.h prntutil.h \ tmpltdef.h factbld.h factmngr.h facthsh.h multifld.h factmch.h factmngr.o: factmngr.c setup.h envrnmnt.h usrsetup.h constant.h symbol.h \ memalloc.h exprnpsr.h extnfunc.h expressn.h exprnops.h userdata.h \ scanner.h pprint.h argacces.h evaluatn.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ strngrtr.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ pattern.h reorder.h factbld.h factqury.h factmngr.h facthsh.h \ multifld.h tmpltdef.h reteutil.h retract.h factcmp.h filecom.h \ factfun.h factcom.h factrhs.h factmch.h watch.h factbin.h default.h \ commline.h engine.h lgcldpnd.h drive.h ruledlt.h tmpltbsc.h tmpltutl.h \ tmpltfun.h factprt.o: factprt.c setup.h envrnmnt.h usrsetup.h symbol.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h userdata.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h factgen.h reorder.h ruledef.h \ constrnt.h cstrccom.h agenda.h match.h network.h pattern.h factprt.h factqpsr.o: factqpsr.c setup.h envrnmnt.h usrsetup.h exprnpsr.h \ extnfunc.h symbol.h expressn.h exprnops.h userdata.h scanner.h pprint.h \ factqury.h factmngr.h facthsh.h conscomp.h constrct.h moduldef.h \ modulpsr.h evaluatn.h constant.h utility.h symblcmp.h pattern.h match.h \ network.h ruledef.h constrnt.h cstrccom.h agenda.h reorder.h multifld.h \ tmpltdef.h factbld.h modulutl.h prcdrpsr.h prntutil.h router.h \ strngrtr.h factqpsr.h factqury.o: factqury.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h modulutl.h \ tmpltutl.h factmngr.h facthsh.h pattern.h match.h network.h ruledef.h \ constrnt.h cstrccom.h agenda.h reorder.h multifld.h tmpltdef.h \ factbld.h insfun.h object.h factqpsr.h prcdrfun.h router.h prntutil.h \ factqury.h factrete.o: factrete.c setup.h envrnmnt.h usrsetup.h memalloc.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ evaluatn.h constant.h symblcmp.h modulpsr.h utility.h incrrset.h \ ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h pattern.h \ reorder.h reteutil.h drive.h engine.h lgcldpnd.h retract.h factgen.h \ factmch.h factmngr.h facthsh.h multifld.h tmpltdef.h factbld.h \ factrete.h factrhs.o: factrhs.c setup.h envrnmnt.h usrsetup.h constant.h extnfunc.h \ symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h userdata.h \ modulutl.h moduldef.h conscomp.h constrct.h evaluatn.h symblcmp.h \ modulpsr.h utility.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h prntutil.h cstrcpsr.h bload.h exprnbin.h \ sysdep.h symblbin.h tmpltpsr.h tmpltdef.h factbld.h factmngr.h \ facthsh.h multifld.h tmpltrhs.h tmpltutl.h strngrtr.h router.h \ factrhs.h filecom.o: filecom.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h commline.h cstrcpsr.h memalloc.h prcdrfun.h \ router.h prntutil.h strngrtr.h sysdep.h filecom.h bsave.h bload.h \ exprnbin.h symblbin.h filertr.o: filertr.c setup.h envrnmnt.h usrsetup.h constant.h memalloc.h \ router.h prntutil.h moduldef.h conscomp.h constrct.h symbol.h \ userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h sysdep.h filertr.h generate.o: generate.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h symbol.h exprnpsr.h extnfunc.h expressn.h exprnops.h \ userdata.h scanner.h pprint.h argacces.h evaluatn.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h router.h \ prntutil.h ruledef.h constrnt.h cstrccom.h agenda.h match.h network.h \ pattern.h reorder.h generate.h globlpsr.h genrcbin.o: genrcbin.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h bload.h utility.h extnfunc.h symbol.h expressn.h exprnops.h \ exprnpsr.h scanner.h pprint.h userdata.h exprnbin.h sysdep.h symblbin.h \ bsave.h cstrcbin.h constrct.h moduldef.h conscomp.h symblcmp.h \ modulpsr.h evaluatn.h objbin.h object.h constrnt.h multifld.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h genrccom.h \ genrcfun.h modulbin.h genrcbin.h router.h prntutil.h genrccmp.o: genrccmp.c setup.h envrnmnt.h usrsetup.h network.h match.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h pattern.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h genrccom.h genrcfun.h object.h \ multifld.h objcmp.h genrccmp.h genrccom.o: genrccom.c setup.h envrnmnt.h usrsetup.h network.h match.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h pattern.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h bload.h exprnbin.h sysdep.h symblbin.h \ genrcbin.h genrcfun.h object.h multifld.h genrccmp.h genrcpsr.h \ classcom.h inscom.h insfun.h watch.h argacces.h cstrcpsr.h genrcexe.h \ memalloc.h router.h prntutil.h genrccom.h genrcexe.o: genrcexe.c setup.h envrnmnt.h usrsetup.h classcom.h \ cstrccom.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h insfun.h argacces.h genrccom.h genrcfun.h prcdrfun.h \ prccode.h proflfun.h router.h prntutil.h genrcexe.h genrcfun.o: genrcfun.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h classcom.h cstrccom.h \ moduldef.h conscomp.h constrct.h evaluatn.h constant.h symblcmp.h \ modulpsr.h object.h constrnt.h multifld.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h argacces.h cstrcpsr.h \ genrccom.h genrcfun.h genrcexe.h memalloc.h prccode.h router.h \ prntutil.h genrcpsr.o: genrcpsr.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h dffnxfun.h conscomp.h \ constrct.h moduldef.h modulpsr.h evaluatn.h constant.h symblcmp.h \ cstrccom.h classfun.h object.h constrnt.h multifld.h match.h network.h \ ruledef.h agenda.h pattern.h reorder.h classcom.h memalloc.h cstrcpsr.h \ genrccom.h genrcfun.h immthpsr.h modulutl.h prcdrpsr.h prccode.h \ router.h prntutil.h genrcpsr.h globlbin.o: globlbin.c setup.h envrnmnt.h usrsetup.h memalloc.h \ multifld.h evaluatn.h constant.h symbol.h expressn.h exprnops.h \ exprnpsr.h extnfunc.h userdata.h scanner.h pprint.h globldef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ cstrccom.h bload.h exprnbin.h sysdep.h symblbin.h bsave.h globlbsc.h \ globlbin.h modulbin.h cstrcbin.h globlbsc.o: globlbsc.c setup.h envrnmnt.h usrsetup.h constrct.h \ moduldef.h conscomp.h extnfunc.h symbol.h expressn.h exprnops.h \ exprnpsr.h scanner.h pprint.h userdata.h symblcmp.h modulpsr.h \ evaluatn.h constant.h utility.h watch.h globlcom.h globldef.h \ cstrccom.h globlbin.h modulbin.h cstrcbin.h globlcmp.h globlbsc.h globlcmp.o: globlcmp.c setup.h envrnmnt.h usrsetup.h conscomp.h \ constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h constant.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h \ pprint.h utility.h symblcmp.h globldef.h cstrccom.h globlcmp.h globlcom.o: globlcom.c setup.h envrnmnt.h usrsetup.h extnfunc.h symbol.h \ expressn.h exprnops.h exprnpsr.h scanner.h pprint.h userdata.h \ argacces.h evaluatn.h constant.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h utility.h prntutil.h router.h globldef.h \ cstrccom.h globlcom.h globldef.o: globldef.c setup.h envrnmnt.h usrsetup.h memalloc.h \ modulpsr.h symbol.h evaluatn.h constant.h expressn.h exprnops.h \ exprnpsr.h extnfunc.h userdata.h scanner.h pprint.h moduldef.h \ conscomp.h constrct.h symblcmp.h utility.h multifld.h router.h \ prntutil.h strngrtr.h modulutl.h globlbsc.h globlpsr.h globlcom.h \ commline.h bload.h exprnbin.h sysdep.h symblbin.h globlbin.h modulbin.h \ cstrcbin.h globldef.h cstrccom.h globlcmp.h globlpsr.o: globlpsr.c setup.h envrnmnt.h usrsetup.h pprint.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h symblcmp.h modulpsr.h utility.h memalloc.h multifld.h watch.h \ modulutl.h cstrcpsr.h globldef.h cstrccom.h globlbsc.h bload.h \ exprnbin.h sysdep.h symblbin.h globlpsr.h immthpsr.o: immthpsr.c setup.h envrnmnt.h usrsetup.h classcom.h \ cstrccom.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h cstrnutl.h genrcpsr.h genrcfun.h prccode.h \ immthpsr.h incrrset.o: incrrset.c setup.h envrnmnt.h usrsetup.h agenda.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h utility.h symblcmp.h constrnt.h cstrccom.h network.h \ match.h pattern.h reorder.h argacces.h drive.h engine.h lgcldpnd.h \ retract.h router.h prntutil.h incrrset.h inherpsr.o: inherpsr.c setup.h envrnmnt.h usrsetup.h classcom.h \ cstrccom.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h modulutl.h router.h prntutil.h inherpsr.h inscom.o: inscom.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h classcom.h cstrccom.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classinf.h insfile.h insfun.h insmngr.h insmoddp.h insmult.h \ inspsr.h lgcldpnd.h memalloc.h msgcom.h msgpass.h msgfun.h router.h \ prntutil.h strngrtr.h sysdep.h commline.h inscom.h insfile.o: insfile.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h classcom.h cstrccom.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h router.h \ prntutil.h strngrtr.h symblbin.h sysdep.h factmngr.h facthsh.h \ tmpltdef.h factbld.h insfile.h insfun.o: insfun.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h classcom.h cstrccom.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnchk.h engine.h lgcldpnd.h retract.h inscom.h insfun.h \ insmngr.h memalloc.h modulutl.h msgcom.h msgpass.h msgfun.h prccode.h \ router.h prntutil.h drive.h objrtmch.h insmngr.o: insmngr.c setup.h envrnmnt.h usrsetup.h network.h match.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h pattern.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h drive.h objrtmch.h object.h multifld.h \ lgcldpnd.h classcom.h classfun.h engine.h retract.h memalloc.h insfun.h \ modulutl.h msgcom.h msgpass.h msgfun.h prccode.h router.h prntutil.h \ insmngr.h inscom.h watch.h insmoddp.o: insmoddp.c setup.h envrnmnt.h usrsetup.h network.h match.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h pattern.h reorder.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h objrtmch.h object.h multifld.h \ argacces.h memalloc.h inscom.h insfun.h insmngr.h inspsr.h miscfun.h \ msgcom.h msgpass.h msgfun.h prccode.h router.h prntutil.h insmoddp.h insmult.o: insmult.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h insfun.h object.h constrnt.h multifld.h match.h \ network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h msgfun.h \ msgpass.h multifun.h router.h prntutil.h insmult.h inspsr.o: inspsr.c setup.h envrnmnt.h usrsetup.h classcom.h cstrccom.h \ moduldef.h conscomp.h constrct.h symbol.h userdata.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h multifld.h \ match.h network.h ruledef.h agenda.h pattern.h reorder.h classfun.h \ classinf.h prntutil.h router.h inspsr.h insquery.o: insquery.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h multifld.h match.h network.h ruledef.h agenda.h \ pattern.h reorder.h classfun.h memalloc.h insfun.h insmngr.h insqypsr.h \ prcdrfun.h router.h prntutil.h insquery.h insqypsr.o: insqypsr.c setup.h envrnmnt.h usrsetup.h classcom.h \ cstrccom.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ insquery.h prcdrpsr.h prntutil.h router.h strngrtr.h insqypsr.h iofun.o: iofun.c setup.h envrnmnt.h usrsetup.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symbol.h userdata.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h strngrtr.h filertr.h \ argacces.h memalloc.h commline.h sysdep.h iofun.h lgcldpnd.o: lgcldpnd.c setup.h envrnmnt.h usrsetup.h memalloc.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h engine.h lgcldpnd.h \ match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h pattern.h \ reorder.h retract.h reteutil.h argacces.h factmngr.h facthsh.h \ multifld.h tmpltdef.h factbld.h insfun.h object.h main.o: main.c setup.h envrnmnt.h usrsetup.h sysdep.h extnfunc.h symbol.h \ expressn.h exprnops.h exprnpsr.h scanner.h pprint.h userdata.h \ commline.h memalloc.o: memalloc.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h miscfun.o: miscfun.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h memalloc.h multifld.h router.h prntutil.h sysdep.h \ dffnxfun.h cstrccom.h miscfun.h modulbin.o: modulbin.c setup.h envrnmnt.h usrsetup.h memalloc.h \ constrct.h moduldef.h conscomp.h extnfunc.h symbol.h expressn.h \ exprnops.h exprnpsr.h scanner.h pprint.h userdata.h symblcmp.h \ modulpsr.h evaluatn.h constant.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h modulbin.h modulbsc.o: modulbsc.c setup.h envrnmnt.h usrsetup.h constrct.h \ moduldef.h conscomp.h extnfunc.h symbol.h expressn.h exprnops.h \ exprnpsr.h scanner.h pprint.h userdata.h symblcmp.h modulpsr.h \ evaluatn.h constant.h utility.h modulbin.h prntutil.h modulcmp.h \ router.h argacces.h bload.h exprnbin.h sysdep.h symblbin.h modulbsc.h modulcmp.o: modulcmp.c setup.h envrnmnt.h usrsetup.h conscomp.h \ constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h constant.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h \ pprint.h utility.h symblcmp.h sysdep.h modulcmp.h moduldef.o: moduldef.c setup.h envrnmnt.h usrsetup.h memalloc.h \ constant.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h \ argacces.h modulcmp.h modulbsc.h bload.h exprnbin.h sysdep.h symblbin.h \ modulbin.h modulpsr.o: modulpsr.c setup.h envrnmnt.h usrsetup.h memalloc.h \ constant.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h \ argacces.h cstrcpsr.h modulutl.h bload.h exprnbin.h sysdep.h symblbin.h modulutl.o: modulutl.c setup.h envrnmnt.h usrsetup.h memalloc.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h modulutl.h msgcom.o: msgcom.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h classcom.h cstrccom.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classinf.h insfun.h insmoddp.h msgfun.h msgpass.h prccode.h \ router.h prntutil.h bload.h exprnbin.h sysdep.h symblbin.h msgpsr.h \ watch.h msgcom.h msgfun.o: msgfun.c setup.h envrnmnt.h usrsetup.h classcom.h cstrccom.h \ moduldef.h conscomp.h constrct.h symbol.h userdata.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h multifld.h \ match.h network.h ruledef.h agenda.h pattern.h reorder.h classfun.h \ memalloc.h insfun.h msgcom.h msgpass.h prccode.h router.h prntutil.h \ msgfun.h msgpass.o: msgpass.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h classcom.h cstrccom.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h memalloc.h insfun.h msgcom.h msgpass.h msgfun.h prcdrfun.h \ prccode.h proflfun.h router.h prntutil.h strngfun.h commline.h inscom.h msgpsr.o: msgpsr.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h classcom.h cstrccom.h \ moduldef.h conscomp.h constrct.h evaluatn.h constant.h symblcmp.h \ modulpsr.h object.h constrnt.h multifld.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h memalloc.h cstrcpsr.h \ cstrnchk.h insfun.h msgcom.h msgpass.h msgfun.h prccode.h router.h \ prntutil.h strngrtr.h msgpsr.h multifld.o: multifld.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h evaluatn.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h router.h prntutil.h moduldef.h \ conscomp.h constrct.h symblcmp.h modulpsr.h utility.h strngrtr.h \ object.h constrnt.h multifld.h match.h network.h ruledef.h cstrccom.h \ agenda.h pattern.h reorder.h multifun.o: multifun.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h multifld.h \ multifun.h prcdrpsr.h constrnt.h prcdrfun.h router.h prntutil.h \ object.h match.h network.h ruledef.h cstrccom.h agenda.h pattern.h \ reorder.h objbin.o: objbin.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h bsave.h classcom.h cstrccom.h \ moduldef.h conscomp.h constrct.h evaluatn.h constant.h symblcmp.h \ modulpsr.h object.h constrnt.h multifld.h match.h network.h ruledef.h \ agenda.h pattern.h reorder.h classfun.h classini.h cstrcbin.h \ cstrnbin.h insfun.h memalloc.h modulbin.h msgcom.h msgpass.h msgfun.h \ prntutil.h router.h objbin.h objcmp.o: objcmp.c setup.h envrnmnt.h usrsetup.h conscomp.h constrct.h \ moduldef.h modulpsr.h symbol.h evaluatn.h constant.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h pprint.h \ utility.h symblcmp.h classcom.h cstrccom.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h classini.h cstrncmp.h objrtfnx.h objrtmch.h sysdep.h \ objcmp.h objrtbin.o: objrtbin.c setup.h envrnmnt.h usrsetup.h bload.h utility.h \ extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h \ userdata.h exprnbin.h sysdep.h symblbin.h bsave.h memalloc.h insfun.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h object.h constrnt.h multifld.h match.h network.h ruledef.h \ cstrccom.h agenda.h pattern.h reorder.h objrtmch.h reteutil.h rulebin.h \ modulbin.h cstrcbin.h objrtbin.h objrtbld.o: objrtbld.c setup.h envrnmnt.h usrsetup.h classcom.h \ cstrccom.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h cstrnutl.h cstrnchk.h cstrnops.h drive.h inscom.h insfun.h \ insmngr.h memalloc.h reteutil.h rulepsr.h objrtmch.h objrtgen.h \ objrtfnx.h router.h prntutil.h objrtcmp.h objrtbin.h objrtbld.h objrtcmp.o: objrtcmp.c setup.h envrnmnt.h usrsetup.h conscomp.h \ constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h constant.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h \ pprint.h utility.h symblcmp.h objrtfnx.h object.h constrnt.h multifld.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ objrtmch.h sysdep.h objrtcmp.h objrtfnx.o: objrtfnx.c setup.h envrnmnt.h usrsetup.h classcom.h \ cstrccom.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h object.h constrnt.h \ multifld.h match.h network.h ruledef.h agenda.h pattern.h reorder.h \ classfun.h bload.h exprnbin.h sysdep.h symblbin.h drive.h engine.h \ lgcldpnd.h retract.h memalloc.h objrtmch.h reteutil.h router.h \ prntutil.h objrtfnx.h objrtgen.o: objrtgen.c setup.h envrnmnt.h usrsetup.h classfun.h object.h \ constrct.h moduldef.h conscomp.h extnfunc.h symbol.h expressn.h \ exprnops.h exprnpsr.h scanner.h pprint.h userdata.h symblcmp.h \ modulpsr.h evaluatn.h constant.h utility.h constrnt.h multifld.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ objrtfnx.h objrtmch.h objrtgen.h objrtmch.o: objrtmch.c setup.h envrnmnt.h usrsetup.h classfun.h object.h \ constrct.h moduldef.h conscomp.h extnfunc.h symbol.h expressn.h \ exprnops.h exprnpsr.h scanner.h pprint.h userdata.h symblcmp.h \ modulpsr.h evaluatn.h constant.h utility.h constrnt.h multifld.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ memalloc.h drive.h engine.h lgcldpnd.h retract.h incrrset.h reteutil.h \ ruledlt.h router.h prntutil.h objrtfnx.h objrtmch.h insmngr.h parsefun.o: parsefun.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h memalloc.h \ multifld.h prcdrpsr.h constrnt.h router.h prntutil.h strngrtr.h \ parsefun.h pattern.o: pattern.c setup.h envrnmnt.h usrsetup.h constant.h constrnt.h \ evaluatn.h symbol.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ userdata.h scanner.h pprint.h cstrnchk.h cstrnutl.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h utility.h \ symblcmp.h cstrccom.h agenda.h pattern.h reorder.h memalloc.h \ reteutil.h router.h prntutil.h rulecmp.h pprint.o: pprint.c setup.h envrnmnt.h usrsetup.h constant.h memalloc.h \ utility.h pprint.h prccode.o: prccode.c setup.h envrnmnt.h usrsetup.h memalloc.h constant.h \ globlpsr.h expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h \ userdata.h scanner.h pprint.h multifld.h evaluatn.h object.h constrct.h \ moduldef.h conscomp.h symblcmp.h modulpsr.h utility.h constrnt.h \ match.h network.h ruledef.h cstrccom.h agenda.h pattern.h reorder.h \ prcdrpsr.h router.h prntutil.h prccode.h prcdrfun.o: prcdrfun.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h memalloc.h multifld.h prcdrpsr.h router.h prntutil.h \ prcdrfun.h globldef.h cstrccom.h prcdrpsr.o: prcdrpsr.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h constrnt.h cstrnchk.h \ cstrnops.h cstrnutl.h memalloc.h modulutl.h multifld.h router.h \ prntutil.h prcdrpsr.h globldef.h cstrccom.h globlpsr.h prdctfun.o: prdctfun.c setup.h envrnmnt.h usrsetup.h exprnpsr.h \ extnfunc.h symbol.h expressn.h exprnops.h userdata.h scanner.h pprint.h \ argacces.h evaluatn.h constant.h moduldef.h conscomp.h constrct.h \ symblcmp.h modulpsr.h utility.h multifld.h router.h prntutil.h \ prdctfun.h prntutil.o: prntutil.c setup.h envrnmnt.h usrsetup.h constant.h symbol.h \ utility.h evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ userdata.h scanner.h pprint.h argacces.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h router.h prntutil.h multifun.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h multifld.h tmpltdef.h factbld.h inscom.h \ object.h insfun.h insmngr.h memalloc.h proflfun.o: proflfun.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h classcom.h cstrccom.h \ object.h constrnt.h multifld.h match.h network.h ruledef.h agenda.h \ pattern.h reorder.h dffnxfun.h genrccom.h genrcfun.h memalloc.h \ msgcom.h msgpass.h router.h prntutil.h sysdep.h proflfun.h reorder.o: reorder.c setup.h envrnmnt.h usrsetup.h cstrnutl.h constrnt.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h memalloc.h pattern.h match.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h cstrccom.h agenda.h reorder.h prntutil.h router.h \ rulelhs.h reteutil.o: reteutil.c setup.h envrnmnt.h usrsetup.h drive.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ match.h evaluatn.h constant.h network.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h engine.h lgcldpnd.h retract.h incrrset.h \ memalloc.h router.h prntutil.h reteutil.h retract.o: retract.c setup.h envrnmnt.h usrsetup.h agenda.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h utility.h symblcmp.h constrnt.h cstrccom.h network.h \ match.h pattern.h reorder.h argacces.h drive.h engine.h lgcldpnd.h \ retract.h memalloc.h reteutil.h router.h prntutil.h router.o: router.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h filertr.h memalloc.h strngrtr.h sysdep.h router.h \ prntutil.h rulebin.o: rulebin.c setup.h envrnmnt.h usrsetup.h memalloc.h bload.h \ utility.h extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h \ scanner.h pprint.h userdata.h exprnbin.h sysdep.h symblbin.h bsave.h \ reteutil.h evaluatn.h constant.h match.h network.h ruledef.h conscomp.h \ constrct.h moduldef.h modulpsr.h symblcmp.h constrnt.h cstrccom.h \ agenda.h pattern.h reorder.h engine.h lgcldpnd.h retract.h rulebsc.h \ rulebin.h modulbin.h cstrcbin.h rulebld.o: rulebld.c setup.h envrnmnt.h usrsetup.h constant.h constrct.h \ moduldef.h conscomp.h extnfunc.h symbol.h expressn.h exprnops.h \ exprnpsr.h scanner.h pprint.h userdata.h symblcmp.h modulpsr.h \ evaluatn.h utility.h drive.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h pattern.h reorder.h incrrset.h memalloc.h \ reteutil.h router.h prntutil.h rulebld.h watch.h rulebsc.o: rulebsc.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h router.h prntutil.h watch.h ruledef.h constrnt.h \ cstrccom.h agenda.h match.h network.h pattern.h reorder.h engine.h \ lgcldpnd.h retract.h rulebin.h modulbin.h cstrcbin.h rulecmp.h \ rulebsc.h rulecmp.o: rulecmp.c setup.h envrnmnt.h usrsetup.h factbld.h pattern.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h match.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h reorder.h reteutil.h rulecmp.h rulecom.o: rulecom.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h crstrtgy.h agenda.h ruledef.h constrnt.h \ cstrccom.h network.h match.h pattern.h reorder.h engine.h lgcldpnd.h \ retract.h incrrset.h memalloc.h reteutil.h router.h prntutil.h \ ruledlt.h watch.h rulebin.h modulbin.h cstrcbin.h rulecom.h rulecstr.o: rulecstr.c setup.h envrnmnt.h usrsetup.h analysis.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h reorder.h ruledef.h conscomp.h constrct.h moduldef.h \ modulpsr.h evaluatn.h constant.h utility.h symblcmp.h constrnt.h \ cstrccom.h agenda.h match.h network.h pattern.h cstrnchk.h cstrnops.h \ cstrnutl.h prcdrpsr.h router.h prntutil.h rulepsr.h rulecstr.h ruledef.o: ruledef.c setup.h envrnmnt.h usrsetup.h agenda.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h utility.h symblcmp.h constrnt.h cstrccom.h network.h \ match.h pattern.h reorder.h drive.h engine.h lgcldpnd.h retract.h \ memalloc.h rulebsc.h rulecom.h rulepsr.h ruledlt.h bload.h exprnbin.h \ sysdep.h symblbin.h rulebin.h modulbin.h cstrcbin.h rulecmp.h ruledlt.o: ruledlt.c setup.h envrnmnt.h usrsetup.h memalloc.h engine.h \ lgcldpnd.h match.h evaluatn.h constant.h symbol.h expressn.h exprnops.h \ exprnpsr.h extnfunc.h userdata.h scanner.h pprint.h network.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h utility.h symblcmp.h \ constrnt.h cstrccom.h agenda.h pattern.h reorder.h retract.h reteutil.h \ drive.h bload.h exprnbin.h sysdep.h symblbin.h ruledlt.h rulelhs.o: rulelhs.c setup.h envrnmnt.h usrsetup.h agenda.h ruledef.h \ conscomp.h constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h \ constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h utility.h symblcmp.h constrnt.h cstrccom.h network.h \ match.h pattern.h reorder.h argacces.h cstrnchk.h memalloc.h router.h \ prntutil.h rulelhs.h rulepsr.o: rulepsr.c setup.h envrnmnt.h usrsetup.h analysis.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ reorder.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ evaluatn.h constant.h utility.h symblcmp.h constrnt.h cstrccom.h \ agenda.h match.h network.h pattern.h cstrcpsr.h cstrnchk.h cstrnops.h \ engine.h lgcldpnd.h retract.h incrrset.h memalloc.h prccode.h \ prcdrpsr.h router.h prntutil.h rulebld.h rulebsc.h rulecstr.h ruledlt.h \ rulelhs.h watch.h tmpltfun.h factmngr.h facthsh.h multifld.h tmpltdef.h \ factbld.h bload.h exprnbin.h sysdep.h symblbin.h rulepsr.h scanner.o: scanner.c setup.h envrnmnt.h usrsetup.h constant.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h \ pprint.h symblcmp.h modulpsr.h utility.h memalloc.h sortfun.o: sortfun.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h dffnxfun.h cstrccom.h memalloc.h multifld.h \ sysdep.h sortfun.h strngfun.o: strngfun.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h cstrcpsr.h engine.h \ lgcldpnd.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ pattern.h reorder.h retract.h memalloc.h prcdrpsr.h router.h prntutil.h \ strngrtr.h drive.h strngfun.h strngrtr.o: strngrtr.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h router.h prntutil.h moduldef.h conscomp.h constrct.h \ symbol.h userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h scanner.h pprint.h symblcmp.h modulpsr.h utility.h \ strngrtr.h symblbin.o: symblbin.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h bload.h exprnbin.h sysdep.h \ symblbin.h bsave.h cstrnbin.h constrnt.h memalloc.h router.h prntutil.h symblcmp.o: symblcmp.c setup.h envrnmnt.h usrsetup.h symbol.h memalloc.h \ constant.h exprnpsr.h extnfunc.h expressn.h exprnops.h userdata.h \ scanner.h pprint.h cstrccom.h moduldef.h conscomp.h constrct.h \ evaluatn.h symblcmp.h modulpsr.h utility.h argacces.h cstrncmp.h \ constrnt.h router.h prntutil.h sysdep.h symbol.o: symbol.c setup.h envrnmnt.h usrsetup.h constant.h memalloc.h \ router.h prntutil.h moduldef.h conscomp.h constrct.h symbol.h \ userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h argacces.h sysdep.o: sysdep.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h bmathfun.h commline.h constrnt.h cstrcpsr.h \ emathfun.h filecom.h iofun.h memalloc.h miscfun.h multifld.h multifun.h \ parsefun.h prccode.h prdctfun.h proflfun.h prcdrfun.h router.h \ prntutil.h sortfun.h strngfun.h textpro.h watch.h sysdep.h dffctdef.h \ cstrccom.h ruledef.h agenda.h match.h network.h pattern.h reorder.h \ genrccom.h genrcfun.h object.h dffnxfun.h globldef.h tmpltdef.h \ factbld.h factmngr.h facthsh.h classini.h ed.h textpro.o: textpro.c setup.h envrnmnt.h usrsetup.h argacces.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h \ evaluatn.h constant.h moduldef.h conscomp.h constrct.h symblcmp.h \ modulpsr.h utility.h commline.h memalloc.h router.h prntutil.h sysdep.h \ textpro.h tmpltbin.o: tmpltbin.c setup.h envrnmnt.h usrsetup.h memalloc.h bload.h \ utility.h extnfunc.h symbol.h expressn.h exprnops.h exprnpsr.h \ scanner.h pprint.h userdata.h exprnbin.h sysdep.h symblbin.h bsave.h \ factbin.h factbld.h pattern.h evaluatn.h constant.h match.h network.h \ ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h symblcmp.h \ constrnt.h cstrccom.h agenda.h reorder.h cstrnbin.h factmngr.h \ facthsh.h multifld.h tmpltdef.h tmpltpsr.h tmpltutl.h tmpltbin.h \ cstrcbin.h modulbin.h tmpltbsc.o: tmpltbsc.c setup.h envrnmnt.h usrsetup.h argacces.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h evaluatn.h constant.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h memalloc.h router.h \ prntutil.h cstrccom.h factrhs.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h constrnt.h agenda.h reorder.h multifld.h tmpltdef.h \ factbld.h cstrcpsr.h tmpltpsr.h tmpltbin.h cstrcbin.h modulbin.h \ tmpltcmp.h tmpltutl.h tmpltbsc.h tmpltcmp.o: tmpltcmp.c setup.h envrnmnt.h usrsetup.h conscomp.h \ constrct.h moduldef.h modulpsr.h symbol.h evaluatn.h constant.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h \ pprint.h utility.h symblcmp.h factcmp.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h cstrncmp.h \ tmpltdef.h factbld.h factmngr.h facthsh.h multifld.h tmpltcmp.h tmpltdef.o: tmpltdef.c setup.h envrnmnt.h usrsetup.h memalloc.h \ exprnops.h expressn.h exprnpsr.h extnfunc.h symbol.h userdata.h \ scanner.h pprint.h cstrccom.h moduldef.h conscomp.h constrct.h \ evaluatn.h constant.h symblcmp.h modulpsr.h utility.h network.h match.h \ pattern.h reorder.h ruledef.h constrnt.h agenda.h tmpltpsr.h tmpltdef.h \ factbld.h factmngr.h facthsh.h multifld.h tmpltbsc.h tmpltutl.h \ tmpltfun.h router.h prntutil.h modulutl.h cstrnchk.h bload.h exprnbin.h \ sysdep.h symblbin.h tmpltbin.h cstrcbin.h modulbin.h tmpltcmp.h tmpltfun.o: tmpltfun.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h symbol.h scanner.h pprint.h exprnpsr.h extnfunc.h expressn.h \ exprnops.h userdata.h argacces.h evaluatn.h moduldef.h conscomp.h \ constrct.h symblcmp.h modulpsr.h utility.h router.h prntutil.h \ cstrnchk.h constrnt.h default.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h cstrccom.h agenda.h reorder.h multifld.h tmpltdef.h \ factbld.h commline.h factrhs.h modulutl.h tmpltlhs.h tmpltutl.h \ tmpltrhs.h tmpltfun.h tmpltlhs.o: tmpltlhs.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h symbol.h scanner.h pprint.h exprnpsr.h extnfunc.h expressn.h \ exprnops.h userdata.h router.h prntutil.h moduldef.h conscomp.h \ constrct.h evaluatn.h symblcmp.h modulpsr.h utility.h constrnt.h \ reorder.h ruledef.h cstrccom.h agenda.h match.h network.h pattern.h \ factrhs.h factmngr.h facthsh.h multifld.h tmpltdef.h factbld.h \ modulutl.h tmpltutl.h tmpltlhs.h tmpltpsr.o: tmpltpsr.c setup.h envrnmnt.h usrsetup.h constant.h \ memalloc.h symbol.h scanner.h pprint.h exprnpsr.h extnfunc.h expressn.h \ exprnops.h userdata.h router.h prntutil.h moduldef.h conscomp.h \ constrct.h evaluatn.h symblcmp.h modulpsr.h utility.h factmngr.h \ facthsh.h pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h \ agenda.h reorder.h multifld.h tmpltdef.h factbld.h cstrnchk.h \ cstrnpsr.h cstrcpsr.h bload.h exprnbin.h sysdep.h symblbin.h default.h \ watch.h cstrnutl.h tmpltbsc.h tmpltpsr.h tmpltrhs.o: tmpltrhs.c setup.h envrnmnt.h usrsetup.h memalloc.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h router.h tmpltfun.h \ factmngr.h facthsh.h pattern.h match.h network.h ruledef.h constrnt.h \ cstrccom.h agenda.h reorder.h multifld.h tmpltdef.h factbld.h factrhs.h \ modulutl.h default.h tmpltutl.h tmpltlhs.h tmpltrhs.h tmpltutl.o: tmpltutl.c setup.h envrnmnt.h usrsetup.h extnfunc.h symbol.h \ expressn.h exprnops.h exprnpsr.h scanner.h pprint.h userdata.h \ memalloc.h constrct.h moduldef.h conscomp.h symblcmp.h modulpsr.h \ evaluatn.h constant.h utility.h router.h prntutil.h argacces.h \ cstrnchk.h constrnt.h tmpltfun.h factmngr.h facthsh.h pattern.h match.h \ network.h ruledef.h cstrccom.h agenda.h reorder.h multifld.h tmpltdef.h \ factbld.h tmpltpsr.h modulutl.h watch.h tmpltbsc.h tmpltutl.h userdata.o: userdata.c setup.h envrnmnt.h usrsetup.h userdata.h userfunctions.o: userfunctions.c setup.h envrnmnt.h usrsetup.h extnfunc.h \ symbol.h expressn.h exprnops.h exprnpsr.h scanner.h pprint.h userdata.h utility.o: utility.c setup.h envrnmnt.h usrsetup.h evaluatn.h constant.h \ symbol.h expressn.h exprnops.h exprnpsr.h extnfunc.h userdata.h \ scanner.h pprint.h facthsh.h factmngr.h conscomp.h constrct.h \ moduldef.h modulpsr.h utility.h symblcmp.h pattern.h match.h network.h \ ruledef.h constrnt.h cstrccom.h agenda.h reorder.h multifld.h \ tmpltdef.h factbld.h memalloc.h prntutil.h watch.o: watch.c setup.h envrnmnt.h usrsetup.h constant.h memalloc.h \ router.h prntutil.h moduldef.h conscomp.h constrct.h symbol.h \ userdata.h evaluatn.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h argacces.h watch.h xclips.o: xclips.c xsetup.h xclips.h \ xmenu.h xmenu_wind.h xmenu_opt.h xclipstext.h xmain.h setup.h \ envrnmnt.h usrsetup.h agenda.h ruledef.h conscomp.h constrct.h \ moduldef.h modulpsr.h symbol.h evaluatn.h constant.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h pprint.h \ utility.h symblcmp.h constrnt.h cstrccom.h network.h match.h pattern.h \ reorder.h bmathfun.h classcom.h object.h multifld.h commline.h \ crstrtgy.h defins.h dffctdef.h dffnxfun.h engine.h lgcldpnd.h retract.h \ facthsh.h factmngr.h tmpltdef.h factbld.h filecom.h genrccom.h \ genrcfun.h globlcom.h globldef.h incrrset.h inscom.h insfun.h router.h \ prntutil.h xclipstext.o: xclipstext.c setup.h envrnmnt.h usrsetup.h commline.h \ evaluatn.h constant.h symbol.h expressn.h exprnops.h exprnpsr.h \ extnfunc.h userdata.h scanner.h pprint.h filertr.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h utility.h \ xclips.h xedit.h xmenu_file.h xmenu_exec.h xmenu_wind.h xclipstext.h \ xmain.h xedit.o: xedit.c setup.h \ envrnmnt.h usrsetup.h clips.h argacces.h expressn.h exprnops.h \ exprnpsr.h extnfunc.h symbol.h userdata.h scanner.h pprint.h evaluatn.h \ constant.h moduldef.h conscomp.h constrct.h symblcmp.h modulpsr.h \ utility.h memalloc.h cstrcpsr.h filecom.h \ strngfun.h commline.h router.h prntutil.h sysdep.h bmathfun.h watch.h \ modulbsc.h bload.h exprnbin.h symblbin.h bsave.h ruledef.h constrnt.h \ cstrccom.h agenda.h match.h network.h pattern.h reorder.h rulebsc.h \ engine.h lgcldpnd.h retract.h drive.h incrrset.h rulecom.h crstrtgy.h \ dffctdef.h dffctbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h \ multifld.h tmpltbsc.h factcom.h factfun.h globldef.h globlbsc.h \ globlcom.h dffnxfun.h genrccom.h genrcfun.h object.h classcom.h \ classexm.h classinf.h classini.h defins.h inscom.h insfun.h insfile.h \ msgcom.h msgpass.h objrtmch.h xsetup.h xclips.h \ xedit.h xmain.h xmenu.h xmenu_file.h xclipstext.h xmain.o: xmain.c setup.h envrnmnt.h usrsetup.h sysdep.h commline.h \ symbol.h xmain.h xmenu_file.h xclipstext.h xmenu.h xclips.h xmenu.o: xmenu.c setup.h envrnmnt.h \ usrsetup.h constrct.h moduldef.h conscomp.h extnfunc.h symbol.h \ expressn.h exprnops.h exprnpsr.h scanner.h pprint.h userdata.h \ symblcmp.h modulpsr.h evaluatn.h constant.h utility.h filecom.h \ xsetup.h xclips.h \ xmenu.h xedit.h xclipstext.h xmenu_wind.h xmenu_exec.h xmenu_file.h \ xmenu_watch.h xmenu_opt.h xmain.h xmenu_exec.o: xmenu_exec.c xsetup.h xclipstext.h \ xmenu_exec.h xmain.h xmenu.h setup.h envrnmnt.h usrsetup.h router.h \ prntutil.h moduldef.h conscomp.h constrct.h symbol.h userdata.h \ evaluatn.h constant.h expressn.h exprnops.h exprnpsr.h extnfunc.h \ scanner.h pprint.h symblcmp.h modulpsr.h utility.h factmngr.h facthsh.h \ pattern.h match.h network.h ruledef.h constrnt.h cstrccom.h agenda.h \ reorder.h multifld.h tmpltdef.h factbld.h commline.h xmenu_file.o: xmenu_file.c setup.h \ envrnmnt.h usrsetup.h constant.h commline.h router.h prntutil.h \ moduldef.h conscomp.h constrct.h symbol.h userdata.h evaluatn.h \ expressn.h exprnops.h exprnpsr.h extnfunc.h scanner.h pprint.h \ symblcmp.h modulpsr.h utility.h xsetup.h \ xclips.h xclipstext.h xmenu.h xmain.h \ xmenu_file.h xmenu_wind.h xmenu_opt.o: xmenu_opt.c xsetup.h xclips.h \ xmenu.h xmenu_opt.h xclipstext.h xmain.h setup.h envrnmnt.h usrsetup.h \ engine.h lgcldpnd.h match.h evaluatn.h constant.h symbol.h expressn.h \ exprnops.h exprnpsr.h extnfunc.h userdata.h scanner.h pprint.h \ network.h ruledef.h conscomp.h constrct.h moduldef.h modulpsr.h \ utility.h symblcmp.h constrnt.h cstrccom.h agenda.h pattern.h reorder.h \ retract.h crstrtgy.h commline.h router.h prntutil.h globlcom.h \ facthsh.h factmngr.h multifld.h tmpltdef.h factbld.h bmathfun.h \ incrrset.h xmenu_watch.o: xmenu_watch.c xclips.h setup.h envrnmnt.h usrsetup.h \ constant.h watch.h expressn.h exprnops.h exprnpsr.h extnfunc.h symbol.h \ userdata.h scanner.h pprint.h xmain.h xmenu.h xmenu_watch.h xmenu_wind.o: xmenu_wind.c setup.h envrnmnt.h \ usrsetup.h agenda.h ruledef.h conscomp.h constrct.h moduldef.h \ modulpsr.h symbol.h evaluatn.h constant.h expressn.h exprnops.h \ exprnpsr.h extnfunc.h userdata.h scanner.h pprint.h utility.h \ symblcmp.h constrnt.h cstrccom.h network.h match.h pattern.h reorder.h \ globldef.h genrcfun.h object.h multifld.h defins.h classcom.h \ commline.h dffctdef.h dffnxfun.h engine.h lgcldpnd.h retract.h \ genrccom.h insfun.h msgcom.h msgpass.h router.h prntutil.h rulebsc.h \ tmpltbsc.h tmpltdef.h factbld.h factmngr.h facthsh.h xsetup.h \ xmenu_wind.h xclips.h xmain.h xmenu_file.h xclipstext.h clips-6.24/x-prjct/makefile/._makefile.x0000400000175000017500000000012210440722665016223 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/.DS_Store0000644000175000017500000001400410444324564013764 0ustar jfsjfsBud1 rIlocblobcolorIlocblob_colordsclboolmakefileIlocblobmakefiledsclboolmakefileicspblob xinterfaceIlocblob xinterfacedsclbool xinterfaceicspblob  @ @ @ @ E DSDB ` @ @ @clips-6.24/x-prjct/xinterface/0000755000175000017500000000000010444324511014422 5ustar jfsjfsclips-6.24/x-prjct/xinterface/xmenu_watch.c0000755000175000017500000002505010444323570017121 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_WATCH MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #include #include "xsetup.h" #include "xclips.h" #include "setup.h" #include "constant.h" #include "watch.h" #include "xmain.h" #include "xmenu.h" #include "xmenu_watch.h" /******* Global variables ***********/ char *WatchName[MAX_WATCH] = {"compilations","facts","rules","statistics","activations", "focus","globals","deffunctions","generic-functions","methods", "instances","slots","message-handlers","messages"}; Widget watchShell = NULL,watchForm = NULL; Widget watch_widgets[MAX_WATCH]; /******************************************************************************* Name: WatchWindow Description: Creates Watch menu arguments: Returns: None *******************************************************************************/ void WatchWindow( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); int n = 0,i; Widget Okay,cancel,All,none; static char *WidgetName[MAX_WATCH] = {"Compilations","Facts","Rules","Statistics","Activations", "Focus","Globals","Deffunctions","Generic Functions","Methods", "Instances","Slots","Messages-handlers","Messages"}; /* ====================================================== */ /* If the watch shell have already existed pop it up, */ /* else create it. */ /* ====================================================== */ if(watchShell != NULL) { for(i = 0; i < MAX_WATCH; i++) { n = 0; if (EnvGetWatchItem(theEnv,WatchName[i])) XtSetArg( TheArgs[n],XtNstate,True); else XtSetArg( TheArgs[n],XtNstate,False); n++; XtSetValues(watch_widgets[i],TheArgs,n); } XtPopup(watchShell,XtGrabExclusive); return; } /* ========================================= */ /* Create the watch toggle menu */ /* ========================================= */ XtSetArg( TheArgs[n], XtNwidth,250);n++; XtSetArg( TheArgs[n], XtNheight,400);n++; watchShell = XtCreatePopupShell("Watch Menu",topLevelShellWidgetClass,XtParent(w),NULL,0); n = 0; watchForm = XtCreateManagedWidget( "watch_form", formWidgetClass, watchShell, TheArgs,n); n = 0; XtSetArg(TheArgs[n],XtNwidth,150);n++; XtSetArg(TheArgs[n],XtNhorizDistance,15);n++; for(i = 0; i < 7;i++) { if (EnvGetWatchItem(theEnv,WatchName[i])) XtSetArg( TheArgs[n],XtNstate,True); else XtSetArg( TheArgs[n],XtNstate,False); n++; watch_widgets[i] = XtCreateManagedWidget(WidgetName[i], toggleWidgetClass, watchForm, TheArgs, n); n = 2; XtSetArg(TheArgs[n],XtNfromVert,watch_widgets[i]);n++; } n = 1; XtSetArg(TheArgs[n],XtNfromHoriz,watch_widgets[0]);n++; for(; i < MAX_WATCH ; i++) { if (EnvGetWatchItem(theEnv,WatchName[i])) XtSetArg( TheArgs[n],XtNstate,True); else XtSetArg( TheArgs[n],XtNstate,False); n++; watch_widgets[i] = XtCreateManagedWidget(WidgetName[i], toggleWidgetClass, watchForm, TheArgs, n); n = 1; XtSetArg(TheArgs[n],XtNfromVert,watch_widgets[i]);n++; XtSetArg(TheArgs[n],XtNfromHoriz,watch_widgets[i - 7]);n++; } /* ======================= */ /* Create the "All" button */ /* ======================= */ n = 0; XtSetArg(TheArgs[n],XtNcornerRoundPercent,40);n++; XtSetArg(TheArgs[n],XtNshapeStyle,XmuShapeRoundedRectangle);n++; XtSetArg(TheArgs[n],XtNwidth,150);n++; XtSetArg(TheArgs[n],XtNfromVert,watch_widgets[6]);n++; XtSetArg(TheArgs[n],XtNvertDistance,31);n++; XtSetArg(TheArgs[n],XtNlabel,"All");n++; All = XtCreateManagedWidget("watchButton", commandWidgetClass, watchForm, TheArgs, n); XtAddCallback(All, XtNcallback, WatchAllCallback, NULL); /* ============================= */ /* Create the "None" button */ /* ============================= */ n = 3; XtSetArg(TheArgs[n],XtNfromHoriz,All);n++; XtSetArg(TheArgs[n],XtNfromVert,watch_widgets[6]);n++; XtSetArg(TheArgs[n],XtNvertDistance,31);n++; XtSetArg(TheArgs[n],XtNhorizDistance,30);n++; XtSetArg(TheArgs[n],XtNlabel,"None");n++; none = XtCreateManagedWidget("watchButton", commandWidgetClass, watchForm,TheArgs,n); XtAddCallback(none, XtNcallback, WatchNoneCallback, NULL); /* ================================ */ /* Create the "Okay" button */ /* ================================ */ n = 3; XtSetArg(TheArgs[n],XtNfromVert,All);n++; XtSetArg(TheArgs[n],XtNvertDistance,15);n++; XtSetArg(TheArgs[n],XtNlabel,"Okay");n++; Okay = XtCreateManagedWidget("watchButton", commandWidgetClass, watchForm, TheArgs, n); XtAddCallback(Okay,XtNcallback,OkWatchCallback,(XtPointer)watchForm); /* ================================ */ /* Create the "Cancel" button */ /* ================================ */ n = 3; XtSetArg(TheArgs[n],XtNfromVert,none);n++; XtSetArg(TheArgs[n],XtNvertDistance,15);n++; XtSetArg(TheArgs[n],XtNfromHoriz,Okay);n++; XtSetArg(TheArgs[n],XtNlabel,"Cancel");n++; XtSetArg(TheArgs[n],XtNhorizDistance,30);n++; cancel = XtCreateManagedWidget("watchButton", commandWidgetClass, watchForm, TheArgs, n); XtAddCallback(cancel,XtNcallback,PopdownSelect,(XtPointer)watchForm); XtPopup(watchShell,XtGrabExclusive); } /************************************************************************** OkWatchCallback Description: This function will reset the watch flags to the new values and remove the watch window from the screen. Arguments: w - widget that event was activated client_data - NULL call_data - Unused Return: None **************************************************************************/ void OkWatchCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); int i,n; Boolean OnOff = False; for(i = 0; i< MAX_WATCH; i++) { n = 0; XtSetArg(TheArgs[n],XtNstate,&OnOff);n++; XtGetValues(watch_widgets[i],TheArgs,n); /*----------------------------------------------------------------*/ /* I have to do this because I am not sure if True and False in X */ /* are defined the same as CLIPS_TRUE and CLIPS_FALSE */ /*----------------------------------------------------------------*/ if((OnOff == True)&&(EnvGetWatchItem(theEnv,WatchName[i])!= CLIPS_TRUE)) { EnvSetWatchItem(theEnv,WatchName[i], ON,NULL); } else if((OnOff == False) && (EnvGetWatchItem(theEnv,WatchName[i]) == CLIPS_TRUE)) { EnvSetWatchItem(theEnv,WatchName[i], OFF,NULL); } } XtPopdown(XtParent(XtParent(w))); quit_get_event = True; } /******************************************************************************* Name: WatchAllCallback Description: Called when Watch All button is activated. It turns all the watch toggle buttons to ON, and the watch flags' values will be reset only when the Okay button is pressed. Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void WatchAllCallback( Widget w, XtPointer client_data, XtPointer call_data) { int i, n = 0; XtSetArg(TheArgs[n],XtNstate,True);n++; for(i = 0;i < MAX_WATCH; i++) { XtSetValues(watch_widgets[i],TheArgs,n); } quit_get_event = True; } /******************************************************************************* Name: WatchNoneCallback Description: Called when Watch None is selected from Watch menu. It turns all the watch toggle buttons to OFF, and the values of the watch flags are resset only when the Okay button is pressed. Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void WatchNoneCallback( Widget w, XtPointer client_data, XtPointer call_data) { int i, n = 0; XtSetArg(TheArgs[n],XtNstate,False);n++; for(i = 0;i < MAX_WATCH ; i++) { XtSetValues(watch_widgets[i],TheArgs,n); } quit_get_event = True; } clips-6.24/x-prjct/xinterface/._xmenu_file.c0000400000175000017500000000012210444323570017123 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/._xedit.h0000400000175000017500000000012210444323575016117 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/._xmenu_opt.c0000400000175000017500000000012210444323570017006 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/.DS_Store0000644000175000017500000003000410444324464016111 0ustar jfsjfsBud1%  @ @ @ @ E%DSDB` @ @ @ E DSDB ` @ @ @clips-6.24/x-prjct/xinterface/xmenu_opt.h0000755000175000017500000000327010444323575016627 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_OPT HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_xmenu_opt #define _H_xmenu_opt void OptionsWindow(Widget,XtPointer,XtPointer); void SetStrategyCallback(Widget,XtPointer,XtPointer); void SetSalienceCallback(Widget,XtPointer,XtPointer); void OkayOptionsCallback(Widget,XtPointer,XtPointer); #ifndef _XMENU_OPT_SOURCE_ extern Widget option_widgets[]; extern Widget strategy_widgets[]; extern Widget sal_opt_widgets[]; #endif #endif clips-6.24/x-prjct/xinterface/xmenu_exec.c0000755000175000017500000002303610444323570016741 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_EXEC MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #include #include "xsetup.h" #include "xclipstext.h" #include "xmenu_exec.h" #include "xmain.h" #include "xmenu.h" #include "setup.h" #include "router.h" #include "factmngr.h" #include "commline.h" /********** local functions not visible outside this file **********/ static void ResetClips(Widget,XtPointer,XtPointer); static void ClearClips(Widget,XtPointer,XtPointer); /******************************************************************************* Name: ResetCallback Description: Called when Reset is selected form Execution menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void ResetCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); MoveEndOfFile(dialog_text, &TheEvent); if(EnvGetNextFact(theEnv,NULL)) { Widget confirmshell, confirm; confirmshell = XtCreatePopupShell("Confirmation", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNlabel, "The fact list\nis not empty!"); XtSetArg(TheArgs[1], XtNicon, clips_logo); confirm = XtCreateManagedWidget("confirm", dialogWidgetClass, confirmshell, TheArgs, 2); XawDialogAddButton(confirm, "Reset", ResetClips, (XtPointer) confirm); XawDialogAddButton(confirm, "Cancel", CancelPopupSelect, (XtPointer) confirm); XtPopup(confirmshell, XtGrabNonexclusive); } else { PrintCLIPS("wclips", "(reset)\n"); SetCommandString(GetCurrentEnvironment(),"(reset)\n"); /* ============================================ */ /* Set this flag to True to break out of the */ /* event loop so CLIPS could process the */ /* command. */ /* ============================================ */ quit_get_event = True; } } /******************************************************************************* Name: RunCallback Description: Called when Run is selected form Execution menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void RunCallback( Widget w, XtPointer client_data, XtPointer call_data) { /* if(CommandLineData(GetCurrentEnvironment())->EvaluatingTopLevelCommand) return;*/ MoveEndOfFile(dialog_text, &TheEvent); PrintCLIPS("wclips", "(run)\n"); SetCommandString(GetCurrentEnvironment(),"(run)\n"); /* ============================================ */ /* Set this flag to True to break out of the */ /* event loop so CLIPS could process the */ /* command. */ /* ============================================ */ quit_get_event = True; } /******************************************************************************* Name: StepCallback Description: Called when Step is selected form Execution menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void StepCallback( Widget w, XtPointer client_data, XtPointer call_data) { /* if(CommandLineData(GetCurrentEnvironment())->EvaluatingTopLevelCommand) return;*/ MoveEndOfFile(dialog_text, &TheEvent); PrintCLIPS("wclips", "(run 1)\n"); SetCommandString(GetCurrentEnvironment(),"(run 1)\n"); /* ============================================ */ /* Set this flag to True to break out of the */ /* event loop so CLIPS could process the */ /* command. */ /* ============================================ */ quit_get_event = True; } /******************************************************************************* Name: ClearCLIPSCallback Description: Called when Clear CLIPS is selected form Execution menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void ClearCLIPSCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget confirmshell, confirm; /* if(CommandLineData(GetCurrentEnvironment())->EvaluatingTopLevelCommand) return;*/ confirmshell = XtCreatePopupShell("Confirmation", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNlabel, "Clear CLIPS!\nAre you sure?"); XtSetArg(TheArgs[1], XtNicon, clips_logo); confirm = XtCreateManagedWidget("confirm", dialogWidgetClass, confirmshell, TheArgs, 2); XawDialogAddButton(confirm, "Clear", ClearClips, (XtPointer) confirm); XawDialogAddButton(confirm, "Cancel", CancelPopupSelect, (XtPointer) confirm); XtPopup(confirmshell, XtGrabNonexclusive); /* ============================================ */ /* Set this flag to True to break out of the */ /* event loop so CLIPS could process the */ /* command. */ /* ============================================ */ quit_get_event = True; } /******************************************************************************* Name: ResetClips Description: Calls the command `reset' in CLIPS Arguments: w - Not Used client_data - Child of widget to destroy call_data - Not Used Returns: None *******************************************************************************/ static void ResetClips( Widget w, XtPointer client_data, XtPointer call_data) { XtDestroyWidget(XtParent((Widget) client_data)); PrintCLIPS("wclips","(reset)\n"); SetCommandString(GetCurrentEnvironment(),"(reset)\n"); /* ============================================ */ /* Set this flag to True to break out of the */ /* event loop so CLIPS could process the */ /* command. */ /* ============================================ */ quit_get_event = True; } /******************************************************************************* Name: ClearClips Description: Calls the `clear' command in CLIPS Arguments: w - Not Used client_data - Not Used call_data - Not Used Returns: None *******************************************************************************/ static void ClearClips( Widget w, XtPointer client_data, XtPointer call_data) { XtDestroyWidget(XtParent((Widget) client_data)); PrintCLIPS("wclips","(clear)\n"); SetCommandString(GetCurrentEnvironment(),"(clear)\n"); /* ============================================ */ /* Set this flag to True to break out of the */ /* event loop so CLIPS could process the */ /* command. */ /* ============================================ */ quit_get_event = True; } /******************************************************************************* * ClearScreenCallback * Description: is called when a clear screen is requested * Input : unused *******************************************************************************/ void ClearScreenCallback( Widget w, XtPointer client_data, XtPointer call_data) { int n = 0; XtSetArg(TheArgs[n],XtNstring,"");n++; XtSetValues(dialog_text,TheArgs,n); PrintPrompt(GetCurrentEnvironment()); } clips-6.24/x-prjct/xinterface/._.DS_Store0000400000175000017500000000012210444324464016312 0ustar jfsjfsMac OS X  2 R@clips-6.24/x-prjct/xinterface/xmenu_file.h0000755000175000017500000000527510444323575016753 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_FILE HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_xmenu_file #define _H_xmenu_file void EditCallback(Widget,XtPointer,XtPointer); void CompletionDialogCallback(Widget,XtPointer,XtPointer); void CompletionEditCallback(Widget,XtPointer,XtPointer); int DisplayMatchedList(Widget,struct symbolMatch *); void MatchDialogReturnD(Widget,XEvent *,String *,Cardinal *); void MatchDialogReturnE(Widget,XEvent *,String *,Cardinal *); int GetMatchList(struct symbolMatch *); void sortList(String *,int); void LoadBatchCallback(Widget,XtPointer,XtPointer); void LoadBinaryCallback(Widget,XtPointer,XtPointer); void LoadFactsCallback(Widget,XtPointer,XtPointer); void LoadRulesCallback(Widget,XtPointer,XtPointer); void DribbleCallback(Widget,XtPointer,XtPointer); void SaveBinaryCallback(Widget,XtPointer,XtPointer); void SaveFactsCallback(Widget,XtPointer,XtPointer); void SaveRulesCallback(Widget,XtPointer,XtPointer); void QuitCallback(Widget,XtPointer,XtPointer); void IntSave(Widget,XtPointer,XtPointer); void FileSelect(void); int IsDirectory(char *); void LoadBatch(char *); void LoadBinary(char *); void LoadTheFacts(char *); void LoadRules(char *); void IntDribbleOn(String); void Restart(Widget,XtPointer,XtPointer); void Quit(Widget,XtPointer,XtPointer); #ifndef _XMENU_FILE_SOURCE_ extern char path[]; extern Widget file_dribble; extern Widget TheFile; extern Widget file_list; extern int file_item; #endif #endif clips-6.24/x-prjct/xinterface/xclipstext.h0000755000175000017500000000316710444323575017025 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XCLIPSTEXT HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_xclipstext #define _H_xclipstext void UnKill(TextWidget,XEvent *); void Stuff(TextWidget,XEvent *); void MoveBeginningOfFile(Widget,XEvent *); void MoveEndOfFile(Widget,XEvent *); void DeleteCurrentSelection(Widget,XEvent *); int LocalClipsInsertNewLine(TextWidget,XEvent *); void InsertClipsString(Widget,XEvent *,String *,Cardinal *); #ifndef _XCLIPSTEXT_SOURCE_ #endif #endif clips-6.24/x-prjct/xinterface/._xmenu_watch.c0000400000175000017500000000012210444323570017312 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/._xmenu_wind.c0000400000175000017500000000012210444323570017145 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/._xclips.h0000400000175000017500000000012210444323575016304 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/._xmenu_exec.c0000400000175000017500000000012210444323570017130 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/._xedit.c0000400000175000017500000000012210444323570016105 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/xmenu_exec.h0000755000175000017500000000303210444323575016745 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_EXEC HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_xmenu_exec #define _H_xmenu_exec void ResetCallback(Widget,XtPointer,XtPointer); void RunCallback(Widget,XtPointer,XtPointer); void StepCallback(Widget,XtPointer,XtPointer); void ClearCLIPSCallback(Widget,XtPointer,XtPointer); void ClearScreenCallback(Widget,XtPointer,XtPointer); #endifclips-6.24/x-prjct/xinterface/xmenu_wind.h0000755000175000017500000000762210444323575016773 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_WIND HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_xmenu_wind #define _H_xmenu_wind void ModuleCallback(Widget,XtPointer,XtPointer); void DefruleManagerCallback(Widget,XtPointer,XtPointer); void DeffactManagerCallback(Widget,XtPointer,XtPointer); void DeftemplateManagerCallback(Widget,XtPointer,XtPointer); void DeffunctionManagerCallback(Widget,XtPointer,XtPointer); void DefglobalManagerCallback(Widget,XtPointer,XtPointer); int IntGetDefglobalList(void); void DefgenericManagerCallback(Widget,XtPointer,XtPointer); void DefinstancesManagerCallback(Widget,XtPointer,XtPointer); void DefclassManagerCallback(Widget,XtPointer,XtPointer); void AgendaManagerCallback(Widget,XtPointer,XtPointer); int IntGetAgendaList(void); void FactsWindowCallback(Widget,XtPointer,XtPointer); void CreateFactWindow(void); void AgendaWindowCallback(Widget,XtPointer,XtPointer); void CreateAgendaWindow(void); void FocusWindowCallback(Widget,XtPointer,XtPointer); void CreateFocusWindow(void); void InstancesWindowCallback(Widget,XtPointer,XtPointer); void CreateInstanceWindow(void); void GlobalsWindowCallback(Widget,XtPointer,XtPointer); void CreateGlobalWindow(void); void AllWindowsCallback(Widget,XtPointer,XtPointer); void NoWindowsCallback(Widget,XtPointer,XtPointer); void CommandLineCLIPSCallback(Widget,XtPointer,XtPointer); void ColorUtilityCallback(Widget,XtPointer,XtPointer); int IntGetDefruleLis(void); int IntGetFactList(void); int IntGetDeftemplateList(void); int IntGetDeffunctionList(void); int IntGetDefgenericList(void); int IntGetDefmethodList(char *); int IntGetDefinstancesList(void); int IntGetDefclassList(void); int IntGetDefmessgHndlerList(char *); void InitializeList(String list[]); void SetManagerList(Widget); Widget GetManagerList(void); int RefreshMngrList(void); void ClearParameters(void); void CancelSelectPrimary(Widget,XtPointer,XtPointer); #ifndef _XMENU_WIND_SOURCE_ extern Widget facts_window; extern Widget agenda_window; extern Widget instances_window; extern Widget globals_window; extern Widget focus_window; extern String *item_list; extern Widget agenda_text; extern Widget facts_text; extern Widget instances_text; extern Widget globals_text; extern Widget focus_text; extern Widget agenda; extern Widget facts; extern Widget instances; extern Widget globals; extern Widget focus; extern Boolean list_change; extern Boolean list1_change; #endif #endif clips-6.24/x-prjct/xinterface/xclips.c0000755000175000017500000011150610444323570016103 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XCLIPS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _XCLIPS_SOURCE_ #include #include #include "xsetup.h" #include "xclips.h" #include "xmenu.h" #include "xmenu_wind.h" #include "xmenu_opt.h" #include "xclipstext.h" #include "xmain.h" #include "setup.h" #include "agenda.h" #include "bmathfun.h" #include "classcom.h" #include "commline.h" #include "crstrtgy.h" #include "defins.h" #include "dffctdef.h" #include "dffnxfun.h" #include "engine.h" #include "exprnpsr.h" #include "facthsh.h" #include "factmngr.h" #include "filecom.h" #include "genrccom.h" #include "globlcom.h" #include "globldef.h" #include "incrrset.h" #include "inscom.h" #include "insfun.h" #include "router.h" #include "utility.h" /********* Local functions visible outside this file **********/ static void PeriodicUpdate(void *); static void UpdateWindowsMenu(void); static int GetEvent(void *); static int InitalizeLogTable(void); static void ReleaseLogTable(void); static LogNamePtr LogInsert(char *); static LogNamePtr LogLookup(char *); static int GetHashValue(char *,int); /********* Global variables **********/ char unget_buf[MAX_CHAR_IN_BUF]; int char_counter = 0; int send_clips_command = True; Boolean periodicChecking = False; LogNamePtr log_table[LOG_TABLE_SIZE]; LogNamePtr stdin_log, xclips_log, xagenda_log, xfacts_log, xinstances_log, xglobals_log, xfocus_log; /******************************************************************************* Name: InitializeInterface Description: initializes the the X window interface Arguments: None Returns: None *******************************************************************************/ void InitializeInterface() { void *theEnv = GetCurrentEnvironment(); if (! InitalizeLogTable()) { EnvPrintRouter(theEnv,"werror", "Could not initialize logical name hash table\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } //SetDribbleStatusFunction(GetCurrentEnvironment(),NULL); /*==================================================================*/ /* Tell CLIPS which GetEvent function to call when an event needed. */ /*==================================================================*/ SetEventFunction(theEnv,GetEvent); /* SetMemoryStatusFunction((int(*)())ActivateTheMenus());*/ /*=================================================*/ /* Tell CLIPS which function to call periodically. */ /*=================================================*/ EnvAddPeriodicFunction(theEnv,"PeriodicUpdate",PeriodicUpdate,90); /*========================*/ /* Add a main I/O router. */ /*========================*/ if (! EnvAddRouter(theEnv,"wclips", 10, XclipsQuery, XclipsPrint, XclipsGetc, XclipsUngetc, XclipsExit)) { printf("Could not allocate xclips router!\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } EnvPrintRouter(theEnv,"wclips", " XCLIPS for:"); } /******************************************************************************* Name: XclipsQuery Description: This function verify the router's logical name Arguments: log_name - logical name of the router Returns: *******************************************************************************/ int XclipsQuery( void *theEnv, char *log_name) { return((LogLookup(log_name) != NULL) ? TRUE : FALSE); } /******************************************************************************* Name: XclipsPrint Description: This function will print a string to the window which has the same logical name as the argument log_name Arguments: log_name - the logical name str - string to be printed Returns: unused *******************************************************************************/ int XclipsPrint( void *theEnv, char *log_name, char *str) { String str_list[1]; int num = 1; LogNamePtr lptr; if ((lptr = LogLookup(log_name)) == NULL) { return(False); } if (lptr == stdin_log) /* standard IO : print to the main dialog */ { str_list[0] = str; InsertClipsString(dialog_text, &TheEvent, str_list,(Cardinal *) &num); } /*================*/ /* Agenda window. */ /*================*/ else if ((lptr == xagenda_log)&&(agenda_text != NULL)) { str_list[0] = str; InsertClipsString(agenda_text, &TheEvent, str_list,(Cardinal *) &num); } /*==============*/ /* Fact window. */ /*==============*/ else if ((lptr == xfacts_log)&&(facts_text != NULL)) { str_list[0] = str; InsertClipsString(facts_text, &TheEvent, str_list,(Cardinal *) &num); } /*===================*/ /* Instances window. */ /*===================*/ else if ((lptr == xinstances_log) && (instances_text != NULL)) { str_list[0] = str; InsertClipsString(instances_text, &TheEvent, str_list,(Cardinal *) &num); } /*====================*/ /* Defglobals window. */ /*====================*/ else if ((lptr == xglobals_log) && (globals_text != NULL)) { str_list[0] = str; InsertClipsString(globals_text, &TheEvent, str_list,(Cardinal *) &num); } /*===============*/ /* Focus window. */ /*===============*/ else if ((lptr == xfocus_log) && (focus_text != NULL)) { str_list[0] = str; InsertClipsString(focus_text,&TheEvent,str_list,(Cardinal *) &num); } /*=======================*/ /* Print to main dialog. */ /*=======================*/ else if ((lptr != xagenda_log) && (lptr != xfacts_log) && (lptr != xinstances_log) && (lptr != xglobals_log)&& (lptr != stdin_log)) { str_list[0] = str; InsertClipsString(dialog_text, &TheEvent, str_list,(Cardinal *) &num); } return(0); } /******************************************************************************* Name: XclipsGetc Description: Get a character input from user Arguments: log_name - Returns: *******************************************************************************/ int XclipsGetc( void *theEnv, char *log_name) { int quit = False; char ch[2]; String str_list[1]; int num = 1; ch[1] = 0; /* if unget_buf is not empty return the last character in the buf */ if (char_counter > 0) { return(unget_buf[--char_counter]); } if (LogLookup(log_name) == NULL) { return(EOS); } while (! quit) { /* Get an event and if it is a legalimate (cahracter)key press */ /* event print it to the main window, return the character */ /* (out of the while loop). */ /* else, dispatch the event and get another event */ XtAppNextEvent(app_con, &TheEvent); /* Get an event */ XLookupString(&TheEvent.xkey, ch, 1, &TheKeysym, &compose_status); if ((TheEvent.type == KeyPress) && (TheEvent.xproperty.window == dialog_text->core.window)) { if ((TheKeysym >= XK_space) && (TheKeysym <= XK_asciitilde)) { str_list[0] = ch; InsertClipsString(dialog_text, &TheEvent, str_list,(Cardinal *) &num); quit = True; } else if ((TheKeysym != XK_Linefeed) ? (TheKeysym == XK_Return) : TRUE) { ch[0] = NEWLINE; quit = True; XtDispatchEvent(&TheEvent); } else if ((TheKeysym != XK_Delete) ? (TheKeysym == XK_BackSpace) :TRUE) { if (RouterData(theEnv)->CommandBufferInputCount != 0) { ch[0] = BACKSPACE; quit = True; XtDispatchEvent(&TheEvent); } } } else { XtDispatchEvent(&TheEvent); } } return((int)ch[0]); } /******************************************************************************* Name: XclipsUngetc Description: unget an input Arguments: ch - the character to be save log_name - logical name Returns: *******************************************************************************/ int XclipsUngetc( void *theEnv, int ch, char *log_name) { if (char_counter < MAX_CHAR_IN_BUF) { unget_buf[char_counter++] = ch; } return(0); } /******************************************************************************* Name: XclipsExit Description: exit CLIPS in case of abnormal exit Arguments: num - unused Returns: *******************************************************************************/ int XclipsExit( void *theEnv, int num) { EnvDribbleOff(theEnv); EnvDeleteRouter(theEnv,"wclips"); XtDestroyApplicationContext(app_con); ReleaseLogTable(); exit(0); } /******************************************************************************* Name: PrintChangedAgenda Description: Update the agenda window Arguments: None Returns: *******************************************************************************/ int PrintChangedAgenda() { void *theEnv = GetCurrentEnvironment(); VOID *rule_ptr; char buffer[MAX_CHAR_IN_BUF]; char *name, labelBuffer[MAX_CHAR_IN_BUF]; Window AgendaWin; Display *theDisplay; struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); /*======================================================*/ /* Change the name of the window to the current module. */ /*======================================================*/ AgendaWin = XtWindow(agenda); theDisplay = XtDisplay(agenda); if (theModule != NULL) { name = EnvGetDefmoduleName(theEnv,theModule); strcpy(labelBuffer,"Agenda Window("); strcat(labelBuffer,name); strcat(labelBuffer,")"); } else { strcpy(labelBuffer,"Agenda Window"); } XStoreName(theDisplay,AgendaWin,labelBuffer); /*============================*/ /* Wipe out the old contents. */ /*============================*/ XtSetArg(TheArgs[0], XtNstring, ""); XtSetValues(agenda_text, TheArgs, 1); XawAsciiSourceFreeString(XawTextGetSource(agenda_text)); /*============================*/ /* Print the new agenda list. */ /*============================*/ rule_ptr = EnvGetNextActivation(theEnv,NULL); while (rule_ptr != NULL) { EnvGetActivationPPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,rule_ptr); EnvPrintRouter(theEnv,"xagenda",buffer); EnvPrintRouter(theEnv,"xagenda", "\n"); rule_ptr = EnvGetNextActivation(theEnv,rule_ptr); } return 0; } /******************************************************************************* Name: PrintChangedFacts Description: Update the fact window Arguments: None Returns: *******************************************************************************/ int PrintChangedFacts() { void *theEnv = GetCurrentEnvironment(); VOID *fact_ptr; char buffer[MAX_CHAR_IN_BUF]; char *name,labelBuffer[MAX_CHAR_IN_BUF]; Window FactWin; Display *theDisplay; struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); /* Change the name of the window to the current module */ FactWin = XtWindow(facts); theDisplay = XtDisplay(facts); if(theModule != NULL) { name = EnvGetDefmoduleName(theEnv,theModule); strcpy(labelBuffer,"Fact Window("); strcat(labelBuffer,name); strcat(labelBuffer,")"); } else { strcpy(labelBuffer,"Fact Window"); } XStoreName(theDisplay,FactWin,labelBuffer); /* Clear the old contents */ XtSetArg(TheArgs[0], XtNstring, ""); XtSetValues(facts_text, TheArgs, 1); XawAsciiSourceFreeString(XawTextGetSource(facts_text)); /* Print the new fact list */ fact_ptr = EnvGetNextFact(theEnv,NULL); while (fact_ptr != NULL) { EnvGetFactPPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,fact_ptr); EnvPrintRouter(theEnv,"xfacts",buffer); EnvPrintRouter(theEnv,"xfacts", "\n"); fact_ptr = EnvGetNextFact(theEnv,fact_ptr); } return 0; } /******************************************************************************* Name: PrintChangedInstances Description: Update the instances window Arguments: None Returns: *******************************************************************************/ int PrintChangedInstances() { void *theEnv = GetCurrentEnvironment(); int n = 0; VOID *instancePtr; char buffer[MAX_CHAR_IN_BUF]; char *name, labelBuffer[MAX_CHAR_IN_BUF]; Window InstanceWin; Display *theDisplay; struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); /* Change the name of the window to the current module */ InstanceWin = XtWindow(instances); theDisplay = XtDisplay(instances); if (theModule != NULL) { name = EnvGetDefmoduleName(theEnv,theModule); strcpy(labelBuffer,"Instances Window("); strcat(labelBuffer,name); strcat(labelBuffer,")"); } else { strcpy(labelBuffer,"Instances Window"); } XStoreName(theDisplay,InstanceWin,labelBuffer); /* Clear the old contents */ XtSetArg(TheArgs[n],XtNstring,"");n++; XtSetValues(instances_text,TheArgs,n); XawAsciiSourceFreeString(XawTextGetSource(instances_text)); /* Print the new instance list */ instancePtr = (VOID *) EnvGetNextInstance(theEnv,NULL); while (instancePtr != NULL) { EnvGetInstancePPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,instancePtr); EnvPrintRouter(theEnv,"xinstances",buffer); EnvPrintRouter(theEnv,"xinstances","\n"); instancePtr = (VOID *) EnvGetNextInstance(theEnv,instancePtr); } return 0; } /******************************************************************************* Name: PrintChangedGlobals Description: Update the global window Arguments: None Returns: *******************************************************************************/ int PrintChangedGlobals() { void *theEnv = GetCurrentEnvironment(); VOID *dgPtr; int n; char *buffer; char *name,labelBuffer[MAX_CHAR_IN_BUF]; Window GlobalWin; Display *theDisplay; struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); /* Change the name of the window to the current module */ GlobalWin = XtWindow(globals); theDisplay = XtDisplay(globals); if (theModule != NULL) { name = EnvGetDefmoduleName(theEnv,theModule); strcpy(labelBuffer,"Globals Window("); strcat(labelBuffer,name); strcat(labelBuffer,")"); } else { strcpy(labelBuffer,"Globals Window"); } XStoreName(theDisplay,GlobalWin,labelBuffer); /* Clear the old contents */ n = 0; XtSetArg(TheArgs[n],XtNstring,"");n++; XtSetValues(globals_text,TheArgs,n); XawAsciiSourceFreeString(XawTextGetSource(globals_text)); /* Print the new defglobal list */ dgPtr = EnvGetNextDefglobal(theEnv,NULL); while (dgPtr != NULL) { buffer = (char *) EnvGetDefglobalPPForm(theEnv,(struct constructHeader *) dgPtr); EnvPrintRouter(theEnv,"xglobals",buffer); EnvPrintRouter(theEnv,"xglobals","\n"); dgPtr = EnvGetNextDefglobal(theEnv,dgPtr); } return 0; } /******************************************************************************* Name: PrintChangedFocus Description: Update the Focus window Arguments: None Returns: *******************************************************************************/ int PrintChangedFocus() { void *theEnv = GetCurrentEnvironment(); VOID *FocusPtr; int n; char *buffer; /* Clear the old contents */ n = 0; XtSetArg(TheArgs[n],XtNstring,"");n++; XtSetValues(focus_text,TheArgs,n); XawAsciiSourceFreeString(XawTextGetSource(focus_text)); /* Print the new focus list */ FocusPtr = EnvGetNextFocus(theEnv,NULL); while(FocusPtr != NULL) { buffer = EnvGetDefmoduleName(theEnv,((struct focus*)FocusPtr)->theModule); EnvPrintRouter(theEnv,"xfocus",buffer); EnvPrintRouter(theEnv,"xfocus","\n"); FocusPtr = EnvGetNextFocus(theEnv,FocusPtr); } return 0; } /******************************************************************************* Name: UpdateMenus Description: Updates the windows if necessary Arguments: None Returns: None *******************************************************************************/ void UpdateMenus() { void *theEnv = GetCurrentEnvironment(); static long LastModuleIndex = -1; Boolean UpdateAll = False; UpdateWindowsMenu(); if(LastModuleIndex != DefmoduleData(theEnv)->ModuleChangeIndex) { UpdateAll = True; LastModuleIndex = DefmoduleData(theEnv)->ModuleChangeIndex; } #if DEFRULE_CONSTRUCT if((Browse_status[AGENDA_WIN] == True ) ? (UpdateAll || (EnvGetAgendaChanged(theEnv) == CLIPS_TRUE)) : FALSE) { EnvSetAgendaChanged(theEnv,CLIPS_FALSE); PrintChangedAgenda(); } if((Browse_status[FOCUS_WIN] == True) ? ( UpdateAll || (EnvGetFocusChanged(theEnv) == CLIPS_TRUE)) : FALSE) { EnvSetFocusChanged(theEnv,CLIPS_FALSE); PrintChangedFocus(); } #endif #if DEFTEMPLATE_CONSTRUCT if((Browse_status[FACT_WIN] == True) ? ( UpdateAll || (EnvGetFactListChanged(theEnv) == CLIPS_TRUE)) : FALSE) { EnvSetFactListChanged(theEnv,CLIPS_FALSE); PrintChangedFacts(); } #endif #if OBJECT_SYSTEM if((Browse_status[INSTANCE_WIN]) ? (UpdateAll || (EnvGetInstancesChanged(theEnv) == CLIPS_TRUE)) : FALSE) { EnvSetInstancesChanged(theEnv,CLIPS_FALSE); PrintChangedInstances(); } #endif #ifdef DEFGLOBAL_CONSTRUCT if((Browse_status[GLOBAL_WIN] == True) ? (UpdateAll || (EnvGetGlobalsChanged(theEnv) == CLIPS_TRUE)) : FALSE) { EnvSetGlobalsChanged(theEnv,CLIPS_FALSE); PrintChangedGlobals(); } #endif } /******************************************************************************* Name: UpdateOptionsMenu Description: Set menu item mark on options selected Arguments: None Returns: None *******************************************************************************/ void UpdateOptionsMenu() { int i; unsigned n = 0; void *theEnv = GetCurrentEnvironment(); XtSetArg(TheArgs[n], XtNleftBitmap, None);n++; for(i = 0; i <= RANDOM_STRATEGY;i++) XtSetValues(strategy_widgets[i], TheArgs, n); for(i = 0; i <= EVERY_CYCLE;i++) XtSetValues(sal_opt_widgets[i],TheArgs,n); n = 0; XtSetArg(TheArgs[n], XtNleftBitmap, checker);n++; XtSetValues(strategy_widgets[EnvGetStrategy(theEnv)],TheArgs,n); XtSetValues(sal_opt_widgets[EnvGetSalienceEvaluation(theEnv)],TheArgs,n); n = 0; if (EnvGetFactDuplication(theEnv)) { XtSetArg(TheArgs[n], XtNstate,True);n++; XtSetValues(option_widgets[INT_FACT_DUPLICATION], TheArgs, n); } else { XtSetArg(TheArgs[n], XtNstate,False);n++; XtSetValues(option_widgets[INT_FACT_DUPLICATION], TheArgs, n); } n = 0; if (EnvGetDynamicConstraintChecking(theEnv)) { XtSetArg(TheArgs[n], XtNstate,True);n++; XtSetValues(option_widgets[INT_DYN_CONSTRAINT_CHK], TheArgs, n); } else { XtSetArg(TheArgs[n], XtNstate,False);n++; XtSetValues(option_widgets[INT_DYN_CONSTRAINT_CHK], TheArgs, n); } n = 0; if (EnvGetStaticConstraintChecking(theEnv)) { XtSetArg(TheArgs[n], XtNstate,True);n++; XtSetValues(option_widgets[INT_STA_CONSTRAINT_CHK], TheArgs, n); } else { XtSetArg(TheArgs[n], XtNstate,False);n++; XtSetValues(option_widgets[INT_STA_CONSTRAINT_CHK], TheArgs, n); } n = 0; if (EnvGetSequenceOperatorRecognition(theEnv)) { XtSetArg(TheArgs[n], XtNstate,True);n++; XtSetValues(option_widgets[INT_SEQUENCE_OPT_REG], TheArgs, n); } else { XtSetArg(TheArgs[n], XtNstate,False);n++; XtSetValues(option_widgets[INT_SEQUENCE_OPT_REG], TheArgs, n); } n = 0; if (EnvGetAutoFloatDividend(theEnv)) { XtSetArg(TheArgs[n], XtNstate,True);n++; XtSetValues(option_widgets[INT_AUTO_FLOAT_DIV], TheArgs, n); } else { XtSetArg(TheArgs[n], XtNstate,False);n++; XtSetValues(option_widgets[INT_AUTO_FLOAT_DIV], TheArgs, n); } n = 0; if (EnvGetIncrementalReset(theEnv)) { XtSetArg(TheArgs[n], XtNstate,True);n++; XtSetValues(option_widgets[INT_INCREMENTAL_RESET], TheArgs, n); } else { XtSetArg(TheArgs[n], XtNstate,False);n++; XtSetValues(option_widgets[INT_INCREMENTAL_RESET], TheArgs, n); } n = 0; if (EnvGetResetGlobals(theEnv)) { XtSetArg(TheArgs[n], XtNstate,True);n++; XtSetValues(option_widgets[INT_RESET_GLOBALS], TheArgs, n); } else { XtSetArg(TheArgs[n], XtNstate,False);n++; XtSetValues(option_widgets[INT_RESET_GLOBALS], TheArgs, n); } } /******************************************************************************* Name: UpdateWindowsMenu Description: Sets manager menu items to sensitive or unsensitive Arguments: None Returns: None *******************************************************************************/ static void UpdateWindowsMenu() { void *theEnv = GetCurrentEnvironment(); /* ==================================================== */ /* Refresh the manager window if nessessary */ /* ==================================================== */ if(list_change || list1_change ) RefreshMngrList(); /* =================================================================== */ /* Set the sensitive state to defrule manager item in the browse menu */ /* =================================================================== */ if(EnvGetNextDefrule(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(defrule_manager, TheArgs, 1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(defrule_manager, TheArgs, 1); } /* ===================================-================================ */ /* Set the sensitive state to deffacts manager item in the browse menu */ /* ==================================================================== */ if(EnvGetNextDeffacts(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(deffact_manager, TheArgs, 1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(deffact_manager, TheArgs, 1); } /* ======================================================================= */ /* Set the sensitive state to deftemplate manager item in the browse menu */ /* ======================================================================= */ if(EnvGetNextDeftemplate(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(deftemplate_manager, TheArgs, 1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(deftemplate_manager, TheArgs, 1); } /* ======================================================================= */ /* Set the sensitive state to deffunction manager item in the browse menu */ /* ======================================================================= */ if(EnvGetNextDeffunction(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(deffunction_manager, TheArgs, 1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(deffunction_manager, TheArgs, 1); } /* ===================================================================== */ /* Set the sensitive state to defglobal manager item in the browse menu */ /* ===================================================================== */ if(EnvGetNextDefglobal(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(defglobal_manager,TheArgs,1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(defglobal_manager,TheArgs,1); } /* ====================================================================== */ /* Set the sensitive state to defgeneric manager item in the browse menu */ /* ====================================================================== */ if(EnvGetNextDefgeneric(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(defgeneric_manager, TheArgs, 1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(defgeneric_manager, TheArgs, 1); } /* ======================================================================== */ /* Set the sensitive state to definstances manager item in the browse menu */ /* ======================================================================== */ if(EnvGetNextDefinstances(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(definstances_manager, TheArgs, 1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(definstances_manager, TheArgs, 1); } /* ==================================================================== */ /* Set the sensitive state to defclass manager item in the browse menu */ /* ==================================================================== */ if(EnvGetNextDefclass(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(defclass_manager, TheArgs, 1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(defclass_manager, TheArgs, 1); } /* =================================================================== */ /* Set the sensitive state to agenda manager item in the browse menu */ /* =================================================================== */ if(EnvGetNextActivation(theEnv,NULL)) { XtSetArg(TheArgs[0], XtNsensitive, True); XtSetValues(agenda_manager, TheArgs, 1); } else { XtSetArg(TheArgs[0], XtNsensitive, False); XtSetValues(agenda_manager, TheArgs, 1); } } /******************************************************************************* Name: GetEvent Description: This function will get the events and dispatch them to the the appropriate event handler. Arguments: None Returns: *******************************************************************************/ static int GetEvent( void *theEnv) { char ch[2]; int i; ch[1] = 0; quit_get_event = False; /*========================================================*/ /* Set the menu items to sensitive before getting events. */ /*========================================================*/ XtSetArg(TheArgs[0],XtNsensitive,True); for (i = 0; i < 7; i++) { XtSetValues(FileItemWidgets[i],TheArgs,1); } for (i = 0; i < 5; i++) { XtSetValues(ExecItemWidgets[i],TheArgs,1); } /*======================*/ /* Refresh the windows. */ /*======================*/ UpdateMenus(); while (! quit_get_event) { /*==============================================================*/ /* There are two types of events (1) middle button press */ /* (paste event) inside the dialog window, (2) others. */ /* For (1), set the send_to_clips flag to true before dispatch. */ /* This flag notify the event handler that the paste event was */ /* inside the main dialog, so send the pasted string to CLIPS */ /*==============================================================*/ XtAppNextEvent(app_con, &TheEvent); if (TheEvent.type == ButtonPress) { if ((TheEvent.xproperty.window == dialog_text->core.window) && (!GetManagerList())&& (TheEvent.xbutton.button == Button2)) { send_to_clips = True; } XtDispatchEvent(&TheEvent); } else { XtDispatchEvent(&TheEvent); set_clips_command(True); } } /*===================================*/ /* Deactivate some of the menu items */ /* while CLIPS processes a command. */ /*===================================*/ XtSetArg(TheArgs[0],XtNsensitive,False); for (i = 0; i < 7; i++) { XtSetValues(FileItemWidgets[i],TheArgs,1); } for (i = 0; i < 5; i++) { XtSetValues(ExecItemWidgets[i],TheArgs,1); } XtSetValues(defrule_manager,TheArgs,1); XtSetValues(deffact_manager,TheArgs,1); XtSetValues(deftemplate_manager,TheArgs,1); XtSetValues(deffunction_manager,TheArgs,1); XtSetValues(defgeneric_manager,TheArgs,1); XtSetValues(definstances_manager,TheArgs,1); XtSetValues(defclass_manager,TheArgs,1); XtSetValues(agenda_manager,TheArgs,1); return 0; } /******************************************************************************* Name: InitalizeLogTable Description: Arguments: None Returns: *******************************************************************************/ static int InitalizeLogTable() { register int i; for (i = 0; i < LOG_TABLE_SIZE; i++) { log_table[i] = NULL; } if ((xclips_log = LogInsert("wclips")) == NULL) { return(FALSE); } if (LogInsert("wdialog") == NULL) { return(FALSE); } if (LogInsert("wdisplay") == NULL) return(FALSE); if (LogInsert("wwarning") == NULL) return(FALSE); if (LogInsert("werror") == NULL) return(FALSE); if (LogInsert("wtrace") == NULL) return(FALSE); if (LogInsert("wagenda") == NULL) return(FALSE); if ((stdin_log = LogInsert("stdin")) == NULL) return(FALSE); if (LogInsert("stdout") == NULL) return(FALSE); if ((xagenda_log = LogInsert("xagenda")) == NULL) return(FALSE); if ((xfacts_log = LogInsert("xfacts")) == NULL) return(FALSE); if ((xinstances_log = LogInsert("xinstances")) == NULL) return(FALSE); if ((xglobals_log = LogInsert("xglobals")) == NULL) return(FALSE); if ((xfocus_log = LogInsert("xfocus")) == NULL) return(FALSE); return(TRUE); } /******************************************************************************* Name: ReleaseLogTable Description: Arguments: None Returns: *******************************************************************************/ static void ReleaseLogTable() { register int i; LogNamePtr ptr1, ptr2; for(i = 0; i < LOG_TABLE_SIZE; i++) { ptr1 = log_table[i]; while(ptr1 != NULL) { ptr2 = ptr1; ptr1 = ptr1->next; release(ptr2->name); release(ptr2); } log_table[i] = NULL; } } /******************************************************************************* Name: LogInsert Description: Insert a new logical name in the log table Arguments: logname - Returns: *******************************************************************************/ static LogNamePtr LogInsert( char *logname) { register int i; LogNamePtr node, ptr; i = GetHashValue(logname, LOG_TABLE_SIZE); if((node = balloc(1, LogName)) == NULL) return(NULL); if((node->name = balloc (strlen(logname)+1, char)) == NULL) { release(node); return(NULL); } strcpy(node->name, logname); node->next = NULL; if(log_table[i] == NULL) log_table[i] = node; else { ptr = log_table[i]; while(ptr != NULL) { if(strcmp(ptr->name, logname) == 0) { release(node->name); release(node); return(NULL); } if(ptr->next == NULL) break; ptr = ptr->next; } ptr->next = node; } return(node); } /******************************************************************************* Name: LogLookup Description: Lookup in the log table for the recognizable logical name Arguments: logname - Returns: *******************************************************************************/ static LogNamePtr LogLookup( char *logname) { LogNamePtr ptr; ptr = log_table[GetHashValue(logname, LOG_TABLE_SIZE)]; while (ptr != NULL) { if(strcmp(logname, ptr->name) == 0) return(ptr); ptr = ptr->next; } return(NULL); } /******************************************************************************* Name: GetHashValue Description: Hash generates an index into the hash table for a string by the following algorithm: For each character in the string, take its ascii value multiplied by its position in the string, and then add all these values together. The hash index is this final sum mod the hash table size. Arguments: str size Returns: hvalue - *******************************************************************************/ static int GetHashValue( char *str, int size) { register unsigned i; unsigned hvalue; for(i = 0, hvalue = 0; str[i] != EOS; i++) hvalue += ((unsigned)str[i])*(i+1); hvalue %= (unsigned)size; return((int)hvalue); } /******************************************************************************* Name: set_clips_command Description: Arguments: flag - Returns: *******************************************************************************/ int set_clips_command( int flag) { send_clips_command = flag; return 0; } /******************************************************************************* Name: get_clips_command Description: Arguments: None Returns: *******************************************************************************/ int get_clips_command() { return(send_clips_command); } /****************************************************************************** * PeriodicUpdate: * Description : This function will be called by CLIPS periodically * while it processes a command. This will allow user * to halt the execution, change options, turn on/off watch, * update the the windows during CLIPS process ****************************************************************************** */ static void PeriodicUpdate( void *theEnv) { periodicChecking = True; while(XtAppPending(app_con) != 0) { XtAppNextEvent(app_con, &TheEvent); XtDispatchEvent(&TheEvent); } periodicChecking = False; if((Browse_status[AGENDA_WIN] == True) ? (EnvGetAgendaChanged(theEnv) == CLIPS_TRUE) : FALSE) { PrintChangedAgenda(); EnvSetAgendaChanged(theEnv,CLIPS_FALSE); } if((Browse_status[FACT_WIN] == True) ? (EnvGetFactListChanged(theEnv) == CLIPS_TRUE) : FALSE) { PrintChangedFacts(); EnvSetFactListChanged(theEnv,CLIPS_FALSE); } if((Browse_status[INSTANCE_WIN] == True) ? (EnvGetInstancesChanged(theEnv) == CLIPS_TRUE) : FALSE) { PrintChangedInstances(); EnvSetInstancesChanged(theEnv,CLIPS_FALSE); } if((Browse_status[GLOBAL_WIN] == True) ? (EnvGetGlobalsChanged(theEnv) == CLIPS_TRUE) : FALSE) { PrintChangedGlobals(); EnvSetGlobalsChanged(theEnv,CLIPS_FALSE); } if((Browse_status[FOCUS_WIN] == True) ? (EnvGetFocusChanged(theEnv) == CLIPS_TRUE) :FALSE) { PrintChangedFocus(); EnvSetFocusChanged(theEnv,CLIPS_FALSE); } } clips-6.24/x-prjct/xinterface/._xmain.c0000400000175000017500000000012210444323570016104 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/xedit.c0000755000175000017500000012771710444323570015731 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XEDIT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #include #include #include #include #include "setup.h" #include "clips.h" #include "commline.h" #include "xsetup.h" #include "xclips.h" #include "xedit.h" #include "xmain.h" #include "xmenu.h" #include "xmenu_file.h" #include "xclipstext.h" static void EditorFontSelect(Widget,XtPointer,XtPointer); static void ExitEditor(Widget,XtPointer,XtPointer); static void EditorSaveFirst(Widget,XtPointer,XtPointer); static void EditorSave(Widget,XtPointer,XtPointer); /********** Global variable in this file ********/ XawTextPosition CurrentPosition,EndPosition; Widget CurrentSource; char *BatchString = NULL; char *xclips_translation3 = "\ CtrlB: balance() \n\ CtrlC: complete-construct-editor()\n\ "; String bindings[] = { "Ctrl-a Begining Of Line", "Ctrl-b Search for matching parenthesis", "Crtl-d Delete Next Character", "Crtl-e End Of Line", "Crtl-f Forward Character", "Crtl-g Multiply Reset", "Crtl-h Delete Previous Character", "Crtl-j Newline And Indent", "Crtl-k Kill To End Of Line", "Crtl-l Redraw Display", "Crtl-m Newline", "Crtl-n Next Line", "Crtl-o Newline And Backup", "Crtl-p Previous Line", "Crtl-r Search/Replace Backward", "Crtl-s Search/Replace Forward", "Crtl-t Transpose Characters", "Crtl-u Multiply by 4", "Crtl-v Next Page", "Crtl-w Kill Selection", "Crtl-y Unkill", "Crtl-z Scroll One Line Up", "Meta-b Backward Word", "Meta-D Kill Word", "Meta-d Delete Next Word", "Meta-f Forward Word", "Meta-H Backward Kill Word", "Meta-h Delete Previous Word", "Meta-i Insert File", "Meta-k Kill To End Of Paragraph", "Meta-q Form Paragraph", "Meta-v Previous Page", "Meta-y Insert Current Selection", "Meta-z Scroll One Line Down", "Meta-< Begining Of File", "Meta-> End Of File", "Meta-] Forward Paragraph", "Meta-[ Backward Paragraph", "Meta-Delete Delete Previous Word", "Meta-Shift Delete Kill Previous Word", "Meta-Backspace Delete Previous Word", "Meta-Shift Backspace Kill Previous Word", NULL, }; /******************************************************************************* Name: EditNewFile Description: Creates new edit window and places file in it Arguments: w - Dialog widget client_data - file to open call_data - Not Used Returns: NONE *******************************************************************************/ void EditNewFile( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); String filename = XawDialogGetValueString(XtParent(w)); char fullpath[255]; Widget edit = NULL, edit_form = NULL, outer_form = NULL, asciiForm = NULL, edit_text= NULL, button= NULL, menu= NULL, item; Dimension width, height; FILE *fp = NULL; char buf[512]; strcpy(fullpath, path); strcat(fullpath, filename); /* ========================================== */ /* Verify if the file is editable */ /* ========================================== */ if((fp = fopen(fullpath, "r+")) == NULL) { switch (errno) { case ENOENT: if((fp = fopen(fullpath, "w")) == NULL) { sprintf(buf,"Can't open file %s for edit\n", fullpath); EnvPrintRouter(theEnv,"wclips", buf); quit_get_event = TRUE; PrintPrompt(theEnv); return; } break; default: sprintf(buf, "Permission denied, can't open file %s \n", fullpath); EnvPrintRouter(theEnv,"wclips", buf); quit_get_event = TRUE; PrintPrompt(theEnv); CancelPopupSelect(outer_form, (XtPointer)XtParent(w), (XtPointer)NULL); return; } } /* ================================= */ /* Close the file so it could be */ /* opened by the asciiTextWidget. */ /* ================================= */ fclose(fp); /* ============================================= */ /* Create the editor window by using the athena */ /* widgets; include : */ /* topLevelShellWidgetClass */ /* panedWidgetClass */ /* formWidgetClass */ /* asciiTextWidgetClass */ /* menuButtonWidgetClass */ /* simpleMenuWidgetClass */ /* smeBSBObjectClass */ /* smeLineObjectClass */ /* ============================================= */ XtSetArg(TheArgs[0], XtNwidth, &width); XtSetArg(TheArgs[1], XtNheight, &height); XtGetValues(dialog, TheArgs, 2); edit = XtCreatePopupShell(filename, topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNheight, height); XtSetArg(TheArgs[1], XtNwidth, width); outer_form = XtCreateManagedWidget("outer_form", panedWidgetClass, edit, TheArgs, 2); edit_form = XtCreateManagedWidget("buttonForm", formWidgetClass, outer_form, NULL, 0); asciiForm = XtCreateManagedWidget("asciiform", formWidgetClass, outer_form, NULL, 0); XtSetArg(TheArgs[0], XtNheight, height-35); XtSetArg(TheArgs[1], XtNwidth, width); XtSetArg(TheArgs[2], XtNresize, "false"); XtSetArg(TheArgs[3], XtNtype, XawAsciiFile); XtSetArg(TheArgs[4], XtNeditType, XawtextEdit); XtSetArg(TheArgs[5], XtNscrollVertical, XawtextScrollWhenNeeded); XtSetArg(TheArgs[6], XtNscrollHorizontal, XawtextScrollWhenNeeded); XtSetArg(TheArgs[7], XtNstring, fullpath); edit_text = XtCreateManagedWidget("dialog_text", asciiTextWidgetClass, asciiForm, TheArgs, 8); XtOverrideTranslations(edit_text,XtParseTranslationTable(xclips_translation3)); /* ================================== */ /* CREATE FILE MENU */ /* ================================== */ button = XtCreateManagedWidget("File", menuButtonWidgetClass, edit_form, NULL, 0); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, button, NULL, 0); item = XtCreateManagedWidget("Save", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorSaveCallback, (XtPointer)(edit_text)); item = XtCreateManagedWidget("Save As", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorSaveAsCallback, (XtPointer)(edit_text)); item = XtCreateManagedWidget("Revert", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorRevertCallback, (XtPointer)(edit_text)); (void)XtCreateManagedWidget("line",smeLineObjectClass,menu,NULL,0); item = XtCreateManagedWidget("Load Selection", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorCompileSelectionCallback, (XtPointer)edit_text); item = XtCreateManagedWidget("Batch Selection", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item,XtNcallback,EditorBatchSelectionCb,(XtPointer)edit_text); item = XtCreateManagedWidget("Load Buffer", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorCompileFileCallback, (XtPointer)edit_text); (void)XtCreateManagedWidget("line",smeLineObjectClass,menu,NULL,0); item = XtCreateManagedWidget("Exit", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorExitCallback, (XtPointer)edit_text); /* ================================= */ /* Create the Edit Menu */ /* ================================= */ XtSetArg(TheArgs[0], XtNfromHoriz, button); button = XtCreateManagedWidget("Edit", menuButtonWidgetClass, edit_form, TheArgs, 1); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, button, NULL, 0); item = XtCreateManagedWidget("Complete... ^C", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, CompletionEditCallback, (XtPointer)edit_text); (void)XtCreateManagedWidget("line", smeLineObjectClass, menu, NULL, 0); item = XtCreateManagedWidget("Cut", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorCutCallback, (XtPointer)edit_text); item = XtCreateManagedWidget("Paste", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorPasteCallback, (XtPointer)edit_text); item = XtCreateManagedWidget("Search/Replace...", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorSearchReplaceCallback, (XtPointer)edit_text); item = XtCreateManagedWidget("Balance ^B", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item,XtNcallback,FindMatchingParenthesisCallback,(XtPointer)edit_text); (void)XtCreateManagedWidget("line", smeLineObjectClass, menu, NULL, 0); item = XtCreateManagedWidget("Beginning of File", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorBeginingOfFileCallback, (XtPointer)edit_text); item = XtCreateManagedWidget("End of File", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorEndOfFileCallback, (XtPointer)edit_text); /* ================================= */ /* Create Font Menu */ /* ================================= */ XtSetArg(TheArgs[0], XtNfromHoriz, button); button = XtCreateManagedWidget("Font", menuButtonWidgetClass, edit_form, TheArgs, 1); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, button, NULL, 0); item = XtCreateManagedWidget("5x8", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorFontSelect, (XtPointer)edit_text); item = XtCreateManagedWidget("6x10", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorFontSelect, (XtPointer)edit_text); item = XtCreateManagedWidget("6x13bold", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorFontSelect, (XtPointer)edit_text); item = XtCreateManagedWidget("7x13bold", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorFontSelect, (XtPointer)edit_text); item = XtCreateManagedWidget("8x13bold", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorFontSelect, (XtPointer)edit_text); item = XtCreateManagedWidget("9x15bold", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorFontSelect, (XtPointer)edit_text); item = XtCreateManagedWidget("10x20", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorFontSelect, (XtPointer)edit_text); item = XtCreateManagedWidget("12x24", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorFontSelect, (XtPointer)edit_text); /* ================================== */ /* Create Help Menu */ /* ================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, button); button = XtCreateManagedWidget("Help", menuButtonWidgetClass, edit_form, TheArgs, 1); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, button, NULL, 0); item = XtCreateManagedWidget("Key Bindings", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(item, XtNcallback, EditorHelpSelect, (XtPointer)edit_text); XtPopup(edit, XtGrabNone); } /******************************************************************************* Name: EditorSaveCallback Description: Called when Save is selected from the File menu This function pops up a confirmation box before the file should be saved. Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorSaveCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget popup, confirm; popup = XtCreatePopupShell("popup", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNlabel, "This will overwrite\nthe old file!"); XtSetArg(TheArgs[1], XtNicon, clips_logo); confirm = XtCreateManagedWidget("confirm", dialogWidgetClass, popup, TheArgs, 2); XawDialogAddButton(confirm, "Overwrite", EditorSave, client_data); XawDialogAddButton(confirm, "Cancel", CancelPopupSelect, (XtPointer)confirm); XtPopup(popup, XtGrabNonexclusive); } /******************************************************************************* Name: EditorSaveAsCallback Description: Called when Save As is selected from the File menu. This function will save the file under a new name. Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorSaveAsCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget popup, file_dialog; file_item = SAVEAS; popup = XtCreatePopupShell("popup", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNlabel, "Enter new file name:"); XtSetArg(TheArgs[1], XtNvalue, ""); XtSetArg(TheArgs[2], XtNicon, clips_logo); file_dialog = XtCreateManagedWidget("file_dialog", dialogWidgetClass, popup, TheArgs, 3); XawDialogAddButton(file_dialog, "Save", EditorSaveAs, client_data); XawDialogAddButton(file_dialog, "Cancel", CancelPopupSelect, (XtPointer)file_dialog); XtPopup(popup, XtGrabNonexclusive); } /******************************************************************************* Name: EditorRevertCallback Description: Called when Revert is selected from the File menu. This function undo all the modifications since the openning of the file. Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorRevertCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget popup, confirm; String filename; file_item = REVERT; popup = XtCreatePopupShell("popup", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNstring, &filename); XtGetValues((Widget)client_data, TheArgs, 1); XtSetArg(TheArgs[0], XtNlabel, "You will loose\nall your changes!"); XtSetArg(TheArgs[1], XtNicon, clips_logo); XtSetArg(TheArgs[2], XtNvalue, filename); XtSetArg(TheArgs[3], XtNeditType, XawtextRead); confirm = XtCreateManagedWidget("confirm", dialogWidgetClass, popup, TheArgs, 4); XawDialogAddButton(confirm, "Revert", EditorRevert, client_data); XawDialogAddButton(confirm, "Cancel", CancelPopupSelect, (XtPointer)confirm); XtPopup(popup, XtGrabNonexclusive); } /* ================================================ */ /* The below functions are for interacting with */ /* CLIPS. */ /* ================================================ */ /******************************************************************************* Name: FindSelection Description: Find the router Argument: log_name - Router's logical name Returns: True if found else fasle *******************************************************************************/ int FindSelection( void *theEnv, char *log_name) { if(strcmp("XeditSelection",log_name)== 0) return(TRUE); return(FALSE); } /******************************************************************************** Name: SelectionGetc Description: Get a charater from the current selection in the editor. Argument: log_name - router's logical name Return: character *******************************************************************************/ int SelectionGetc( void *theEnv, char *log_name) { XawTextBlock text_return; if(XawTextSourceRead(CurrentSource,CurrentPosition,&text_return,1) != EndPosition) { CurrentPosition++; return((int)text_return.ptr[0]); } else return(EOF); } /******************************************************************************** Name: SelectionUngetc Description: Move the cursor back one character Argument: c - the character that being pushed back Return: always 1 *******************************************************************************/ int SelectionUngetc( void *theEnv, int c, char *log_name) { if (c == EOF ) return(1); if(CurrentPosition > 0) CurrentPosition--; return(1); } /******************************************************************************** Name: EditorCompileSelectionCallback Description: Load the selection to CLIPS window Argument: w - the widget that initiates the callback client_data - the editor widget call_data - Not used Return: none *******************************************************************************/ void EditorCompileSelectionCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); CurrentSource = XawTextGetSource((Widget)client_data); XawTextGetSelectionPos((Widget)client_data,&CurrentPosition,&EndPosition); if(CurrentPosition == EndPosition) /* No selection was made */ return; EndPosition++; /* Move the cursor to the end of the selection */ /* Create a IO router for the buffer */ EnvAddRouter(theEnv,"xclipsSelection",90,FindSelection,NULL,SelectionGetc,SelectionUngetc,NULL); /* Compile */ LoadXFile("xclipsSelection","XeditSelection"); EnvPrintRouter(theEnv,"wclips","CLIPS> "); quit_get_event = True; } /******************************************************************************* Name: FileFind Description: Find the router Argument: log_name - Router's logical name Returns: True if found else fasle *******************************************************************************/ int FileFind( void *theEnv, char *log_name) { if(strcmp("XeditBuffer",log_name)== 0) return(TRUE); return(FALSE); } /******************************************************************************** Name: FileGetc Description: Get a charater from the current buffer. Argument: log_name - router's logical name Return: character *******************************************************************************/ int FileGetc( void *theEnv, char *log_name) { XawTextBlock text_return; if(XawTextSourceRead(CurrentSource,CurrentPosition,&text_return,1) != CurrentPosition) { CurrentPosition++; return((int)text_return.ptr[0]); } else return(EOF); } /******************************************************************************** Name: FileUngetc Description: Move the cursor back one character Argument: c - the character that being pushed back Return: always 1 *******************************************************************************/ int FileUngetc( void *theEnv, int c, char *log_name) { if (c == EOF ) return(1); if(CurrentPosition > 0) CurrentPosition--; return(1); } /******************************************************************************* Name: EditorCompileFileCallback Description: Called when Load File to CLIPS is selected from the File menu. This function will load the entire buffer to CLIPS. Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorCompileFileCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); CurrentPosition = 0; CurrentSource = XawTextGetSource((Widget)client_data); /* Create a IO router for the file */ EnvAddRouter(theEnv,"xclipsFile",90,FileFind,NULL,FileGetc,FileUngetc,NULL); /* Compile */ LoadXFile("xclipsFile","XeditBuffer"); PrintCLIPS("wclips","CLIPS> "); quit_get_event = True; } /******************************************************************************** Name: LoadXFile Description:This function activates a router and tell CLIPS to load the construct file using the router. Argument: char str1 - logical name of the router char str2 - logical name of the buffer to be loaded Return: int - unused. *******************************************************************************/ int LoadXFile( char *str1, char *str2) { void *theEnv = GetCurrentEnvironment(); EnvActivateRouter(theEnv,str1); SetPrintWhileLoading(theEnv,TRUE); LoadConstructsFromLogicalName(theEnv,str2); EnvDeactivateRouter(theEnv,str1); SetPrintWhileLoading(theEnv,FALSE); EnvDeleteRouter(theEnv,str1); return 0; } /****************************************************************************** Name: EditorBatchSelectionCb Description: This function is called when Batch Selection is selected from the menu. THis function will batch the current selection and send to CLIPS. Argument: w - widget caused the event to happen client_data - the text widget which contains the edited buffer. call_data - unused Return: *******************************************************************************/ void EditorBatchSelectionCb( Widget w, XtPointer client_data, XtPointer call_data) { XawTextBlock text_return; if(BatchString != NULL) { free(BatchString); BatchString = NULL; } CurrentSource = XawTextGetSource((Widget)client_data); XawTextGetSelectionPos((Widget)client_data,&CurrentPosition,&EndPosition); XawTextSourceRead(CurrentSource,CurrentPosition,&text_return,EndPosition - CurrentPosition ); BatchString = (char*)malloc((EndPosition - CurrentPosition) + 2); strncpy(BatchString,text_return.ptr,EndPosition - CurrentPosition); BatchString[EndPosition - CurrentPosition] = '\n'; BatchString[(EndPosition + 1) - CurrentPosition] = 0; OpenStringBatch(GetCurrentEnvironment(),"editBatch",BatchString,False); quit_get_event = True; } /******************************************************************************* Name: EditorExitCallback Description: Called when Exit is selected from the File menu Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorExitCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget popup, confirm; popup = XtCreatePopupShell("popup", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNlabel, "Exit this editor!\nAre you sure?"); XtSetArg(TheArgs[1], XtNicon, clips_logo); confirm = XtCreateManagedWidget("confirm", dialogWidgetClass, popup, TheArgs, 2); XawDialogAddButton(confirm, "Exit", ExitEditor, (XtPointer)(XtParent(XtParent((Widget)client_data)))); XawDialogAddButton(confirm, "Cancel", CancelPopupSelect, (XtPointer)confirm); if (XawAsciiSourceChanged(XawTextGetSource((Widget)client_data))) XawDialogAddButton(confirm, "Save First", EditorSaveFirst, client_data); XtPopup(popup, XtGrabNonexclusive); } /******************************************************************************* Name: EditorCutCallback Description: Called when Cut is selected from the Edit menu Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorCutCallback( Widget w, XtPointer client_data, XtPointer call_data) { DeleteCurrentSelection((Widget)client_data, &TheEvent); } /******************************************************************************* Name: EditorPasteCallback Description: Called when Paste is selected from the Edit menu Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorPasteCallback( Widget w, XtPointer client_data, XtPointer call_data) { Stuff((TextWidget) client_data, &TheEvent); } /******************************************************************************* Name: EditorSearchReplaceCallback Description: Called when Search/Replace is selected from the Edit menu Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorSearchReplaceCallback( Widget w, XtPointer client_data, XtPointer call_data) { static String params[] = {"forward"}; Cardinal num_params = 1; _XawTextSearch((Widget)client_data, &TheEvent, params, &num_params); } /******************************************************************************* Name: FindMatchingParenthesisCallback Description: Find the matching parenthesis Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void FindMatchingParenthesisCallback( Widget w, XtPointer client_data, XtPointer call_data) { XawTextBlock text_return; XawTextPosition length; Boolean Forward = True; Widget source = XawTextGetSource((Widget)client_data); XawTextPosition Pos = XawTextGetInsertionPoint((Widget)client_data); /* ====================================== */ /* If there is a parenthesis at the */ /* current position of the cusor then */ /* try to find the matching parenthesis, */ /* otherwise, return. */ /* ====================================== */ length = XawTextSourceRead (source,Pos,&text_return,1); if(text_return.length != 0) { if(text_return.ptr[0] == ')') Forward = False; else if (text_return.ptr[0] != '(') { XBell(XtDisplay(toplevel),100); return; } } else { XBell(XtDisplay(toplevel),100); return; } /* =============================== */ /* Searching for a ")" */ /* =============================== */ if(Forward) { if( SearchForward(source,&text_return,length)) XawTextSetSelection((Widget)client_data,Pos,text_return.firstPos + text_return.length); else { XBell(XtDisplay(toplevel),100); WarningWindow( "There is no\n matching parenthesis!"); } } /* =============================== */ /* Searching for a "(" */ /* =============================== */ else { if( SearchBackward(source,&text_return,length)) XawTextSetSelection((Widget)client_data,text_return.firstPos, Pos + 1); else { XBell(XtDisplay(toplevel),100); WarningWindow("There is no\nmatching parenthesis!"); } } } /******************************************************************************* Name: SearchForward Description: Search forward for the mathching parethesis [")"] Arguments: source - Widget, text source text_return _ Pointer to the structure that contains the information about the text block, which has been read by XawTextSourceRead; length - the Position of the last char in the text block Returns: Return True If Found; otherwise, return False. *******************************************************************************/ int SearchForward( Widget source, XawTextBlock *text_return, XawTextPosition length) { XawTextPosition newPos = length; int count = 1; while((newPos != text_return->firstPos) && (count)) { newPos = XawTextSourceRead(source,newPos,text_return,1); if(newPos == text_return->firstPos) break; if( text_return->ptr[0] == '(') count++; else if( text_return->ptr[0] == ')') count--; } if(count) /* could not find the matching parenthesis */ return(False); else return(True); /* found the matching parenthesis */ } /******************************************************************************* Name: WarningWindow Description: Pop up a warning message window; Arguments: Text - Warning message; Returns: None *******************************************************************************/ void WarningWindow( char *text) { Widget WarningShell,WarningDialog; WarningShell = XtCreatePopupShell("Confirmation", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNlabel, text); WarningDialog = XtCreateManagedWidget("confirm", dialogWidgetClass, WarningShell, TheArgs, 1); XawDialogAddButton( WarningDialog,"Okay",CancelPopupSelect,(XtPointer)WarningDialog); XtPopup(WarningShell, XtGrabNonexclusive); } /******************************************************************************* Name: SearchBackward Description: Search backward for the matchhing parethesis ["("] Arguments: text_return _ Pointer to the structure that contains the information about the text block, which has been read by XawTextSourceRead; length - the Position of the last char in the text block Returns: True if Found; otherwise, it returns False. *******************************************************************************/ int SearchBackward( Widget source, XawTextBlock *text_return, XawTextPosition length) { int count = 1; XawTextPosition NewPos = length - 2; while((NewPos >= 0 ) && count) { NewPos = XawTextSourceRead(source,NewPos,text_return,1) - 2; if(text_return->ptr[0] == ')') count++; else if (text_return->ptr[0] == '(') count--; } if(count) /* Unfound */ return(False); else return(True); /* Found */ } /******************************************************************************* Name: EditorBeginingOfFileCallback Description: Move to the beginning of the file. It is Called when Begining of File is selected from the Edit menu Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorBeginingOfFileCallback( Widget w, XtPointer client_data, XtPointer call_data) { MoveBeginningOfFile((Widget)client_data, &TheEvent); } /******************************************************************************* Name: EditorEndOfFileCallback Description: Moves the cursor to the end of the file. It is called when End of File is selected from the Edit menu. Arguments: w - menu item that was selected client_data - Widget to edit call_data - Not Used Returns: None *******************************************************************************/ void EditorEndOfFileCallback( Widget w, XtPointer client_data, XtPointer call_data) { MoveEndOfFile((Widget)client_data, &TheEvent); } /******************************************************************************* Name: EditorFontSelect Description: Changes to font selected by user Arguments: w - menu item that was selected client_data - edit_text asciitext widget call_data - Not used Returns: None *******************************************************************************/ static void EditorFontSelect( Widget w, XtPointer client_data, XtPointer call_data) { Widget edit_text = (Widget)client_data; XFontStruct *font; Arg args[1]; if ((font = XLoadQueryFont(XtDisplay(edit_text), XtName(w))) != NULL) { XtSetArg(args[0], XtNfont, font); XtSetValues(edit_text, args, 1); } } /******************************************************************************* Name: EditorHelpSelect Description: Changes to font selected by user Arguments: w - menu item that was selected client_data - edit_text asciitext widget call_data - Not used Returns: None *******************************************************************************/ void EditorHelpSelect( Widget w, XtPointer client_data, XtPointer call_data) { Arg args[6]; Widget help, help_form, help_list; help = XtCreatePopupShell("help", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(args[0], XtNdefaultDistance, 0); help_form = XtCreateManagedWidget("help_form", formWidgetClass, help, args, 1); XtSetArg(args[0], XtNborderWidth, 0); XtSetArg(args[1], XtNdefaultColumns, 2); XtSetArg(args[2], XtNforceColumns, True); XtSetArg(args[3], XtNlist, bindings); XtSetArg(args[4], XtNallowHoriz, True); XtSetArg(args[5], XtNallowVert, True); help_list = XtCreateManagedWidget("menu", listWidgetClass, help_form, args, 6); XtAddCallback(help_list, XtNcallback, CancelPopupSelect, (XtPointer)help_form); XtPopup(help, XtGrabNone); } /******************************************************************************* Name: EditorSave Description: Saves editor to a new file name Arguments: w - Dialog widget client_data - File to save call_data - Not Used Returns: None Comments: MUST USE `XawTextGetSource' FOR `Saves' TO WORK *******************************************************************************/ static void EditorSave( Widget w, XtPointer client_data, XtPointer call_data) { XawAsciiSave(XawTextGetSource((Widget)client_data)); XtDestroyWidget(XtParent(XtParent(w))); } /******************************************************************************* Name: EditorSaveAs Description: Saves editor to a new file name Arguments: w - Dialog widget client_data - AsciiText widget call_data - Not Used Returns: None Comments: MUST USE `XawTextGetSource' FOR `SaveAs' TO WORK *******************************************************************************/ void EditorSaveAs( Widget w, XtPointer client_data, XtPointer call_data) { Arg args[1]; String filename = XawDialogGetValueString(XtParent(w)); Widget edit_text = XawTextGetSource((Widget)client_data); if (XawAsciiSaveAsFile(edit_text, filename)) { XtSetArg(args[0], XtNstring, filename); XtSetValues(edit_text, args, 1); } XtDestroyWidget(XtParent(XtParent(w))); } /******************************************************************************* Name: EditorRevert Description: Reverts editor file Arguments: w - Dialog widget client_data - AsciiText widget call_data - Not Used Returns: None *******************************************************************************/ void EditorRevert( Widget w, XtPointer client_data, XtPointer call_data) { Arg args[1]; String filename = XawDialogGetValueString(XtParent(w)); if (access(filename, 00) == 0) { XtSetArg(args[0], XtNstring, filename); XtSetValues((Widget)client_data, args, 1); } XtDestroyWidget(XtParent(XtParent(w))); } /******************************************************************************* Name: ExitEditor Description: Exits editor without saving Arguments: w - Dialog widget client_data - AsciiText widget call_data - Not Used Returns: None *******************************************************************************/ static void ExitEditor( Widget w, XtPointer client_data, XtPointer call_data) { if(BatchString != NULL) { free(BatchString); BatchString = NULL; } XtDestroyWidget(XtParent(XtParent(w))); XtDestroyWidget(XtParent((Widget)client_data)); } /******************************************************************************* Name: EditorSaveFirst Description: Saves editor then exits Arguments: w - Dialog widget client_data - AsciiText widget call_data - Not Used Returns: None *******************************************************************************/ static void EditorSaveFirst( Widget w, XtPointer client_data, XtPointer call_data) { XawAsciiSave(XawTextGetSource((Widget)client_data)); XtDestroyWidget(XtParent(XtParent(w))); XtDestroyWidget(XtParent(XtParent(XtParent((Widget)client_data)))); } clips-6.24/x-prjct/xinterface/xmenu_wind.c0000755000175000017500000052761510444323570016772 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_WIND MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _XMENU_WIND_SOURCE_ #include #include #include "setup.h" #include "agenda.h" #include "globldef.h" #include "genrcfun.h" #include "defins.h" #include "classcom.h" #include "commline.h" #include "dffctdef.h" #include "dffnxfun.h" #include "engine.h" #include "genrccom.h" #include "insfun.h" #include "moduldef.h" #include "msgcom.h" #include "object.h" #include "router.h" #include "rulebsc.h" #include "ruledef.h" #include "tmpltbsc.h" #include "tmpltdef.h" #include "xsetup.h" #include "xmenu_wind.h" #include "xclips.h" #include "xmain.h" #include "xmenu_file.h" #include "xclipstext.h" /********** local functions not visible outside this file **********/ static char **IntGetModuleList(void); static void DoneSelectDefmoduleCallback(Widget,XtPointer,XtPointer); static void DefmoduleSelectCallback(Widget,XtPointer,XtPointer); static void DefglobalRemoveCallback(Widget,XtPointer,XtPointer); static void DefglobalPprintCallback(Widget,XtPointer,XtPointer); static void AgendaRemove(Widget,XtPointer,XtPointer); static void AgendaFire(Widget,XtPointer,XtPointer); static void DefruleRemoveCallback(Widget,XtPointer,XtPointer); static void DefruleMatchesCallback(Widget,XtPointer,XtPointer); static void DefrulePprintCallback(Widget,XtPointer,XtPointer); static void DefruleRefreshCallback(Widget,XtPointer,XtPointer); static void DeffactsRemove(Widget,XtPointer,XtPointer); static void DeffactsPprint(Widget,XtPointer,XtPointer); static void DeftemplateRemove(Widget,XtPointer,XtPointer); static void DeftemplatePprint(Widget,XtPointer,XtPointer); static void DeffunctionRemoveCallback(Widget,XtPointer,XtPointer); static void DeffunctionPprintCallback(Widget,XtPointer,XtPointer); static void DefgenericRemoveCallback(Widget,XtPointer,XtPointer); static void DefgenericPprintCallback(Widget,XtPointer,XtPointer); static void DefgenericWatchCallback(Widget,XtPointer,XtPointer); static void DefgenericMngrCheckBoxCallback(Widget,XtPointer,XtPointer); static void DefgenericMethodCallback(Widget,XtPointer,XtPointer); static void RemoveDefmethodCallback(Widget,XtPointer,XtPointer); static void DefmethodPprintCallback(Widget,XtPointer,XtPointer); static void DefmethodWatchCallback(Widget,XtPointer,XtPointer); static void DefmethodMngrCheckBoxCallback(Widget,XtPointer,XtPointer); static void DefinstancesRemoveCallback(Widget,XtPointer,XtPointer); static void DefinstancesPprintCallback(Widget,XtPointer,XtPointer); static void DefclassRemoveCallback(Widget,XtPointer,XtPointer); static void DefclassDescribeCallback(Widget,XtPointer,XtPointer); static void DefclassBrowseCallback(Widget,XtPointer,XtPointer); static void DefclassPprintCallback(Widget,XtPointer,XtPointer); static void DefclassMessageHandlersCallback(Widget,XtPointer,XtPointer); static void RemoveMessageHandlerCallback(Widget,XtPointer,XtPointer); static void MessageHandlerPprintCallback(Widget,XtPointer,XtPointer); static void CancelSelectSecondary(Widget,XtPointer,XtPointer); static void DefruleBreakPointCallback(Widget,XtPointer,XtPointer); static void DefruleActivationCallback(Widget,XtPointer,XtPointer); static void DefruleFiringsCallback(Widget,XtPointer,XtPointer); static void DefruleMngrCheckboxesCallback(Widget,XtPointer,XtPointer); static void WatchInstancesCallback(Widget,XtPointer,XtPointer); static void WatchSlotCallback(Widget,XtPointer,XtPointer); static void DefclssMngrChckbxCallback(Widget,XtPointer,XtPointer); static void DeftemplateWatchCallback(Widget,XtPointer,XtPointer); static void DeftemplateMngrCheckboxCallback(Widget,XtPointer,XtPointer); static void DeffunctionWatchCallback(Widget,XtPointer,XtPointer); static void DeffunctionMngrCheckboxCallback(Widget,XtPointer,XtPointer); static void DefmessHdlrMngrWatchCallback(Widget,XtPointer,XtPointer); static void DefmessHdlrMngrCheckBoxCallback(Widget,XtPointer,XtPointer); /********** local variables available to other files ***********/ Widget agenda = NULL,agenda_form = NULL, agenda_text = NULL, facts = NULL, facts_form = NULL, facts_text = NULL,instances = NULL,instances_form = NULL, instances_text = NULL,globals = NULL,globals_form = NULL, globals_text = NULL,focus = NULL, focus_form = NULL,focus_text = NULL; char *xclips_translation2 = "\ CtrlD: no-op() \n\ CtrlG: no-op() \n\ CtrlJ: no-op() \n\ CtrlK: no-op() \n\ CtrlM: no-op() \n\ CtrlO: no-op() \n\ CtrlR: search(forward) \n\ MetaQ: no-op() \n\ :Metad: no-op() \n\ :MetaD: no-op() \n\ :Metah: no-op() \n\ :MetaH: no-op() \n\ :Meta]: no-op() \n\ :Meta[: no-op() \n\ ~Shift MetaDelete: no-op() \n\ Shift MetaDelete: no-op() \n\ ~Shift MetaBackSpace: no-op() \n\ Shift MetaBackSpace: no-op() \n\ Return: no-op() \n\ Delete: no-op() \n\ BackSpace: no-op() \n\ : no-op() \n\ : no-op() \n\ "; /********** local variables **********/ Boolean list_change = False; Boolean list1_change = False; static Widget manager_list, manager_list1; static Boolean defrulemanager_flag = False; static Boolean deffactsmanager_flag = False; static Boolean deftemplatemanager_flag = False; static Boolean deffunctionmanager_flag = False; static Boolean defglobalmanager_flag = False; static Boolean defgenericmanager_flag = False; static Boolean defmethodmanager_flag = False; static Boolean definstancesmanager_flag = False; static Boolean defclassmanager_flag = False; static Boolean agendamanager_flag = False; static Boolean defmessagehandler_flag = False; Widget facts_window, agenda_window,instances_window, globals_window,focus_window; static String curr_def_name; String *item_list; String *item_list1; /******************************************************************************* Name: ModuleCallback Description: Called when Module is selected form Execution menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void ModuleCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); static char **moduleList = NULL; char *ModuleName; int i = 0; Widget defmoduleShell = NULL, defmoduleForm = NULL, defmoduleViewport = NULL, defmoduleList = NULL, done = NULL; /*======================*/ /* Get the module list. */ /*======================*/ moduleList = IntGetModuleList(); /*==============================*/ /* Create the defmodule window. */ /*==============================*/ defmoduleShell = XtCreatePopupShell("Defmodule", topLevelShellWidgetClass, toplevel, NULL, 0); defmoduleForm = XtCreateManagedWidget("manager_form", formWidgetClass, defmoduleShell, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); defmoduleViewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, defmoduleForm, TheArgs,2); if (moduleList == NULL) { moduleList = (char**)balloc(2,String); moduleList[0] = ""; moduleList[1] = NULL; } else /* Find the index of the current module from the list */ { ModuleName = EnvGetDefmoduleName(theEnv,(struct defmodule*) EnvGetCurrentModule(theEnv)); for (i = 0; moduleList[i] != NULL;) { if (strcmp(ModuleName,moduleList[i]) == 0) { break; } i++; } } XtSetArg(TheArgs[0],XtNlist,moduleList); defmoduleList = XtCreateManagedWidget("manager_list", listWidgetClass, defmoduleViewport, TheArgs, 1); /*===============================*/ /* Highlight the current module. */ /*===============================*/ XawListHighlight(defmoduleList,i); XtAddCallback(defmoduleList,XtNcallback, DefmoduleSelectCallback,defmoduleList); /*=========================*/ /* Create the Done Button. */ /*=========================*/ XtSetArg(TheArgs[0], XtNlabel,"Done"); XtSetArg(TheArgs[1], XtNfromHoriz, defmoduleViewport); done = XtCreateManagedWidget("managerButton", commandWidgetClass, defmoduleForm, TheArgs,2); XtAddCallback(done,XtNcallback,DoneSelectDefmoduleCallback,moduleList); XtPopup(defmoduleShell, XtGrabNonexclusive); } /**************************************************************************** * IntGetModuleList * Description: * Input : * Returns: A list of modules ***************************************************************************/ static char **IntGetModuleList() { void *theEnv = GetCurrentEnvironment(); int maxItems = 20, itemCount = 0; char* name; static char **itemList = NULL; struct defmodule *theDefmodule = NULL; if ((theDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL)) == NULL) { return(NULL); } itemList = (String *)calloc(maxItems,sizeof(String)); while( theDefmodule != NULL) { name = EnvGetDefmoduleName(theEnv,theDefmodule); itemList[itemCount] = balloc(strlen(name) + 1,char); strcpy(itemList[itemCount],name); itemCount++; if (itemCount == (maxItems - 1)) { maxItems = 2*maxItems; itemList = (String *)realloc(itemList,maxItems * sizeof(String)); } theDefmodule = (struct defmodule *)EnvGetNextDefmodule(theEnv,theDefmodule); } itemList[itemCount] = NULL; /*sortList(itemList,itemCount);*/ return(itemList); } /******************************************************************************* Name: DoneSelectDefmoduleCallback Description: Called when Done is selected form module window Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ static void DoneSelectDefmoduleCallback( Widget w, XtPointer client_data, XtPointer call_data) { char** list = (char**)client_data; int i = 0; XtDestroyWidget(XtParent(XtParent(w))); if(list == NULL) return; while(list[i] != NULL) { free(list[i]); i++; } free(list); } /**************************************************************************** ** Name: DefmoduleSelectCallback Description: Arguments: Return: ***************************************************************************** **/ static void DefmoduleSelectCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); XawListReturnStruct *current = XawListShowCurrent((Widget)client_data); if (current->list_index == XAW_LIST_NONE) { return; } EnvSetCurrentModule(theEnv,EnvFindDefmodule(theEnv,current->string)); /*=====================================================*/ /* Set this flag to True to get out of the event loop. */ /*=====================================================*/ quit_get_event = True; } /******************************************************************************* Name: DefruleManagerCallback Description: Pop up the Rule Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DefruleManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { static Widget defrulemanager = NULL; Widget defrulemanager_form,defrulemanager_viewport, removeb = NULL, refresh = NULL, matches = NULL, pprint = NULL, break_point = NULL,break_point_label = NULL,watch_activation_label = NULL, watch_firing_label = NULL, watch_activation = NULL,watch_firing = NULL, cancel = NULL; static Widget CheckBoxes[3]; int itemCount = 0; char buffer[MAX_CHAR_IN_BUF]; /* ======================= */ /* Get the rule list */ /* ======================= */ itemCount = IntGetDefruleLis(); if(item_list == NULL) { ClearParameters(); defrulemanager_flag = False; return; } defrulemanager_flag = True; /* ======================================== */ /* Get the title for defrule manager window */ /* ======================================== */ sprintf(buffer,"Defrule Manager - %d Items",itemCount); /* ====================================================== */ /* Create the defrule manager window */ /* ====================================================== */ defrulemanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); defrulemanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, defrulemanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); defrulemanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, defrulemanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, defrulemanager_viewport, TheArgs, 1); XtSetArg(TheArgs[0], XtNfromHoriz, defrulemanager_viewport); /* ==================================================== */ /* Create the Remove button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, defrulemanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, DefruleRemoveCallback, manager_list); /* ==================================================== */ /* Create the Refresh button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Refresh"); refresh = XtCreateManagedWidget("managerButton", commandWidgetClass, defrulemanager_form, TheArgs, 3); XtAddCallback(refresh, XtNcallback, DefruleRefreshCallback, manager_list); /* ==================================================== */ /* Create the Matches button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, refresh); XtSetArg(TheArgs[2], XtNlabel, "Matches"); matches = XtCreateManagedWidget("managerButton", commandWidgetClass, defrulemanager_form, TheArgs, 3); XtAddCallback(matches, XtNcallback, DefruleMatchesCallback, manager_list); /* ==================================================== */ /* Create the Pprint button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, matches); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, defrulemanager_form, TheArgs, 3); XtAddCallback(pprint, XtNcallback, DefrulePprintCallback, manager_list); /* ==================================================== */ /* Create the BreakPoint button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, pprint); XtSetArg(TheArgs[2], XtNlabel," "); CheckBoxes[0] = break_point = XtCreateManagedWidget("managerButton", toggleWidgetClass, defrulemanager_form, TheArgs, 3); XtAddCallback(break_point,XtNcallback,DefruleBreakPointCallback,manager_list); XtSetArg(TheArgs[0], XtNfromHoriz,break_point); XtSetArg(TheArgs[1], XtNfromVert, pprint); XtSetArg(TheArgs[2], XtNlabel,"Breakpoint"); XtSetArg(TheArgs[3], XtNborderWidth,0); break_point_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, defrulemanager_form, TheArgs, 4); /* ==================================================== */ /* Create the Watch Activation button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz,defrulemanager_viewport); XtSetArg(TheArgs[1], XtNfromVert,break_point); XtSetArg(TheArgs[2], XtNlabel," "); CheckBoxes[1] = watch_activation = XtCreateManagedWidget("managerButton", toggleWidgetClass, defrulemanager_form, TheArgs, 3); XtAddCallback(watch_activation,XtNcallback,DefruleActivationCallback,manager_list); XtSetArg(TheArgs[0], XtNfromHoriz,watch_activation); XtSetArg(TheArgs[1], XtNfromVert, break_point); XtSetArg(TheArgs[2], XtNlabel,"Watch Activation"); XtSetArg(TheArgs[3], XtNborderWidth,0); watch_activation_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, defrulemanager_form, TheArgs, 4); /* ==================================================== */ /* Create the Watch Firing button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz,defrulemanager_viewport); XtSetArg(TheArgs[1], XtNfromVert,watch_activation); XtSetArg(TheArgs[2], XtNlabel," "); CheckBoxes[2] = watch_firing = XtCreateManagedWidget("managerButton", toggleWidgetClass, defrulemanager_form, TheArgs, 3); XtAddCallback(watch_firing,XtNcallback,DefruleFiringsCallback,manager_list); XtSetArg(TheArgs[0], XtNfromHoriz,watch_firing); XtSetArg(TheArgs[1], XtNfromVert, watch_activation); XtSetArg(TheArgs[2], XtNlabel,"Watch Firing"); XtSetArg(TheArgs[3], XtNborderWidth,0); watch_firing_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, defrulemanager_form, TheArgs, 4); XtSetArg(TheArgs[0], XtNfromHoriz,defrulemanager_viewport); XtSetArg(TheArgs[1], XtNfromVert, watch_firing); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, defrulemanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectPrimary, defrulemanager); /* ====================================================== */ /* Add the callback function to the manager_list widget */ /* ====================================================== */ XtAddCallback(manager_list,XtNcallback,DefruleMngrCheckboxesCallback,CheckBoxes); XtPopup(defrulemanager, XtGrabNonexclusive); } /******************************************************************************* Name: DeffactManagerCallback Description: Pop up the Deffacts Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DeffactManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget deffactsmanager,deffactsmanager_form, deffactsmanager_viewport, removeb, pprint, cancel; char buffer[MAX_CHAR_IN_BUF]; int itemCount; itemCount = IntGetFactList(); if(item_list == NULL) { ClearParameters(); deffactsmanager_flag = False; return; } deffactsmanager_flag = True; /* ======================================== */ /* Get the title for deffact manager window */ /* ======================================== */ sprintf(buffer,"Deffacts Manager - %d Items",itemCount); /* ==================================================== */ /* Create the Deffacts Manager window */ /* ==================================================== */ deffactsmanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); deffactsmanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, deffactsmanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); deffactsmanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, deffactsmanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, deffactsmanager_viewport, TheArgs, 1); /* ==================================================== */ /* Create the Remove button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, deffactsmanager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, deffactsmanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, DeffactsRemove, manager_list); /* ==================================================== */ /* Create the Pprint button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, deffactsmanager_form, TheArgs, 3); XtAddCallback(pprint, XtNcallback, DeffactsPprint, manager_list); /* ==================================================== */ /* Create the Done button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, pprint); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, deffactsmanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectPrimary, deffactsmanager); XtPopup(deffactsmanager, XtGrabNonexclusive); } /******************************************************************************* Name: DeftemplateManagerCallback Description: Pop up the Deftemplate Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DeftemplateManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget deftemplatemanager, deftemplatemanager_form, deftemplatemanager_viewport, removeb, pprint,watch_label, cancel; static Widget watch = NULL; int itemCount = 0; char buffer[MAX_CHAR_IN_BUF]; itemCount = IntGetDeftemplateList(); if(item_list == NULL) { deftemplatemanager_flag = False; return; } deftemplatemanager_flag = True; /* ======================================== */ /* Get the title for deffact manager window */ /* ======================================== */ sprintf(buffer,"Deftemplate Manager - %d Items",itemCount); /* ==================================================== */ /* Create the Deftemplate Mananaager window */ /* ==================================================== */ deftemplatemanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); deftemplatemanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, deftemplatemanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); deftemplatemanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, deftemplatemanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, deftemplatemanager_viewport, TheArgs, 1); /* ==================================================== */ /* Create the Remove button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, deftemplatemanager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, deftemplatemanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, DeftemplateRemove, manager_list); /* ==================================================== */ /* Create the Pprint button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, deftemplatemanager_form, TheArgs, 3); XtAddCallback(pprint, XtNcallback, DeftemplatePprint, manager_list); /* ==================================================== */ /* Create the Watch button */ /*===================================================g */ XtSetArg(TheArgs[1], XtNfromVert, pprint); XtSetArg(TheArgs[2], XtNlabel," "); watch = XtCreateManagedWidget("managerButton", toggleWidgetClass, deftemplatemanager_form, TheArgs, 3); XtAddCallback(watch,XtNcallback,DeftemplateWatchCallback,manager_list); XtAddCallback(manager_list,XtNcallback,DeftemplateMngrCheckboxCallback,watch); XtSetArg(TheArgs[0],XtNfromHoriz,watch); XtSetArg(TheArgs[1],XtNfromVert,pprint); XtSetArg(TheArgs[2],XtNlabel,"Watch"); XtSetArg(TheArgs[3],XtNborderWidth,0); watch_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, deftemplatemanager_form, TheArgs,4); /* ==================================================== */ /* Create the Done button */ /* ==================================================== */ XtSetArg(TheArgs[0],XtNfromHoriz,deftemplatemanager_viewport); XtSetArg(TheArgs[1], XtNfromVert, watch); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, deftemplatemanager_form, TheArgs, 3); XtAddCallback(cancel,XtNcallback,CancelSelectPrimary, deftemplatemanager); XtPopup(deftemplatemanager, XtGrabNonexclusive); } /******************************************************************************* Name: DeffunctionManagerCallback Description: Pops up the Deffunction Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DeffunctionManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget deffunctionmanager, deffunctionmanager_form, deffunctionmanager_viewport,watch_label, removeb, pprint, cancel; static Widget watch; int itemCount = 0; char buffer[MAX_CHAR_IN_BUF]; itemCount = IntGetDeffunctionList(); if(item_list == NULL) { ClearParameters(); deffunctionmanager_flag = False; return; } deffunctionmanager_flag = True; /* ============================================= */ /* Get the title for deffunction manager window */ /* ============================================ */ sprintf(buffer,"Deffunction Manager - %d Items",itemCount); /* ==================================================== */ /* Create the Deffunction Manager window */ /* ==================================================== */ deffunctionmanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); deffunctionmanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, deffunctionmanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); deffunctionmanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, deffunctionmanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, deffunctionmanager_viewport, TheArgs, 1); /* ==================================================== */ /* Create the Remove button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, deffunctionmanager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, deffunctionmanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, DeffunctionRemoveCallback, manager_list); /* ==================================================== */ /* Create the Pprint button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, deffunctionmanager_form, TheArgs, 3); XtAddCallback(pprint, XtNcallback, DeffunctionPprintCallback, manager_list); /* ==================================================== */ /* Create the Watch button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNlabel, " "); XtSetArg(TheArgs[2],XtNfromVert,pprint); watch = XtCreateManagedWidget("managerButton", toggleWidgetClass, deffunctionmanager_form, TheArgs,3); XtAddCallback(watch,XtNcallback,DeffunctionWatchCallback,(XtPointer)manager_list); XtAddCallback(manager_list,XtNcallback,DeffunctionMngrCheckboxCallback,(XtPointer)watch); XtSetArg(TheArgs[0], XtNfromHoriz,watch); XtSetArg(TheArgs[1], XtNlabel, "Watch"); watch_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, deffunctionmanager_form, TheArgs,3); /* ==================================================== */ /* Create the Cancel button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz,deffunctionmanager_viewport); XtSetArg(TheArgs[1], XtNfromVert, watch); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, deffunctionmanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectPrimary, (XtPointer)deffunctionmanager); XtPopup(deffunctionmanager, XtGrabNonexclusive); } /******************************************************************************* Name: DefglobalManagerCallback Description: Pops up the Defglobal Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DefglobalManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget defglobalmanager, defglobalmanager_form, defglobalmanager_viewport, removeb, pprint, cancel; char buffer[MAX_CHAR_IN_BUF]; int itemCount = 0; itemCount = IntGetDefglobalList(); if(item_list == NULL) { ClearParameters(); defglobalmanager_flag = False; return; } defglobalmanager_flag = True; /* ========================================== */ /* Get the title for defglobal manager window */ /* ========================================== */ sprintf(buffer,"Defglobal Manager - %d Items",itemCount); /* ==================================================== */ /* Create the Defglobal Manager window */ /* ==================================================== */ defglobalmanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); defglobalmanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, defglobalmanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); defglobalmanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, defglobalmanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, defglobalmanager_viewport, TheArgs, 1); /* ==================================================== */ /* Create the Remove button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, defglobalmanager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, defglobalmanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, DefglobalRemoveCallback, (XtPointer)manager_list); /* ==================================================== */ /* Create the Pprint button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, defglobalmanager_form, TheArgs, 3); XtAddCallback(pprint, XtNcallback,DefglobalPprintCallback, (XtPointer)manager_list); /* ==================================================== */ /* Create the Cancel button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, pprint); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, defglobalmanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectPrimary, (XtPointer)defglobalmanager); XtPopup(defglobalmanager, XtGrabNonexclusive); } /******************************************************************************* Name: IntGetDefglobal Description: Arguments: Returns: *******************************************************************************/ int IntGetDefglobalList() { void *theEnv = GetCurrentEnvironment(); struct defglobal* defglPtr = NULL; int itemCount = 0,maxItems = 20; char *name; if ((defglPtr = (struct defglobal*) EnvGetNextDefglobal(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String*)calloc(maxItems,sizeof(String)); while(defglPtr != NULL) { name = (char*) EnvGetDefglobalName(theEnv,(struct constructHeader *) defglPtr); item_list[itemCount] = balloc(strlen(name) + 1,char); strcpy(item_list[itemCount++],name); if (itemCount == (maxItems - 1)) { maxItems = maxItems * 2; item_list = (String *)realloc(item_list,maxItems * sizeof(String)); } defglPtr = (struct defglobal*) EnvGetNextDefglobal(theEnv,defglPtr); } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /******************************************************************************* Name: DefglobalRemoveCallback Description: Arguments: Returns: *******************************************************************************/ static void DefglobalRemoveCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undefglobal "); EnvPrintRouter(theEnv,"wclips","(undefglobal "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list_change = True; } /******************************************************************************* Name: DefglobalPprintCallback Description: Arguments: Returns: *******************************************************************************/ static void DefglobalPprintCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE || EnvGetDefglobalPPForm(theEnv,(struct constructHeader *) EnvFindDefglobal(theEnv,current->string)) == NULL) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(ppdefglobal "); EnvPrintRouter(theEnv,"wclips","(ppdefglobal "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /******************************************************************************* Name: DefgenericManagerCallback Description: Pops up the Defgeneric Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DefgenericManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget defgenericmanager, defgenericmanager_form, defgenericmanager_viewport, watch, watch_label,removeb, pprint, methods, cancel; char buffer[MAX_CHAR_IN_BUF]; int itemCount = 0; itemCount = IntGetDefgenericList(); if(item_list == NULL) { ClearParameters(); defgenericmanager_flag = False; release(curr_def_name); return; } defgenericmanager_flag = True; /* =========================================== */ /* Get the title for defgeneric manager window */ /* =========================================== */ sprintf(buffer,"Defgeneric Manager - %d Items",itemCount); /* ==================================================== */ /* Create the Defgeneric Manager */ /* ==================================================== */ defgenericmanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); defgenericmanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, defgenericmanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); defgenericmanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, defgenericmanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, defgenericmanager_viewport, TheArgs, 1); /* ==================================================== */ /* Create the Remove button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, defgenericmanager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, defgenericmanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, DefgenericRemoveCallback, (XtPointer)manager_list); /* ==================================================== */ /* Create the Pprint button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, defgenericmanager_form, TheArgs, 3); XtAddCallback(pprint, XtNcallback, DefgenericPprintCallback, (XtPointer)manager_list); /* ==================================================== */ /* Create the Methods button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, pprint); XtSetArg(TheArgs[2], XtNlabel, "Methods..."); methods = XtCreateManagedWidget("managerButton", commandWidgetClass, defgenericmanager_form, TheArgs, 3); XtAddCallback(methods,XtNcallback,DefgenericMethodCallback, (XtPointer)manager_list); /* ==================================================== */ /* Create the Watch button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNlabel, " "); XtSetArg(TheArgs[2],XtNfromVert,methods); watch = XtCreateManagedWidget("managerButton", toggleWidgetClass, defgenericmanager_form, TheArgs,3); XtAddCallback(watch,XtNcallback,DefgenericWatchCallback,(XtPointer)manager_list); XtAddCallback(manager_list,XtNcallback,DefgenericMngrCheckBoxCallback,(XtPointer)watch); XtSetArg(TheArgs[0], XtNfromHoriz,watch); XtSetArg(TheArgs[1], XtNlabel, "Watch"); watch_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, defgenericmanager_form, TheArgs,3); /* ==================================================== */ /* Create the Done button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz,defgenericmanager_viewport); XtSetArg(TheArgs[1], XtNfromVert, watch); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, defgenericmanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectPrimary,(XtPointer)defgenericmanager); XtPopup(defgenericmanager, XtGrabNonexclusive); } /******************************************************************************* Name: DefinstancesManagerCallback Description: Pops up the Definstances Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DefinstancesManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget definstancesmanager, definstancesmanager_form, definstancesmanager_viewport, removeb, pprint, cancel; char buffer[MAX_CHAR_IN_BUF]; int itemCount = 0; itemCount = IntGetDefinstancesList(); if(item_list == NULL) { ClearParameters(); definstancesmanager_flag = False; return; } definstancesmanager_flag = True; /* =========================================== */ /* Get the title for definstance manager window */ /* =========================================== */ sprintf(buffer,"Definstance Manager - %d Items",itemCount); /* ==================================================== */ /* Create the Definstances Manager window */ /* ==================================================== */ definstancesmanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); definstancesmanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, definstancesmanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); definstancesmanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, definstancesmanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, definstancesmanager_viewport, TheArgs, 1); XtSetArg(TheArgs[0], XtNfromHoriz, definstancesmanager_viewport); /* ==================================================== */ /* Create the Remove button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, definstancesmanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, DefinstancesRemoveCallback, (XtPointer)manager_list); /* ==================================================== */ /* Create the Pprint button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, definstancesmanager_form, TheArgs, 3); XtAddCallback(pprint, XtNcallback, DefinstancesPprintCallback, (XtPointer)manager_list); /* ==================================================== */ /* Create the Done button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, pprint); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, definstancesmanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectPrimary, (XtPointer)definstancesmanager); XtPopup(definstancesmanager, XtGrabNonexclusive); } /******************************************************************************* Name: DefclassManagerCallback Description: Pops up the Defclass Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DefclassManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget defclassmanager, defclassmanager_form, defclassmanager_viewport, removeb, describe, browse, pprint, message_handlers, watch_instances, watch_slot, watch_instances_label,watch_slot_label,cancel; static Widget CheckBoxes[3]; char buffer[MAX_CHAR_IN_BUF]; int itemCount = 0; itemCount = IntGetDefclassList(); if(item_list == NULL) { ClearParameters(); release(curr_def_name); defclassmanager_flag = False; return; } defclassmanager_flag = True; /* =========================================== */ /* Get the title for defclass manager window */ /* =========================================== */ sprintf(buffer,"Defclass Manager - %d Items",itemCount); /* =========================================== */ /* Create the parent window for the defclass */ /* window manager */ /* =========================================== */ defclassmanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); defclassmanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, defclassmanager, NULL, 0); /* =========================================== */ /* Create the list widget for the defclass */ /* list */ /* =========================================== */ XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); defclassmanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, defclassmanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, defclassmanager_viewport, TheArgs, 1); /* =========================================== */ /* Create the Remove button */ /* =========================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, defclassmanager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, defclassmanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, DefclassRemoveCallback, (XtPointer)manager_list); /* =========================================== */ /* Create the Describe button */ /* =========================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Describe"); describe = XtCreateManagedWidget("managerButton", commandWidgetClass, defclassmanager_form, TheArgs, 3); XtAddCallback(describe, XtNcallback, DefclassDescribeCallback, (XtPointer)manager_list); /* =========================================== */ /* Create the Browse button */ /* =========================================== */ XtSetArg(TheArgs[1], XtNfromVert, describe); XtSetArg(TheArgs[2], XtNlabel, "Browse"); browse = XtCreateManagedWidget("managerButton", commandWidgetClass, defclassmanager_form, TheArgs, 3); XtAddCallback(browse, XtNcallback, DefclassBrowseCallback, (XtPointer)manager_list); /* =========================================== */ /* Create the Pretty Print button */ /* =========================================== */ XtSetArg(TheArgs[1], XtNfromVert, browse); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, defclassmanager_form, TheArgs, 3); XtAddCallback(pprint, XtNcallback, DefclassPprintCallback, (XtPointer)manager_list); /* =========================================== */ /* Create the Message Handler button */ /* =========================================== */ XtSetArg(TheArgs[1], XtNfromVert, pprint); XtSetArg(TheArgs[2], XtNlabel, "Message Handlers..."); message_handlers = XtCreateManagedWidget("managerButton", commandWidgetClass, defclassmanager_form, TheArgs, 3); XtAddCallback(message_handlers,XtNcallback, DefclassMessageHandlersCallback,(XtPointer)manager_list); /* ======================================================= */ /* Create the toggle button for the Watch Instance button */ /* ======================================================= */ XtSetArg(TheArgs[1], XtNfromVert, message_handlers); XtSetArg(TheArgs[2], XtNlabel," "); CheckBoxes[0] = watch_instances = XtCreateManagedWidget("managerButton", toggleWidgetClass, defclassmanager_form, TheArgs, 3); XtAddCallback(watch_instances,XtNcallback,WatchInstancesCallback,(XtPointer)manager_list); /* ======================================================= */ /* Create the label button for the Watch Instance button */ /* ======================================================= */ XtSetArg(TheArgs[1], XtNfromVert, message_handlers); XtSetArg(TheArgs[2], XtNlabel,"Watch Instances"); XtSetArg(TheArgs[0],XtNfromHoriz,watch_instances); XtSetArg(TheArgs[3],XtNborderWidth,0); watch_instances_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, defclassmanager_form, TheArgs, 4); /* ======================================================= */ /* Create the toggle button for the Watch Slot button */ /* ======================================================= */ XtSetArg(TheArgs[0],XtNfromHoriz,defclassmanager_viewport); XtSetArg(TheArgs[1], XtNfromVert,watch_instances); XtSetArg(TheArgs[2], XtNlabel," "); CheckBoxes[1] = watch_slot = XtCreateManagedWidget("managerButton", toggleWidgetClass, defclassmanager_form, TheArgs, 3); XtAddCallback(watch_slot,XtNcallback,WatchSlotCallback,(XtPointer)manager_list); /* ======================================================= */ /* Create the label button for the Watch Slot */ /* ======================================================= */ XtSetArg(TheArgs[0],XtNfromHoriz,watch_slot); XtSetArg(TheArgs[1], XtNfromVert,watch_instances); XtSetArg(TheArgs[2], XtNlabel,"Watch Slots"); XtSetArg(TheArgs[3], XtNborderWidth,0); watch_slot_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, defclassmanager_form, TheArgs,4); /* ======================================================= */ /* Create the command button for the Done */ /* ======================================================= */ XtSetArg(TheArgs[0],XtNfromHoriz,defclassmanager_viewport); XtSetArg(TheArgs[1], XtNfromVert, watch_slot); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, defclassmanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectPrimary, (XtPointer)defclassmanager); /* ======================================================= */ /* Add the callback function to the manager list */ /* ======================================================= */ XtAddCallback(manager_list,XtNcallback,DefclssMngrChckbxCallback,(XtPointer)CheckBoxes); XtPopup(defclassmanager, XtGrabNonexclusive); } /******************************************************************************* Name: AgendaManagerCallback Description: Pop up the Agenda Manager Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void AgendaManagerCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget agendamanager, agendamanager_form, agendamanager_viewport, removeb, fire, cancel; char buffer[MAX_CHAR_IN_BUF]; int itemCount = IntGetAgendaList(); if(item_list == NULL) { ClearParameters(); agendamanager_flag = False; return; } agendamanager_flag = True; /* =========================================== */ /* Get the title for agenda manager window */ /* =========================================== */ sprintf(buffer,"Agenda Manager - %d Items",itemCount); /* ==================================================== */ /* Create the Agenda Manager window */ /* ==================================================== */ agendamanager = XtCreatePopupShell(buffer, topLevelShellWidgetClass, toplevel, NULL, 0); agendamanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, agendamanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); agendamanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, agendamanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list); manager_list = XtCreateManagedWidget("manager_list", listWidgetClass, agendamanager_viewport, TheArgs, 1); /* ==================================================== */ /* Create the Remove button */ /* ==================================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, agendamanager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, agendamanager_form, TheArgs, 2); XtAddCallback(removeb, XtNcallback, AgendaRemove, (XtPointer)manager_list); /* ==================================================== */ /* Create the Fire button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Fire"); fire = XtCreateManagedWidget("managerButton", commandWidgetClass, agendamanager_form, TheArgs, 3); XtAddCallback(fire, XtNcallback, AgendaFire,(XtPointer)manager_list); /* ==================================================== */ /* Create the Done button */ /* ==================================================== */ XtSetArg(TheArgs[1], XtNfromVert, fire); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, agendamanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectPrimary, (XtPointer) agendamanager); XtPopup(agendamanager, XtGrabNonexclusive); } /******************************************************************************* Name: IntGetAgendaList Description: Gets agenda list Arguments: None Returns: *******************************************************************************/ int IntGetAgendaList() { void *theEnv = GetCurrentEnvironment(); int maxItems = 20,itemCount = 0; struct activation *act_ptr; char buffer[MAX_CHAR_IN_BUF]; if((act_ptr = (struct activation *) EnvGetNextActivation(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String *)calloc(maxItems,sizeof(String)); while(act_ptr != NULL) { /*name = GetActivationName((VOID*)act_ptr);*/ EnvGetActivationPPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,act_ptr); item_list[itemCount] = balloc(strlen(buffer) + 1, char); strcpy(item_list[itemCount++],buffer); if(itemCount == (maxItems - 1)) { maxItems = maxItems * 2; item_list = (String *)realloc(item_list,maxItems*sizeof(String)); } act_ptr = (struct activation *) EnvGetNextActivation(theEnv,act_ptr); } item_list[itemCount] = NULL; /*sortList(item_list,itemCount);*/ return(itemCount); } /****************************************************************************** Name: AgendaRemove Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void AgendaRemove( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); register int i; struct activation *act_ptr; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if (current->list_index == XAW_LIST_NONE) { return; } act_ptr = (struct activation *) EnvGetNextActivation(theEnv,NULL); for (i = 0; i < current->list_index ; i++) { act_ptr = (struct activation *) EnvGetNextActivation(theEnv,act_ptr); } EnvDeleteActivation(theEnv, (void *) act_ptr); /*=====================================================*/ /* Set this flag to True to get out of the event loop. */ /*=====================================================*/ quit_get_event = True; list_change = True; } /****************************************************************************** Name: AgendaFire Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void AgendaFire( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); register int i; struct activation *act_ptr; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; act_ptr = (struct activation *) EnvGetNextActivation(theEnv,NULL); for (i = 0; i < current->list_index ; i++) act_ptr = (struct activation *) EnvGetNextActivation(theEnv,act_ptr); MoveActivationToTop(theEnv,(VOID*)act_ptr); MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(run 1)\n"); EnvPrintRouter(theEnv,"wclips","(run 1)\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list_change = True; } /******************************************************************************* Name: FactsWindowCallback Description: Called when Facts Window is selected from the Window menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void FactsWindowCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); if (Browse_status[FACT_WIN]) { XtSetArg(TheArgs[0], XtNleftBitmap, None); XtPopdown(facts); } else if (facts_text != NULL) { XtPopup(facts,XtGrabNone); EnvSetFactListChanged(theEnv,FALSE); PrintChangedFacts(); XtSetArg(TheArgs[0], XtNleftBitmap, checker); } else { CreateFactWindow(); EnvSetFactListChanged(theEnv,FALSE); PrintChangedFacts(); XtSetArg(TheArgs[0], XtNleftBitmap, checker); } XtSetValues(facts_window, TheArgs, 1); Browse_status[FACT_WIN] = !Browse_status[FACT_WIN]; } /********************************************************************** * CreateFactWindow * **********************************************************************/ void CreateFactWindow() { void *theEnv = GetCurrentEnvironment(); Dimension height; int n = 0; char *name,labelBuffer[256]; struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); /* Change the name of the window to the current module */ if(theModule != NULL) { name = EnvGetDefmoduleName(theEnv,theModule); strcpy(labelBuffer,"Facts Window("); strcat(labelBuffer,name); strcat(labelBuffer,")"); } else { strcpy(labelBuffer,"Facts Window"); } XtSetArg(TheArgs[n], XtNheight, &height);n++; XtGetValues(dialog, TheArgs, n); height = (height + 150) / 3; n = 0; XtSetArg(TheArgs[n], XtNheight, height);n++; facts = XtCreatePopupShell(labelBuffer, topLevelShellWidgetClass, toplevel, TheArgs, n); n = 0; XtSetArg(TheArgs[n], XtNdefaultDistance, 0);n++; facts_form = XtCreateManagedWidget("facts_form", formWidgetClass, facts, TheArgs, n); n = 0; XtSetArg(TheArgs[n], XtNwidth, 250);n++; XtSetArg(TheArgs[n], XtNeditType, XawtextAppend);n++; XtSetArg(TheArgs[n], XtNscrollHorizontal, XawtextScrollAlways);n++; XtSetArg(TheArgs[n], XtNscrollVertical, XawtextScrollAlways);n++; facts_text = XtCreateManagedWidget("facts_text", asciiTextWidgetClass, facts_form, TheArgs, n); XtOverrideTranslations(facts_text, XtParseTranslationTable(xclips_translation2)); XtPopup(facts, XtGrabNone); if(! EnvAddRouter(theEnv,"xfacts", 10, XclipsQuery, XclipsPrint, NULL, NULL, XclipsExit)) { EnvPrintRouter(theEnv,"werror", "Could not allocate xfacts router!\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } } /******************************************************************************* Name: AgendaWindowCallback Description: Called when Agenda Window is selected from the Window menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void AgendaWindowCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); if (Browse_status[AGENDA_WIN]) { XtSetArg(TheArgs[0], XtNleftBitmap, None); XtPopdown(agenda); } else if(agenda != NULL) { XtPopup(agenda,XtGrabNone); EnvSetAgendaChanged(theEnv,FALSE); PrintChangedAgenda(); XtSetArg(TheArgs[0], XtNleftBitmap,checker); } else { CreateAgendaWindow(); EnvSetAgendaChanged(theEnv,FALSE); PrintChangedAgenda(); XtSetArg(TheArgs[0], XtNleftBitmap, checker); } XtSetValues(agenda_window, TheArgs, 1); Browse_status[AGENDA_WIN] = !Browse_status[AGENDA_WIN]; } /******************************************************************************* Name: Description: Arguments: None Returns: None *******************************************************************************/ void CreateAgendaWindow() { void *theEnv = GetCurrentEnvironment(); Dimension width; char *name,labelBuffer[256]; struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); XtSetArg(TheArgs[0], XtNwidth, &width); XtGetValues(dialog, TheArgs, 1); XtSetArg(TheArgs[0], XtNwidth,2 * width/3); if(theModule != NULL) { name = EnvGetDefmoduleName(theEnv,theModule); strcpy(labelBuffer,"Agenda Window("); strcat(labelBuffer,name); strcat(labelBuffer,")"); } else { strcpy(labelBuffer,"Agenda Window"); } agenda = XtCreatePopupShell(labelBuffer, topLevelShellWidgetClass, toplevel, TheArgs, 1); XtSetArg(TheArgs[0], XtNdefaultDistance, 0); agenda_form = XtCreateManagedWidget("agenda_form", formWidgetClass, agenda, TheArgs, 1); XtSetArg(TheArgs[0], XtNheight, 150); XtSetArg(TheArgs[1], XtNeditType, XawtextAppend); XtSetArg(TheArgs[2], XtNscrollHorizontal, XawtextScrollAlways); XtSetArg(TheArgs[3], XtNscrollVertical, XawtextScrollAlways); agenda_text = XtCreateManagedWidget("agenda_text", asciiTextWidgetClass, agenda_form, TheArgs, 4); XtOverrideTranslations(agenda_text, XtParseTranslationTable(xclips_translation2)); XtPopup(agenda, XtGrabNone); if(!EnvAddRouter(theEnv, "xagenda", 10, XclipsQuery, XclipsPrint,NULL,NULL,XclipsExit)) { EnvPrintRouter(theEnv,WERROR, "Could not allocate xagenda router!\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } } /******************************************************************************* Name: Description: Arguments: Returns: None *******************************************************************************/ void FocusWindowCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); if (Browse_status[FOCUS_WIN]) { XtSetArg(TheArgs[0], XtNleftBitmap, None); XtPopdown(focus); } else if (focus != NULL) { XtPopup(focus,XtGrabNone); EnvSetFocusChanged(theEnv,FALSE); PrintChangedFocus(); XtSetArg(TheArgs[0], XtNleftBitmap,checker); } else { CreateFocusWindow(); EnvSetFocusChanged(theEnv,FALSE); PrintChangedFocus(); XtSetArg(TheArgs[0], XtNleftBitmap, checker); } XtSetValues(focus_window, TheArgs, 1); Browse_status[FOCUS_WIN] = !Browse_status[FOCUS_WIN]; } /******************************************************************************* Name: Description: Arguments: Returns: None *******************************************************************************/ void CreateFocusWindow() { void *theEnv = GetCurrentEnvironment(); Dimension width; XtSetArg(TheArgs[0], XtNwidth, &width); XtGetValues(dialog, TheArgs, 1); XtSetArg(TheArgs[0], XtNwidth,width/3); focus = XtCreatePopupShell("Focus Window", topLevelShellWidgetClass, toplevel, TheArgs, 1); XtSetArg(TheArgs[0], XtNdefaultDistance, 0); focus_form = XtCreateManagedWidget("agenda_form", formWidgetClass, focus, TheArgs, 1); XtSetArg(TheArgs[0], XtNheight, 150); XtSetArg(TheArgs[1], XtNeditType, XawtextAppend); XtSetArg(TheArgs[2], XtNscrollHorizontal, XawtextScrollAlways); XtSetArg(TheArgs[3], XtNscrollVertical, XawtextScrollAlways); focus_text = XtCreateManagedWidget("focus_text", asciiTextWidgetClass, focus_form, TheArgs, 4); XtOverrideTranslations(focus_text, XtParseTranslationTable(xclips_translation2)); XtPopup(focus, XtGrabNone); if(!EnvAddRouter(theEnv,"xfocus", 10, XclipsQuery, XclipsPrint,NULL,NULL,XclipsExit)) { EnvPrintRouter(theEnv,"werror", "Could not allocate xfocus router!\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } } /******************************************************************************* Name: Description: Arguments: Returns: None *******************************************************************************/ void InstancesWindowCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); if (Browse_status[INSTANCE_WIN]) { XtSetArg(TheArgs[0], XtNleftBitmap, None); XtPopdown(instances); } else if (instances != NULL) { XtPopup(instances,XtGrabNone); EnvSetInstancesChanged(theEnv,FALSE); PrintChangedInstances(); XtSetArg(TheArgs[0], XtNleftBitmap,checker); } else { CreateInstanceWindow(); EnvSetInstancesChanged(theEnv,FALSE); PrintChangedInstances(); XtSetArg(TheArgs[0], XtNleftBitmap, checker); } XtSetValues(instances_window, TheArgs, 1); Browse_status[INSTANCE_WIN] = !Browse_status[INSTANCE_WIN]; } /********************************************************************************** * CreateInstanceWindow **********************************************************************************/ void CreateInstanceWindow() { void *theEnv = GetCurrentEnvironment(); Dimension height; char *name,labelBuffer[256]; struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); /* Change the name of the window to the current module */ if(theModule != NULL) { name = EnvGetDefmoduleName(theEnv,theModule); strcpy(labelBuffer,"Instances Window("); strcat(labelBuffer,name); strcat(labelBuffer,")"); } else { strcpy(labelBuffer,"Instances Window"); } XtSetArg(TheArgs[0], XtNheight, &height); XtGetValues(dialog, TheArgs, 1); height = (height + 150)/3; XtSetArg(TheArgs[0], XtNheight, height); instances = XtCreatePopupShell(labelBuffer, topLevelShellWidgetClass, toplevel, TheArgs, 1); XtSetArg(TheArgs[0], XtNdefaultDistance, 0); instances_form = XtCreateManagedWidget("instances_form", formWidgetClass, instances, TheArgs, 1); XtSetArg(TheArgs[0], XtNwidth, 250); XtSetArg(TheArgs[1], XtNeditType, XawtextAppend); XtSetArg(TheArgs[2], XtNscrollHorizontal,XawtextScrollAlways); XtSetArg(TheArgs[3], XtNscrollVertical, XawtextScrollAlways); instances_text = XtCreateManagedWidget("instances_text", asciiTextWidgetClass, instances_form, TheArgs, 4); XtOverrideTranslations(instances_text, XtParseTranslationTable(xclips_translation2)); XtPopup(instances, XtGrabNone); if (! EnvAddRouter(theEnv,"xinstances", 10, XclipsQuery, XclipsPrint, NULL, NULL, XclipsExit)) { EnvPrintRouter(theEnv,"werror", "Could not allocate xinstances router!\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } } /******************************************************************************* Name: Description: Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void GlobalsWindowCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); if (Browse_status[GLOBAL_WIN]) { XtPopdown(globals); XtSetArg(TheArgs[0], XtNleftBitmap, None); } else if(globals != NULL) { XtPopup(globals,XtGrabNone); EnvSetGlobalsChanged(theEnv,FALSE); PrintChangedGlobals(); XtSetArg(TheArgs[0], XtNleftBitmap,checker); } else { CreateGlobalWindow(); EnvSetGlobalsChanged(theEnv,FALSE); PrintChangedGlobals(); XtSetArg(TheArgs[0], XtNleftBitmap, checker); } XtSetValues(globals_window, TheArgs, 1); Browse_status[GLOBAL_WIN] = !Browse_status[GLOBAL_WIN]; } /********************************************************************************** * CreateGlobalWindow **********************************************************************************/ void CreateGlobalWindow() { void *theEnv = GetCurrentEnvironment(); Dimension height; char *name,labelBuffer[256]; struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); /* Change the name of the window to the current module */ if (theModule != NULL) { name = EnvGetDefmoduleName(theEnv,theModule); strcpy(labelBuffer,"Globals Window("); strcat(labelBuffer,name); strcat(labelBuffer,")"); } else { strcpy(labelBuffer,"Globals Window"); } XtSetArg(TheArgs[0], XtNheight, &height); XtGetValues(dialog, TheArgs, 1); height = (height + 150)/3; XtSetArg(TheArgs[0], XtNheight, height); globals = XtCreatePopupShell(labelBuffer, topLevelShellWidgetClass, toplevel, TheArgs, 1); XtSetArg(TheArgs[0], XtNdefaultDistance, 0); globals_form = XtCreateManagedWidget("globals_form", formWidgetClass, globals, TheArgs, 1); XtSetArg(TheArgs[0], XtNwidth, 250); XtSetArg(TheArgs[1], XtNeditType, XawtextAppend); XtSetArg(TheArgs[2], XtNscrollHorizontal,XawtextScrollAlways); XtSetArg(TheArgs[3], XtNscrollVertical, XawtextScrollAlways); globals_text = XtCreateManagedWidget("globals_text", asciiTextWidgetClass, globals_form, TheArgs, 4); XtOverrideTranslations(globals_text, XtParseTranslationTable(xclips_translation2)); XtPopup(globals, XtGrabNone); if (! EnvAddRouter(theEnv, "xglobals", 10, XclipsQuery, XclipsPrint, NULL, NULL, XclipsExit)) { EnvPrintRouter(theEnv,"werror", "Could not allocate xglobals router!\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } } /******************************************************************************* Name: AllWindowsCallback Description: This function turn all the browse flags to True, create all the windows and put the check mark in front of the items of the window menu Arguments: Returns: *******************************************************************************/ void AllWindowsCallback( Widget w, XtPointer client_data, XtPointer call_data) { int n = 0; /* ============================================================ * * If the fact window has not been created then create it * * ============================================================ */ if(!Browse_status[FACT_WIN]) { if(facts != NULL) XtPopup(facts,XtGrabNone); else CreateFactWindow(); XtSetArg(TheArgs[n],XtNleftBitmap,checker);n++; XtSetValues(facts_window,TheArgs,n); Browse_status[FACT_WIN] = !Browse_status[FACT_WIN]; PrintChangedFacts(); } /* ============================================================ * * If the agenda window has not been created then create it * * ============================================================ */ if(!Browse_status[AGENDA_WIN]) { if(agenda != NULL) XtPopup(agenda,XtGrabNone); else CreateAgendaWindow(); XtSetArg(TheArgs[n],XtNleftBitmap,checker);n++; XtSetValues(agenda_window,TheArgs,n); Browse_status[AGENDA_WIN] = !Browse_status[AGENDA_WIN]; PrintChangedAgenda(); } /* ============================================================ * * If the instance window has not been created then create it * * ============================================================ */ if(!Browse_status[INSTANCE_WIN]) { if(instances != NULL) XtPopup(instances,XtGrabNone); else CreateInstanceWindow(); XtSetArg(TheArgs[n],XtNleftBitmap,checker);n++; XtSetValues(instances_window,TheArgs,n); Browse_status[INSTANCE_WIN] = !Browse_status[INSTANCE_WIN]; PrintChangedInstances(); } /* ============================================================ * * If the global window has not been created then create it * * ============================================================ */ if(!Browse_status[GLOBAL_WIN]) { if(globals != NULL) XtPopup(globals,XtGrabNone); else CreateGlobalWindow(); XtSetArg(TheArgs[n],XtNleftBitmap,checker);n++; XtSetValues(globals_window,TheArgs,n); Browse_status[GLOBAL_WIN] = !Browse_status[GLOBAL_WIN]; PrintChangedGlobals(); } /* ============================================================ * * If the focus window has not been created then create it * * ============================================================ */ if(!Browse_status[FOCUS_WIN]) { if(focus != NULL) XtPopup(focus,XtGrabNone); else CreateFocusWindow(); XtSetArg(TheArgs[n],XtNleftBitmap,checker);n++; XtSetValues(focus_window,TheArgs,n); Browse_status[FOCUS_WIN] = !Browse_status[FOCUS_WIN]; PrintChangedFocus(); } } /******************************************************************************* Name: NoWindowsCallback Description: This fucntion will pop down all of the windows Arguments: Widget w - Unused XtPointer client_data, call_data - Unsused Returns: none *******************************************************************************/ void NoWindowsCallback( Widget w, XtPointer client_data, XtPointer call_data) { int n = 0; XtSetArg(TheArgs[n], XtNleftBitmap, None); n++; if (Browse_status[GLOBAL_WIN]) { XtPopdown(globals); XtSetValues(globals_window,TheArgs,n); Browse_status[GLOBAL_WIN] = !Browse_status[GLOBAL_WIN]; } if (Browse_status[INSTANCE_WIN]) { XtPopdown(instances); XtSetValues(instances_window,TheArgs,n); Browse_status[INSTANCE_WIN] = !Browse_status[INSTANCE_WIN]; } if(Browse_status[FACT_WIN]) { XtPopdown(facts); XtSetValues(facts_window,TheArgs,n); Browse_status[FACT_WIN] = !Browse_status[FACT_WIN]; } if(Browse_status[AGENDA_WIN]) { XtPopdown(agenda); XtSetValues(agenda_window,TheArgs,n); Browse_status[AGENDA_WIN] = !Browse_status[AGENDA_WIN]; } if(Browse_status[FOCUS_WIN]) { XtPopdown(focus); XtSetValues(focus_window,TheArgs,n); Browse_status[FOCUS_WIN] = !Browse_status[FOCUS_WIN]; } } /******************************************************************************* Name: CommandLineCLIPSCallback Description: Called when Command Line CLIPS is selected from the Window menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void CommandLineCLIPSCallback( Widget w, XtPointer client_data, XtPointer call_data) { system("xterm -e clips &"); } /******************************************************************************* Name: ColorUtilityCallback Description: Called when Color is selected from the Window menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void ColorUtilityCallback( Widget w, XtPointer client_data, XtPointer call_data) { system("color&"); } /******************************************************************************* Name: IntGetDefruleLis Description: Gets the list of rules Arguments: None Returns: *******************************************************************************/ int IntGetDefruleLis() { void *theEnv = GetCurrentEnvironment(); struct defrule *rule_ptr; int maxItems = 20,itemCount = 0; char *name; if ((rule_ptr = (struct defrule *) EnvGetNextDefrule(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String *)calloc(maxItems,sizeof(String)); while(rule_ptr != NULL) { name = EnvGetDefruleName(theEnv,(VOID*) rule_ptr); item_list[itemCount] = balloc(strlen(name) + 1,char); strcpy(item_list[itemCount], name); itemCount++; if (itemCount == (maxItems -1)) { maxItems = 2*maxItems; item_list = (String *)realloc(item_list,maxItems * sizeof(String)); } rule_ptr = (struct defrule *) EnvGetNextDefrule(theEnv, (VOID*)rule_ptr); } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /****************************************************************************** Name: DefruleRemoveCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data - not used Returns: None *******************************************************************************/ static void DefruleRemoveCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if (current->list_index == XAW_LIST_NONE) { return; } MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undefrule "); EnvPrintRouter(theEnv,"wclips","(undefrule "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /*=====================================================*/ /* Set this flag to True to get out of the event loop. */ /*=====================================================*/ quit_get_event = True; list_change = True; } /****************************************************************************** Name: DefruleMatchesCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefruleMatchesCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if (current->list_index == XAW_LIST_NONE) { return; } MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(matches "); EnvPrintRouter(theEnv,"wclips","(matches "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /*=====================================================*/ /* Set this flag to True to get out of the event loop. */ /*=====================================================*/ quit_get_event = True; } /****************************************************************************** Name: DefrulePprintCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefrulePprintCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE || EnvGetDefrulePPForm(theEnv,(struct constructHeader *) EnvFindDefrule(theEnv,current->string)) == NULL) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(ppdefrule "); EnvPrintRouter(theEnv,"wclips","(ppdefrule "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /****************************************************************************** Name: DefruleRefreshCallback Description: Calls CLIPS refresh command Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefruleRefreshCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(refresh "); EnvPrintRouter(theEnv,"wclips","(refresh "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); quit_get_event = True; } /******************************************************************************* Name: IntGetFactList Description: Gets list of facts Arguments: None Returns: *******************************************************************************/ int IntGetFactList() { void *theEnv = GetCurrentEnvironment(); struct deffacts *fact_ptr; int maxItems = 20,itemCount = 0; char *name; if((fact_ptr = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String*)calloc(maxItems,sizeof(String)); while(fact_ptr != NULL) { name = (char*) EnvGetDeffactsName(theEnv,fact_ptr); item_list[itemCount] = balloc(strlen(name) + 1,char); strcpy(item_list[itemCount],name); itemCount += 1; if(itemCount == (maxItems - 1)) { maxItems = 2 * (maxItems); item_list = (String*)realloc(item_list,maxItems * sizeof(String)); } fact_ptr = (struct deffacts *) EnvGetNextDeffacts(theEnv,(VOID*)fact_ptr); } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /****************************************************************************** Name: DeffactsRemove Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DeffactsRemove( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undeffacts "); EnvPrintRouter(theEnv,"wclips","(undeffacts "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list_change = True; } /****************************************************************************** Name: DeffactsPprint Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DeffactsPprint( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(ppdeffacts "); EnvPrintRouter(theEnv,"wclips","(ppdeffacts "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /******************************************************************************* Name: IntGetDeftemplateList Description: Gets list of deftemplates Arguments: None Returns: *******************************************************************************/ int IntGetDeftemplateList() { void *theEnv = GetCurrentEnvironment(); struct deftemplate *dtmpl_ptr; int itemCount = 0,maxItems = 20; char *name; if((dtmpl_ptr = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String *)calloc(maxItems,sizeof(String)); while(dtmpl_ptr != NULL) { name = EnvGetDeftemplateName(theEnv,(struct constructHeader *) dtmpl_ptr); item_list[itemCount] = balloc(strlen(name) + 1, char); strcpy(item_list[itemCount++],name); if(itemCount == (maxItems - 1)) { maxItems = 2 * maxItems; item_list = (String*)realloc(item_list,maxItems * sizeof(String)); } dtmpl_ptr = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,(VOID*)dtmpl_ptr); } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /****************************************************************************** Name: DeftemplateRemove Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DeftemplateRemove( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undeftemplate "); EnvPrintRouter(theEnv,"wclips","(undeftemplate "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list_change = True; } /****************************************************************************** Name: DeftemplatePprint Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DeftemplatePprint( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(ppdeftemplate "); EnvPrintRouter(theEnv,"wclips","(ppdeftemplate "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /******************************************************************************* Name: IntGetDeffunctionList Description: Gets list of deffunctions Arguments: None Returns: *******************************************************************************/ int IntGetDeffunctionList() { void *theEnv = GetCurrentEnvironment(); DEFFUNCTION * dfunc_ptr; int itemCount = 0,maxItems = 20; char *name; if((dfunc_ptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String *)calloc(maxItems,sizeof(String)); while(dfunc_ptr != NULL) { name = EnvGetDeffunctionName(theEnv,(VOID *) dfunc_ptr); item_list[itemCount] = balloc(strlen(name) + 1, char); strcpy(item_list[itemCount++],name); if(itemCount == (maxItems - 1)) { maxItems = maxItems * 2; item_list = (String *)realloc(item_list,maxItems * sizeof(String)); } dfunc_ptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,(VOID*)dfunc_ptr); } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /****************************************************************************** Name: DeffunctionRemoveCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DeffunctionRemoveCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undeffunction "); EnvPrintRouter(theEnv,"wclips","(undeffunction "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list_change = True; } /****************************************************************************** Name: DeffunctionPprintCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DeffunctionPprintCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if (current->list_index == XAW_LIST_NONE || EnvGetDeffunctionPPForm(theEnv,EnvFindDeffunction(theEnv,current->string)) == NULL) { return; } MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(ppdeffunction "); EnvPrintRouter(theEnv,"wclips","(ppdeffunction "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /*=====================================================*/ /* Set this flag to True to get out of the event loop. */ /*=====================================================*/ quit_get_event = True; } /******************************************************************************* Name: IntGetDefgenericList Description: Gets list of defgenerics Arguments: None Returns: *******************************************************************************/ int IntGetDefgenericList() { void *theEnv = GetCurrentEnvironment(); int maxItems = 20,itemCount = 0; struct generic_func *generic_func_ptr; char *name; if ((generic_func_ptr = (struct generic_func *) EnvGetNextDefgeneric(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String *)calloc(maxItems,sizeof(String)); while( generic_func_ptr != NULL) { name = (char*) EnvGetDefgenericName(theEnv,generic_func_ptr); item_list[itemCount] = balloc(strlen(name) + 1, char); strcpy(item_list[itemCount++],name); if (itemCount == (maxItems - 1)) { maxItems = maxItems * 2; item_list = (String *)realloc(item_list,maxItems*sizeof(String)); } generic_func_ptr = (struct generic_func *) EnvGetNextDefgeneric(theEnv,(VOID*)generic_func_ptr); } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /****************************************************************************** Name: DefgenericRemoveCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefgenericRemoveCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undefgeneric "); EnvPrintRouter(theEnv,"wclips","(undefgeneric "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list_change = True; } /****************************************************************************** Name: DefgenericPprintCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefgenericPprintCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE || EnvGetDefgenericPPForm(theEnv,EnvFindDefgeneric(theEnv,current->string)) == NULL) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(ppdefgeneric "); EnvPrintRouter(theEnv,"wclips","(ppdefgeneric "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /****************************************************************************** Name: DefgenericWatchCallback Description: Arguments: Return: *******************************************************************************/ static void DefgenericWatchCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID* defgenericPtr = NULL; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; defgenericPtr = EnvFindDefgeneric(theEnv,current->string); EnvSetDefgenericWatch(theEnv,!EnvGetDefgenericWatch(theEnv,defgenericPtr),defgenericPtr); } /****************************************************************************** Name: DefgenericMngrCheckBoxCallback Description: Arguments: Return: *******************************************************************************/ static void DefgenericMngrCheckBoxCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); void *defgenericPtr = NULL; Widget checkbox = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(w); if (current->list_index == XAW_LIST_NONE) { return; } defgenericPtr = EnvFindDefgeneric(theEnv,current->string); XtSetArg(TheArgs[0],XtNstate,EnvGetDefgenericWatch(theEnv,defgenericPtr)); XtSetValues(checkbox,TheArgs,1); } /****************************************************************************** Name: DefgenericMethodCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefgenericMethodCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget defmethodmanager, defmethodmanager_form, defmethodmanager_viewport, removeb, pprint, cancel,watch_label; static Widget watch; char title[MAX_CHAR_IN_BUF]; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); int itemCount = 0; if(current->list_index == XAW_LIST_NONE) return; /* ========================================== */ /* Get the defmethod list */ /* ========================================== */ itemCount = IntGetDefmethodList(current->string); if(item_list1 == NULL) { defmethodmanager_flag = False; return; } curr_def_name = balloc(strlen(current->string) + 1,char); strcpy(curr_def_name,current->string); defmethodmanager_flag = True; title[0] = 0; sprintf(title,"%s Defmethod Manager - %d Items",curr_def_name,itemCount); /* =========================================== */ /* Create the defmethod manager window */ /* =========================================== */ defmethodmanager = XtCreatePopupShell(title, topLevelShellWidgetClass, toplevel, NULL, 0); defmethodmanager_form = XtCreateManagedWidget("manager_form", formWidgetClass, defmethodmanager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); defmethodmanager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, defmethodmanager_form, TheArgs, 2); XtSetArg(TheArgs[0], XtNlist, item_list1); manager_list1 = XtCreateManagedWidget("manager_list", listWidgetClass, defmethodmanager_viewport, TheArgs, 1); /* ============================================= */ /* Create the Pprint button */ /* ============================================= */ XtSetArg(TheArgs[0], XtNfromHoriz, defmethodmanager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, defmethodmanager_form, TheArgs, 2); XtAddCallback(removeb,XtNcallback,RemoveDefmethodCallback,(XtPointer)manager_list1); XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, defmethodmanager_form, TheArgs, 3); XtAddCallback(pprint,XtNcallback,DefmethodPprintCallback,(XtPointer)manager_list1); /* ============================================= */ /* Create the Watch button */ /* ============================================= */ XtSetArg(TheArgs[1], XtNfromVert,pprint ); XtSetArg(TheArgs[2], XtNlabel, " "); watch = XtCreateManagedWidget("managerButton", toggleWidgetClass, defmethodmanager_form, TheArgs, 3); XtAddCallback(watch,XtNcallback,DefmethodWatchCallback,(XtPointer)manager_list1); XtAddCallback(manager_list1,XtNcallback,DefmethodMngrCheckBoxCallback,(XtPointer)watch); XtSetArg(TheArgs[2], XtNlabel,"Watch"); XtSetArg(TheArgs[0],XtNfromHoriz,watch); watch_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, defmethodmanager_form, TheArgs,3); /* ============================================= */ /* Create the DOne button */ /* ============================================= */ XtSetArg(TheArgs[0], XtNfromHoriz, defmethodmanager_viewport); XtSetArg(TheArgs[1], XtNfromVert, watch); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, defmethodmanager_form, TheArgs, 3); XtAddCallback(cancel, XtNcallback, CancelSelectSecondary, (XtPointer) defmethodmanager); XtPopup(defmethodmanager, XtGrabNonexclusive); } /****************************************************************************** Name: RemoveDefmethodCallback Description: removes aa method from the method list Arguments: w - not used client_data - not used call_data - not used Returns: None *******************************************************************************/ static void RemoveDefmethodCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); char theIndex[5]; int i; Widget aList = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(aList); if(current->list_index == XAW_LIST_NONE) return; for (i = 0; ('0' <= current->string[i]) && (current->string[i] <= '9');i++) theIndex[i] = current->string[i]; theIndex[i] = 0; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undefmethod "); EnvPrintRouter(theEnv,"wclips","(undefmethod "); AppendCommandString(theEnv,curr_def_name); EnvPrintRouter(theEnv,"wclips",curr_def_name); AppendCommandString(theEnv," "); EnvPrintRouter(theEnv,"wclips"," "); AppendCommandString(theEnv,theIndex); EnvPrintRouter(theEnv,"wclips",theIndex); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list1_change = True; } /****************************************************************************** Name: DefmethodPprintCallback Description: Print the method Arguments: w - not used client_data - the list widget call_data - not used Returns: None *******************************************************************************/ static void DefmethodPprintCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); char theIndex[5]; int i; unsigned methodIndex; Widget aList = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(aList); if(current->list_index == XAW_LIST_NONE) return; for (i = 0; ('0' <= current->string[i]) && (current->string[i] <= '9');i++) theIndex[i] = current->string[i]; theIndex[i] = 0; methodIndex = (unsigned)atoi(theIndex); if(EnvGetDefmethodPPForm(theEnv,EnvFindDefgeneric(theEnv,curr_def_name),methodIndex) == NULL) return; MoveEndOfFile(dialog_text, &TheEvent); AppendCommandString(theEnv,"(ppdefmethod "); EnvPrintRouter(theEnv,"wclips","(ppdefmethod "); AppendCommandString(theEnv,curr_def_name); EnvPrintRouter(theEnv,"wclips",curr_def_name); AppendCommandString(theEnv," "); EnvPrintRouter(theEnv,"wclips"," "); AppendCommandString(theEnv,theIndex); EnvPrintRouter(theEnv,"wclips",theIndex); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /******************************************************************************* Name: Description: Arguments: Returns: *******************************************************************************/ static void DefmethodWatchCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); char theIndex[5]; int i; unsigned MethodIndex; void *defgenericPtr = NULL; Widget aList = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(aList); if (current->list_index == XAW_LIST_NONE) { return; } for (i = 0; ('0' <= current->string[i]) && (current->string[i] <= '9');i++) theIndex[i] = current->string[i]; theIndex[i] = 0; MethodIndex = (unsigned) atoi(theIndex); defgenericPtr = EnvFindDefgeneric(theEnv,curr_def_name); EnvSetDefmethodWatch(theEnv,! EnvGetDefmethodWatch(theEnv,defgenericPtr,MethodIndex), defgenericPtr,MethodIndex); } /******************************************************************************* Name: DefmethodMngrCheckBoxCallback Description: Arguments: Returns: *******************************************************************************/ static void DefmethodMngrCheckBoxCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); char theIndex[5]; int i; unsigned MethodIndex; XawListReturnStruct *current = XawListShowCurrent(w); if (current->list_index == XAW_LIST_NONE) { return; } for (i = 0; ('0' <= current->string[i]) && (current->string[i] <= '9');i++) theIndex[i] = current->string[i]; theIndex[i] = 0; MethodIndex = (unsigned)atoi(theIndex); XtSetArg(TheArgs[0],XtNstate,EnvGetDefmethodWatch(theEnv,EnvFindDefgeneric(theEnv,curr_def_name),MethodIndex)); XtSetValues((Widget)client_data,TheArgs,1); } /******************************************************************************* Name: IntGetDefmethodList Description: Gets list of defmethods Arguments: None Returns: *******************************************************************************/ int IntGetDefmethodList( char *Aname) { void *theEnv = GetCurrentEnvironment(); VOID *genrc_ptr; unsigned theIndex; char buf[61]; register int itemCount = 0; int maxItems = 20; genrc_ptr = EnvFindDefgeneric(theEnv,Aname); if (item_list1 != NULL) { free(item_list1); } if ((theIndex = EnvGetNextDefmethod(theEnv,genrc_ptr,0)) == 0) { item_list1 = NULL; return(0); } item_list1 = (String*) calloc(maxItems,sizeof(String)); while (theIndex != 0) { EnvGetDefmethodDescription(theEnv,buf,60,genrc_ptr,theIndex); item_list1[itemCount] = balloc(strlen(buf) + 1,char); strcpy(item_list1[itemCount++],buf); if (itemCount == (maxItems - 1)) { maxItems = 2 * maxItems; item_list1 = (String*)realloc(item_list1,maxItems*sizeof(String)); } theIndex = EnvGetNextDefmethod(theEnv,genrc_ptr,theIndex); } item_list1[itemCount] = NULL; sortList(item_list1,itemCount); return(itemCount); } /******************************************************************************* Name: IntGetDefinstancesList Description: Gets list of definstances Arguments: None Returns: *******************************************************************************/ int IntGetDefinstancesList() { void *theEnv = GetCurrentEnvironment(); int maxItems = 20, itemCount = 0; struct definstance *definstance_ptr; char *name; if((definstance_ptr = (struct definstance *) EnvGetNextDefinstances(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String*)calloc(maxItems,sizeof(String)); while( definstance_ptr != NULL) { name = EnvGetDefinstancesName(theEnv, (VOID*)definstance_ptr); item_list[itemCount] = balloc(strlen(name) + 1, char); strcpy(item_list[itemCount++],name); if(itemCount == (maxItems - 1)) { maxItems = maxItems * 2; item_list = (String*)realloc(item_list,maxItems * sizeof(String)); } definstance_ptr = (struct definstance *) EnvGetNextDefinstances(theEnv,(VOID*)definstance_ptr); } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /****************************************************************************** Name: DefinstancesRemoveCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefinstancesRemoveCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undefinstances "); EnvPrintRouter(theEnv,"wclips","(undefinstances "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list_change = True; } /****************************************************************************** Name: DefinstancesPprintCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefinstancesPprintCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE || EnvGetDefinstancesPPForm(theEnv,EnvFindDefinstances(theEnv,current->string)) == NULL) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(ppdefinstances "); EnvPrintRouter(theEnv,"wclips","(ppdefinstances "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /******************************************************************************* Name: IntGetDefclassList Description: Gets list of defclasses Arguments: None Returns: *******************************************************************************/ int IntGetDefclassList() { void *theEnv = GetCurrentEnvironment(); int maxItems = 20, itemCount = 0; struct cls *cls_ptr; char *name; if ((cls_ptr = (struct cls *) EnvGetNextDefclass(theEnv,NULL)) == NULL) { item_list = NULL; return(0); } item_list = (String*)calloc(maxItems,sizeof(String)); while( cls_ptr != NULL) { name = (char*)EnvGetDefclassName(theEnv,cls_ptr); item_list[itemCount] = balloc(strlen(name) + 1, char); strcpy(item_list[itemCount++], name); if(itemCount == (maxItems - 1)) { maxItems = maxItems * 2; item_list = (String*)realloc(item_list,maxItems * sizeof(String)); } cls_ptr = (struct cls *) EnvGetNextDefclass(theEnv,(VOID*)cls_ptr); } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /****************************************************************************** Name: DefclassRemoveCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefclassRemoveCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(undefclass "); EnvPrintRouter(theEnv,"wclips","(undefclass "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list_change = True; } /****************************************************************************** Name: DefclassDescribeCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefclassDescribeCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(describe-class "); EnvPrintRouter(theEnv,"wclips","(describe-class "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /****************************************************************************** Name: DefclassBrowseCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefclassBrowseCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(browse-classes "); EnvPrintRouter(theEnv,"wclips","(browse-classes "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /****************************************************************************** Name: DefclassPprintCallback Description: Calls CLIPS Arguments: w - not used client_data - not used call_data Returns: None *******************************************************************************/ static void DefclassPprintCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE || EnvGetDefclassPPForm(theEnv,EnvFindDefclass(theEnv,current->string)) == NULL) return; MoveEndOfFile(dialog_text, &TheEvent); SetCommandString(theEnv,"(ppdefclass "); EnvPrintRouter(theEnv,"wclips","(ppdefclass "); AppendCommandString(theEnv,current->string); EnvPrintRouter(theEnv,"wclips",current->string); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /****************************************************************************** Name: DefclassMessageHandlersCallback Description: Displays a dialog box allowing the message handlers for the currently selected class to be browsed. Arguments: w - not used client_data - not used call_data - the list widget containing the list of defclass Returns: None *******************************************************************************/ static void DefclassMessageHandlersCallback( Widget w, XtPointer client_data, XtPointer call_data) { char title[MAX_CHAR_IN_BUF]; Widget defmessHdlrManager, defmessHdlrManager_form, defmessHdlrManager_viewport, removeb, pprint, cancel,watch,watch_label; int itemCount = 0; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; itemCount = IntGetDefmessgHndlerList(current->string); if(item_list1 == NULL) { defmessagehandler_flag = False; return; } curr_def_name = balloc(strlen(current->string) + 1,char); strcpy(curr_def_name,current->string); title[0] = 0; sprintf(title,"%s Defmessage-Handler Manager - %d Items",curr_def_name,itemCount); defmessagehandler_flag = True; /* ========================================== */ /* Create Defmessage Manager window */ /* ========================================== */ defmessHdlrManager = XtCreatePopupShell(title, topLevelShellWidgetClass, toplevel, NULL, 0); defmessHdlrManager_form = XtCreateManagedWidget("manager_form", formWidgetClass, defmessHdlrManager, NULL, 0); XtSetArg(TheArgs[0],XtNallowHoriz,True); XtSetArg(TheArgs[1],XtNallowVert,True); defmessHdlrManager_viewport = XtCreateManagedWidget("manager_viewport", viewportWidgetClass, defmessHdlrManager_form, TheArgs,2); XtSetArg(TheArgs[0], XtNlist, item_list1); manager_list1 = XtCreateManagedWidget("manager_list", listWidgetClass, defmessHdlrManager_viewport, TheArgs, 1); /* ========================================== */ /* Create the Remove button */ /* ========================================== */ XtSetArg(TheArgs[0], XtNfromHoriz, defmessHdlrManager_viewport); XtSetArg(TheArgs[1], XtNlabel, "Remove"); removeb = XtCreateManagedWidget("managerButton", commandWidgetClass, defmessHdlrManager_form, TheArgs, 2); XtAddCallback(removeb,XtNcallback,RemoveMessageHandlerCallback,(XtPointer)manager_list1); /* ========================================== */ /* Create the Pprrint button */ /* ========================================== */ XtSetArg(TheArgs[1], XtNfromVert, removeb); XtSetArg(TheArgs[2], XtNlabel, "Pprint"); pprint = XtCreateManagedWidget("managerButton", commandWidgetClass, defmessHdlrManager_form, TheArgs, 3); XtAddCallback(pprint,XtNcallback,MessageHandlerPprintCallback,manager_list1); /* ========================================== */ /* Create the Watch button */ /* ========================================== */ XtSetArg(TheArgs[1],XtNfromVert,pprint); XtSetArg(TheArgs[2],XtNlabel," "); watch = XtCreateManagedWidget("managerButton", toggleWidgetClass, defmessHdlrManager_form, TheArgs, 3); XtAddCallback(watch,XtNcallback,DefmessHdlrMngrWatchCallback,manager_list1); XtAddCallback(manager_list1,XtNcallback,DefmessHdlrMngrCheckBoxCallback,watch); XtSetArg(TheArgs[0],XtNfromHoriz,watch); XtSetArg(TheArgs[1],XtNfromVert,pprint); XtSetArg(TheArgs[2],XtNlabel,"Watch"); watch_label = XtCreateManagedWidget("checkBoxLabel", labelWidgetClass, defmessHdlrManager_form, TheArgs, 3); /* ========================================== */ /* Create the Cancel button */ /* ========================================== */ XtSetArg(TheArgs[0], XtNfromHoriz,defmessHdlrManager_viewport); XtSetArg(TheArgs[1], XtNfromVert, watch); XtSetArg(TheArgs[2], XtNlabel, "Done"); cancel = XtCreateManagedWidget("managerCancel", commandWidgetClass, defmessHdlrManager_form, TheArgs, 3); XtAddCallback(cancel,XtNcallback,CancelSelectSecondary,defmessHdlrManager); XtPopup(defmessHdlrManager, XtGrabNonexclusive); } /******************************************************************************* Name: IntGetDefmessgHndlerList Description: Gets the defmessage-handlers list Arguments: name of the defclass Returns: *******************************************************************************/ int IntGetDefmessgHndlerList( char *name) { void *theEnv = GetCurrentEnvironment(); VOID *defclass_ptr; unsigned theIndex; char *buf1,*buf2; unsigned int maxItems = 20; int itemCount = 0; defclass_ptr = EnvFindDefclass(theEnv,name); if(item_list1 != NULL) free(item_list1); if((theIndex = EnvGetNextDefmessageHandler(theEnv,defclass_ptr,0)) == 0) { item_list1 = NULL; return(0); } item_list1 = (String*)calloc(maxItems,sizeof(String)); while(theIndex != 0) { buf1 = EnvGetDefmessageHandlerName(theEnv,defclass_ptr,theIndex); buf2 = EnvGetDefmessageHandlerType(theEnv,defclass_ptr,theIndex); item_list1[itemCount] = balloc(strlen(buf1) + strlen(buf2) + 2,char); strcpy(item_list1[itemCount],buf1); strcat(item_list1[itemCount]," "); strcat(item_list1[itemCount++],buf2); if(itemCount == (maxItems - 1)) { maxItems = 2 * maxItems; item_list1 = (String*)realloc(item_list1,maxItems * sizeof(String)); } theIndex = EnvGetNextDefmessageHandler(theEnv,defclass_ptr,theIndex); } item_list1[itemCount] = NULL; sortList(item_list1,itemCount); return(itemCount); } /******************************************************************************* Name: RemoveMessageHandlerCallback Description: Take the message-handler out of the list Arguments: w - widget that initiate this call back call_data - not used client_data - the list widget which contains the list of the defmessage-handlers Returns: *******************************************************************************/ static void RemoveMessageHandlerCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); char buf[256]; int i; Widget aList = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(aList); if(current->list_index == XAW_LIST_NONE) return; for (i = 0; current->string[i] != ' '; i++) buf[i] = current->string[i]; buf[i] = 0; MoveEndOfFile(dialog_text, &TheEvent); AppendCommandString(theEnv,"(undefmessage-handler "); EnvPrintRouter(theEnv,"wclips","(undefmessage-handler "); AppendCommandString(theEnv,curr_def_name); EnvPrintRouter(theEnv,"wclips",curr_def_name); AppendCommandString(theEnv," "); EnvPrintRouter(theEnv,"wclips"," "); AppendCommandString(theEnv,buf); EnvPrintRouter(theEnv,"wclips",buf); strcpy(buf,&(current->string[i])); AppendCommandString(theEnv," "); EnvPrintRouter(theEnv,"wclips"," "); AppendCommandString(theEnv,buf); EnvPrintRouter(theEnv,"wclips",buf); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; list1_change = True; } /******************************************************************************* Name: MessageHandlerPprintCallback Description: Take the message-handler out of the list Arguments: w - widget that initiate this call back call_data - not used client_data - the list widget which contains the list of the defmessage-handlers Returns: *******************************************************************************/ static void MessageHandlerPprintCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); char buf[256]; int i; unsigned messageIndex; Widget aList = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(aList); if(current->list_index == XAW_LIST_NONE) return; for (i = 0; current->string[i] != ' '; i++) buf[i] = current->string[i]; buf[i] = 0; i++; messageIndex = EnvFindDefmessageHandler(theEnv,EnvFindDefclass(theEnv,curr_def_name), buf,&(current->string[i])); if(EnvGetDefmessageHandlerPPForm(theEnv,EnvFindDefclass(theEnv,curr_def_name),messageIndex) == NULL) return; MoveEndOfFile(dialog_text, &TheEvent); AppendCommandString(theEnv,"(ppdefmessage-handler "); EnvPrintRouter(theEnv,"wclips","(ppdefmessage-handler "); AppendCommandString(theEnv,curr_def_name); EnvPrintRouter(theEnv,"wclips",curr_def_name); AppendCommandString(theEnv," "); EnvPrintRouter(theEnv,"wclips"," "); AppendCommandString(theEnv,buf); EnvPrintRouter(theEnv,"wclips",buf); strcpy(buf,&(current->string[i])); AppendCommandString(theEnv," "); EnvPrintRouter(theEnv,"wclips"," "); AppendCommandString(theEnv,buf); EnvPrintRouter(theEnv,"wclips",buf); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips",")\n"); /* ================================================== */ /* Set this flag to True to get out of the event loop */ /* ================================================== */ quit_get_event = True; } /******************************************************************************* Name: Initialize Description: Arguents: list - Returns: *******************************************************************************/ void InitializeList( String list[1000]) { register int i = 0; while(list[i] != NULL) { release(list[i]); list[i++] = NULL; } } /******************************************************************************* Name: SetManagerList Description: Arguments: widget Returns: *******************************************************************************/ void SetManagerList( Widget widget) { manager_list = widget; } /******************************************************************************* Name: GetManagerList Description: Arguments: None Returns: manager_list *******************************************************************************/ Widget GetManagerList() { return(manager_list); } /******************************************************************************* Name: RefreshMngrList Description: Update the manager lists if neccessary Arguments: None Returns: Notes: manager_list and manager_list1 are the global variables which store the list widget(s) on the current manager window(s) *******************************************************************************/ int RefreshMngrList() { int itemCount = 0; char buffer[MAX_CHAR_IN_BUF]; Window theWindow; Display *theDisplay; if(list_change) { list_change = False; /* =========================================================== * * Update the rule manager list * * =========================================================== */ if(defrulemanager_flag) { itemCount = IntGetDefruleLis(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); defrulemanager_flag = False; } else { defrulemanager_flag = True; theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Defrule Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } /* =========================================================== * * Update the deffact manager list * * =========================================================== */ else if (deffactsmanager_flag) { itemCount = IntGetFactList(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); deffactsmanager_flag = False; } else { deffactsmanager_flag = True; theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Deffacts Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } /* =========================================================== * * Update the deftemplate manager list * * =========================================================== */ else if (deftemplatemanager_flag) { itemCount = IntGetDeftemplateList(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); deftemplatemanager_flag = False; } else { deftemplatemanager_flag = True; theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Deftemplate Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } /* =========================================================== * * Update the deffunction manager list * * =========================================================== */ else if (deffunctionmanager_flag) { itemCount = IntGetDeffunctionList(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); deffunctionmanager_flag = False; } else { deffunctionmanager_flag = True; theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Deffunction Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } /* =========================================================== * * Update the defglobal manager list * * =========================================================== */ else if (defglobalmanager_flag) { itemCount = IntGetDefglobalList(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); defglobalmanager_flag = False; } else { defglobalmanager_flag = True; theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Defglobal Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } /* =========================================================== * * Update the defgeneric manager list * * =========================================================== */ else if (defgenericmanager_flag) { itemCount = IntGetDefgenericList(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); defgenericmanager_flag = False; } else { /*defgenericmanager_flag = True;*/ theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Defgeneric Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } /* =========================================================== * * Update the definstances manager list * * =========================================================== */ else if (definstancesmanager_flag) { itemCount = IntGetDefinstancesList(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); definstancesmanager_flag = False; } else { definstancesmanager_flag = True; theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Definstances Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } /* =========================================================== * * Update the defclass manager list * * =========================================================== */ else if (defclassmanager_flag) { itemCount = IntGetDefclassList(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); defclassmanager_flag = False; } else { defclassmanager_flag = True; theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Defclass Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } /* =========================================================== * * Update the agenda manager list * * =========================================================== */ else if (agendamanager_flag) { itemCount = IntGetAgendaList(); if(item_list == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list)))); ClearParameters(); agendamanager_flag = False; } else { agendamanager_flag = True; theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list)))); sprintf(buffer,"Agenda Manager - %d Items",itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list,item_list,0,0,False); } } } /* End of list change = True */ /* =========================================================== * * Update the defmethod manager list * * =========================================================== */ else if (list1_change) { if ((defmethodmanager_flag)&&(list1_change)) { list1_change = False; itemCount = IntGetDefmethodList(curr_def_name); if(item_list1 == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list1)))); defmethodmanager_flag = False; release(curr_def_name); } else { theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list1)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list1)))); sprintf(buffer,"%s Defmethod Manager - %d Items",curr_def_name,itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list1,item_list1,0,0,False); } } /* =========================================================== * * Update the defmessage handler list * * =========================================================== */ else if((defmessagehandler_flag)&&(list1_change)) { list1_change = False; itemCount = IntGetDefmessgHndlerList(curr_def_name); if(item_list1 == NULL) { XtDestroyWidget(XtParent(XtParent(XtParent(manager_list1)))); defmessagehandler_flag = False; release(curr_def_name); } else { theWindow = XtWindow(XtParent(XtParent(XtParent(manager_list1)))); theDisplay = XtDisplay(XtParent(XtParent(XtParent(manager_list1)))); sprintf(buffer,"%s Defmessage-Handler Manager - %d Items",curr_def_name,itemCount); XStoreName(theDisplay,theWindow,buffer); XawListChange(manager_list1,item_list1,0,0,False); } } } /* End of list1_change = True */ return(0); } /******************************************************************************* Name: ClearParameters Description: Clear the list_change flag t False and reset the manager widget to NULL Arguments: None Returns: *******************************************************************************/ void ClearParameters() { list_change = False; SetManagerList((Widget)NULL); } /****************************************************************************** Name: CancelSelectPrimary Description: Destroys top level popup window for managers Arguments: w - not used client_data - widget to destroy call_data - not used Returns: None *******************************************************************************/ void CancelSelectPrimary( Widget w, XtPointer client_data, XtPointer call_data) { Widget widget = (Widget) client_data; XtDestroyWidget(widget); ClearParameters(); free(item_list); item_list = NULL; defrulemanager_flag = False; deffactsmanager_flag = False; deftemplatemanager_flag = False; deffunctionmanager_flag = False; defglobalmanager_flag = False; defgenericmanager_flag = False; definstancesmanager_flag = False; defclassmanager_flag = False; agendamanager_flag = False; } /****************************************************************************** Name: CancelSelectSecondary Description: Destroys second level popup window for managers Arguments: w - not used client_data - widget to destroy call_data - not used Returns: None *******************************************************************************/ static void CancelSelectSecondary( Widget w, XtPointer client_data, XtPointer call_data) { Widget widget = (Widget) client_data; XtDestroyWidget(widget); list1_change = False; manager_list1 = NULL; release(curr_def_name); free(item_list1); item_list1 = NULL; defmethodmanager_flag = False; defmessagehandler_flag = False; } /****************************************************************************** Name: DefruleBreakPointCallback Description: Arguments: Return: *******************************************************************************/ static void DefruleBreakPointCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); Boolean OnOff = False; VOID *defrulePtr; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if (current->list_index == XAW_LIST_NONE) { return; } defrulePtr = EnvFindDefrule(theEnv,current->string); XtSetArg(TheArgs[0],XtNstate,&OnOff); XtGetValues(w,TheArgs,1); if (OnOff == True) { EnvSetBreak(theEnv,defrulePtr); } else { if (EnvRemoveBreak(theEnv,defrulePtr) == CLIPS_FALSE) { EnvPrintRouter(theEnv,"werror","Rule "); EnvPrintRouter(theEnv,"werror",current->string); EnvPrintRouter(theEnv,"werror"," does not have a breakpoint set.\n"); } } } /****************************************************************************** Name: DefruleActivationCallback Description: Arguments: Return: *******************************************************************************/ static void DefruleActivationCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID *defrulePtr; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; defrulePtr = EnvFindDefrule(theEnv,current->string); EnvSetDefruleWatchActivations(theEnv,(! EnvGetDefruleWatchActivations(theEnv,defrulePtr)),defrulePtr); } /****************************************************************************** Name: DefruleFiringsCallback Description: Arguments: Return: *******************************************************************************/ static void DefruleFiringsCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID *defrulePtr; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if (current->list_index == XAW_LIST_NONE) { return; } defrulePtr = EnvFindDefrule(theEnv,current->string); EnvSetDefruleWatchFirings(theEnv,(! EnvGetDefruleWatchFirings(theEnv,defrulePtr)),defrulePtr); } /****************************************************************************** Name: DefruleMngrCheckboxesCallback Description: Arguments: Return: *******************************************************************************/ static void DefruleMngrCheckboxesCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID *defrulePtr; Widget *CheckBoxes = (Widget*)client_data; XawListReturnStruct *current = XawListShowCurrent(w); if (current->list_index == XAW_LIST_NONE) { return; } defrulePtr = EnvFindDefrule(theEnv,current->string); XtSetArg(TheArgs[0],XtNstate,EnvDefruleHasBreakpoint(theEnv,defrulePtr)); XtSetValues(CheckBoxes[0],TheArgs,1); XtSetArg(TheArgs[0],XtNstate,EnvGetDefruleWatchActivations(theEnv,defrulePtr)); XtSetValues(CheckBoxes[1],TheArgs,1); XtSetArg(TheArgs[0],XtNstate,EnvGetDefruleWatchFirings(theEnv,defrulePtr)); XtSetValues(CheckBoxes[2],TheArgs,1); } /****************************************************************************** Name: WatchInstancesCallback Description: Arguments: Return: *******************************************************************************/ static void WatchInstancesCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID *defclassPtr; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; defclassPtr = EnvFindDefclass(theEnv,current->string); EnvSetDefclassWatchInstances(theEnv,! EnvGetDefclassWatchInstances(theEnv,defclassPtr),defclassPtr); } /****************************************************************************** Name: WatchSlotCallback Description: Arguments: Return: *******************************************************************************/ static void WatchSlotCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID *defclassPtr; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; defclassPtr = EnvFindDefclass(theEnv,current->string); EnvSetDefclassWatchSlots(theEnv, ! EnvGetDefclassWatchSlots(theEnv,defclassPtr),defclassPtr); } /****************************************************************************** Name: DefclssMngrChckbxCallback Description: Arguments: Return: *******************************************************************************/ static void DefclssMngrChckbxCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); void *defclassPtr; Widget *CheckBoxes = (Widget*)client_data; XawListReturnStruct *current = XawListShowCurrent(w); if (current->list_index == XAW_LIST_NONE) return; defclassPtr = EnvFindDefclass(theEnv,current->string); XtSetArg(TheArgs[0],XtNstate,EnvGetDefclassWatchInstances(theEnv,defclassPtr)); XtSetValues(CheckBoxes[0],TheArgs,1); XtSetArg(TheArgs[0],XtNstate,EnvGetDefclassWatchSlots(theEnv,defclassPtr)); XtSetValues(CheckBoxes[1],TheArgs,1); } /****************************************************************************** Name: DeftemplateWatchCallback Description: Arguments: Return: *******************************************************************************/ static void DeftemplateWatchCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); void *deftemplatePtr = NULL; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if (current->list_index == XAW_LIST_NONE) { return; } deftemplatePtr = EnvFindDeftemplate(theEnv,current->string); EnvSetDeftemplateWatch(theEnv,! EnvGetDeftemplateWatch(theEnv,deftemplatePtr),deftemplatePtr); } /****************************************************************************** Name: DeftemplateMngrCheckboxCallback Description: Arguments: Return: *******************************************************************************/ static void DeftemplateMngrCheckboxCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID* deftemplatePtr = NULL; Widget checkbox = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(w); if(current->list_index == XAW_LIST_NONE) return; deftemplatePtr = EnvFindDeftemplate(theEnv,current->string); XtSetArg(TheArgs[0],XtNstate,EnvGetDeftemplateWatch(theEnv,deftemplatePtr)); XtSetValues(checkbox,TheArgs,1); } /****************************************************************************** Name: DeffunctionWatchCallback Description: Arguments: Return: *******************************************************************************/ static void DeffunctionWatchCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID* deffunctionPtr = NULL; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; deffunctionPtr = EnvFindDeffunction(theEnv,current->string); EnvSetDeffunctionWatch(theEnv,! EnvGetDeffunctionWatch(theEnv,deffunctionPtr),deffunctionPtr); } /****************************************************************************** Name: DeffunctionMngrCheckBoxCallback Description: Arguments: Return: *******************************************************************************/ static void DeffunctionMngrCheckboxCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID *deffunctionPtr = NULL; Widget checkbox = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(w); if (current->list_index == XAW_LIST_NONE) return; deffunctionPtr = EnvFindDeffunction(theEnv,current->string); XtSetArg(TheArgs[0],XtNstate,EnvGetDeffunctionWatch(theEnv,deffunctionPtr)); XtSetValues(checkbox,TheArgs,1); } /****************************************************************************** Name: DefmessHdlrMngrWatchCallback Description: Arguments: Return: *******************************************************************************/ static void DefmessHdlrMngrWatchCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID *defclassPtr = NULL; char *buf1,buf2[20]; unsigned i,j = 0,theIndex; Widget list_widget = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(list_widget); if(current->list_index == XAW_LIST_NONE) return; /* ======================================= */ /* get the name of the defmessage handler */ /* ====================================== */ buf1 = (char*)balloc(strlen(current->string),char); for (i = 0; current->string[i] != ' '; i++) buf1[i] = current->string[i]; buf1[i] = 0; while(current->string[i] == ' ') i++; /* ======================================= */ /* Get the handler-type */ /* ======================================= */ while(current->string[i] != 0) buf2[j++] = current->string[i++]; buf2[j] = 0; defclassPtr = EnvFindDefclass(theEnv,curr_def_name); theIndex = EnvFindDefmessageHandler(theEnv,defclassPtr,buf1,buf2); EnvSetDefmessageHandlerWatch(theEnv, (! EnvGetDefmessageHandlerWatch(theEnv,defclassPtr,theIndex)), defclassPtr,theIndex); free(buf1); } /****************************************************************************** Name: DefmessHdlrMngrCheckBoxCallback Description: Arguments: Return: *******************************************************************************/ static void DefmessHdlrMngrCheckBoxCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); VOID* defclassPtr = NULL; char *buf1; char buf2[20]; unsigned i,j = 0, theIndex; Widget checkbox = (Widget)client_data; XawListReturnStruct *current = XawListShowCurrent(w); if (current->list_index == XAW_LIST_NONE) { return; } /* ======================================= */ /* get the name of the defmessage handler */ /* ====================================== */ buf1 = (char*)balloc(strlen(current->string),char); for (i = 0; current->string[i] != ' '; i++) buf1[i] = current->string[i]; buf1[i] = 0; while(current->string[i] == ' ') i++; /* ======================================= */ /* Get the handler-type */ /* ======================================= */ while(current->string[i] != 0) buf2[j++] = current->string[i++]; buf2[j] = 0; defclassPtr = EnvFindDefclass(theEnv,curr_def_name); theIndex = EnvFindDefmessageHandler(theEnv,defclassPtr,buf1,buf2); XtSetArg(TheArgs[0],XtNstate,EnvGetDefmessageHandlerWatch(theEnv,defclassPtr,theIndex)); XtSetValues(checkbox,TheArgs,1); free(buf1); } clips-6.24/x-prjct/xinterface/xmenu_file.c0000755000175000017500000012361610444323570016741 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_FILE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains all the callback functions for the file */ /* menu. */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _XMENU_FILE_SOURCE_ #include #include #include #include #include "setup.h" #include "constant.h" #include "commline.h" #include "router.h" #include "symbol.h" #include "scanner.h" #include "xsetup.h" #include "xclips.h" #include "xclipstext.h" #include "xmenu.h" #include "xmain.h" #include "xmenu_file.h" #include "xmenu_wind.h" #include #include #include #include #include #ifndef MAX #define MAX(x, y) ((x) > (y) ? (x) : (y)) #endif /********** local functions not visible outside this file **********/ static char * GetBufferFromTextEdit(Widget); static void printMatch(Widget,XtPointer,XtPointer); static void printMatchForTextEdit(Widget,XtPointer,XtPointer); static void ClipsSave(void); static char **GetDirectory(void); static void FileToDialog(Widget,XtPointer,XtPointer); static void GetFileForCLIPS(char *); /********** local variables that available to the other files **********/ Widget file_dribble; Widget TheFile, file_list; int file_item = -1; char path[255]; char **filenames = NULL; char *completionString = NULL; int number_entries; /******************************************************************************* Name: EditCallback Description: Called when Edit is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void EditCallback( Widget w, XtPointer client_data, XtPointer call_data) { file_item = EDIT; (void)FileSelect(); } /******************************************************************************* Name: CompletionDialogCallback Description: Called when Completion is selected form File menu Arguments: w - menu item that was selected client_data - dialog window or edit window call_data - not used Returns: None *******************************************************************************/ void CompletionDialogCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); unsigned int NumberOfMatches; int length; struct symbolMatch *matches; char *commandString; /* ================================================== */ /* Free the memory of completionString before assign */ /* it to the new string. */ /* ================================================== */ if(completionString != NULL) { free(completionString); completionString = NULL; } /* =========================================================== */ /* Get the the uncompleted command string; if there is none */ /* sound the bell and exit, else determine if the last token */ /* of the string can be complete */ /* =========================================================== */ commandString = GetCommandString(GetCurrentEnvironment()); if(commandString != NULL) { length = strlen(commandString); commandString = GetCommandCompletionString(GetCurrentEnvironment(),commandString,length); } if(commandString == NULL) { XBell(XtDisplay(toplevel),100); return; } /* ============================================================ */ /* Copy the command string to a global variable for later use. */ /* Global completionString has to be used here due to the */ /* limitation of the number of arguments could be passed in the */ /* call back function of in X window system. */ /* ============================================================ */ completionString = (char*)malloc(strlen(commandString) + 1); strcpy(completionString,commandString); /* ============================================================ */ /* Find the match(es). If there is none, sound the bell and */ /* exit; else if there is one match complete the command; else */ /* if there are more than one display them */ /* ============================================================ */ matches = FindSymbolMatches(GetCurrentEnvironment(),completionString,&NumberOfMatches,NULL); if(NumberOfMatches == 0) { XBell(XtDisplay(toplevel),100); return; } else if (NumberOfMatches == 1) { length = strlen(completionString); AppendCommandString(GetCurrentEnvironment(),&(matches->match->contents[length])); EnvPrintRouter(theEnv,"stdin",&(matches->match->contents[length])); } else { DisplayMatchedList(dialog_text,matches); } } /******************************************************************************* Name: CompletionEditCallback Description: Called when Completion is selected form File menu in the editor. Arguments: w - menu item that was selected client_data - dialog window or edit window call_data - not used Returns: None *******************************************************************************/ void CompletionEditCallback( Widget w, XtPointer client_data, XtPointer call_data) { unsigned int NumberOfMatches; int length; struct symbolMatch *matches; XawTextBlock text; char *matchString = NULL; Widget source = XawTextGetSource((Widget)client_data); XawTextPosition CurrentPosition,EndPosition; /* ================================================== */ /* Free the memory of completionString before assign */ /* it to the new string. */ /* ================================================== */ if(completionString != NULL) { free(completionString); completionString = NULL; } /* =================================================== */ /* Get the beginning and ending positions of the */ /* selection. If there is no selection get the last */ /* word from the cursor. */ /* ====================================================*/ XawTextGetSelectionPos((Widget)client_data,&CurrentPosition,&EndPosition); if(CurrentPosition == EndPosition) /* No selection was made */ { matchString = GetBufferFromTextEdit((Widget)client_data); length = strlen(matchString); } else { XawTextSourceRead(source,CurrentPosition,&text,EndPosition - CurrentPosition); XawTextUnsetSelection((Widget)client_data); XawTextSetInsertionPoint((Widget)client_data,EndPosition); matchString = text.ptr; length = text.length; } /* ======================================= */ /* Determine if the word can be matched. */ /* ======================================= */ matchString = GetCommandCompletionString(GetCurrentEnvironment(),matchString,length); if(matchString == NULL) { XBell(XtDisplay(toplevel),100); return; } completionString = (char*)malloc(strlen(matchString) + 1); strcpy(completionString,matchString); matches = FindSymbolMatches(GetCurrentEnvironment(),completionString,&NumberOfMatches,NULL); if(NumberOfMatches == 0) { XBell(XtDisplay(toplevel),100); return; } else if (NumberOfMatches == 1) { length = strlen(completionString); text.firstPos = 0; text.length = strlen(&(matches->match->contents[length])); text.ptr = &(matches->match->contents[length]); XawTextReplace((Widget)client_data, XawTextGetInsertionPoint((Widget)client_data), XawTextGetInsertionPoint((Widget)client_data),&text); XawTextSetInsertionPoint((Widget)client_data, XawTextGetInsertionPoint((Widget)client_data) + text.length); } else { DisplayMatchedList((Widget)client_data,matches); } } /******************************************************************************* GetBufferFromTextEdit Description : This function will return the last word in the editor from the cursor *******************************************************************************/ static char * GetBufferFromTextEdit( Widget w) { XawTextBlock text_return; char *buffer; Widget source = XawTextGetSource(w); XawTextPosition NewPos,EndPos = XawTextGetInsertionPoint(w); /* ================================================ */ /* If Cursor is at the begining return empty */ /* string,orther while move the cursor backward */ /* until it hits the space then read and return */ /* the last word. */ /* ================================================ */ if(EndPos == 0) return(""); NewPos = EndPos - 1; XawTextSourceRead(source,NewPos,&text_return,1); while((text_return.ptr[0] != ' ') && (NewPos != 0)) { NewPos--; XawTextSourceRead(source,NewPos,&text_return,1); } if(NewPos != 0) NewPos++; XawTextSourceRead(source,NewPos,&text_return,EndPos - NewPos); buffer = (char *)malloc(text_return.length + 1); strncpy(buffer,text_return.ptr,text_return.length); buffer[text_return.length] = 0; return(buffer); } /******************************************************************************* Name DisplayMatchedList Description : Called when there are more than one matches for completion command *******************************************************************************/ int DisplayMatchedList( Widget w, struct symbolMatch *matches) { Widget matchShell,matchForm,matchViewport, matchDialog,matchList; int n; if(GetMatchList(matches) == 0) return(0); matchShell = XtCreatePopupShell("Matches", topLevelShellWidgetClass, toplevel, NULL, 0); matchForm = XtCreateManagedWidget( "manager_form", formWidgetClass, matchShell, NULL,0); XtSetArg(TheArgs[0],XtNallowHoriz, True); XtSetArg(TheArgs[1],XtNallowVert, True); matchViewport = XtCreateManagedWidget("manager_viewport",viewportWidgetClass, matchForm,NULL,0); n = 0; XtSetArg(TheArgs[n],XtNlist,item_list);n++; matchList = XtCreateManagedWidget("manager_list", listWidgetClass, matchViewport, TheArgs,n); n = 0; XtSetArg(TheArgs[n], XtNresizable, True);n++; XtSetArg(TheArgs[n],XtNlabel,"");n++; XtSetArg(TheArgs[n], XtNvalue, "");n++; XtSetArg(TheArgs[n], XtNfromVert, matchViewport);n++; XtSetArg(TheArgs[n], XtNicon, clips_logo);n++; XtSetArg(TheArgs[n], XtNleft, XtChainLeft);n++; XtSetArg(TheArgs[n], XtNright, XtChainRight);n++; XtSetArg(TheArgs[n], XtNtop, XtChainBottom);n++; XtSetArg(TheArgs[n], XtNbottom, XtChainBottom);n++; /* ============================================================= */ /* If the current active window is clips dialog box then pass */ /* the appropriate function to handle the match for the clips */ /* dialog; else the funcTion handling the match for the text */ /* editor is passed as the callback function. */ /* ============================================================= */ if(w == dialog_text) { matchDialog = XtCreateManagedWidget("match_dialog", dialogWidgetClass, matchForm, TheArgs, n); XawDialogAddButton(matchDialog, "SELECT",printMatch, (XtPointer)completionString); } else { matchDialog = XtCreateManagedWidget("match_editor", dialogWidgetClass, matchForm, TheArgs, n); XawDialogAddButton(matchDialog, "SELECT",printMatchForTextEdit,(XtPointer)w); } XawDialogAddButton(matchDialog, "CANCEL", CancelPopupSelect, (XtPointer) matchForm); XtAddCallback(matchList, XtNcallback, FileToDialog, (XtPointer) matchDialog); XtPopup(matchShell,XtGrabNonexclusive); return 0; } /******************************************************************************* Name: MatchDialogReturnD Description: Called when pressing return key in match dialog widget Arguments: w - Widget that caused action to be called event - Not used params - Dialog widget num_params - Not used Returns: None *******************************************************************************/ void MatchDialogReturnD( Widget w, XEvent *event, String *params, Cardinal *num_params) { printMatch(w,(XtPointer)completionString,NULL); } /******************************************************************************* Name: MatchDialogReturnE Description: Called when pressing return key in match dialog widget Arguments: w - Widget that caused action to be called event - Not used params - editor widget num_params - Not used Returns: None Notes : Currently, this does not work yet since I do not know how to pass the text editor without make it a global variable. *******************************************************************************/ void MatchDialogReturnE( Widget w, XEvent *event, String *params, Cardinal *num_params) { /*printMatchForTextEdit(w,params,NULL);*/ } /******************************************************************************* Name: printMatch Description: Simulates callbacks for dialog widget Arguments: w - Dialog widget client_data - Dialog widget call_data - Not Used Returns: None *******************************************************************************/ static void printMatch( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); String aString = XawDialogGetValueString(XtParent(w)); int length = strlen((char*)client_data); AppendCommandString(theEnv,&(aString[length])); EnvPrintRouter(theEnv,"stdin",&(aString[length])); XtDestroyWidget(XtParent(XtParent(XtParent(w)))); } /******************************************************************************* Name: printMatchForTextEdit Description: Simulates callbacks for dialog widget Arguments: w - Dialog widget client_data - Dialog widget call_data - Not Used Returns: None *******************************************************************************/ static void printMatchForTextEdit( Widget w, XtPointer client_data, XtPointer call_data) { XawTextBlock text; String aString = XawDialogGetValueString(XtParent(w)); Widget text_widget = (Widget)client_data; int length; length = strlen(completionString); text.firstPos = 0; text.length = strlen(&(aString[length])); text.ptr = &(aString[length]); XawTextReplace(text_widget, XawTextGetInsertionPoint(text_widget), XawTextGetInsertionPoint(text_widget),&text); XawTextSetInsertionPoint(text_widget, XawTextGetInsertionPoint(text_widget) + text.length); XtDestroyWidget(XtParent(XtParent(XtParent(w)))); } /******************************************************************************* Name: GetDefruleList Description: Gets the list of rules Arguments: None Returns: *******************************************************************************/ int GetMatchList( struct symbolMatch *matches) { int maxItems = 20,itemCount; if(matches == NULL) return(0); if(item_list != NULL) { free(item_list); item_list = NULL; } item_list = (String *)calloc(maxItems,sizeof(String)); for(itemCount = 0;matches != NULL;matches = matches->next) { item_list[itemCount] = balloc(strlen(matches->match->contents) + 1,char); strcpy(item_list[itemCount], matches->match->contents); itemCount++; if(itemCount == (maxItems -1)) { maxItems = 2*maxItems; item_list = (String *)realloc(item_list,maxItems * sizeof(String)); } } item_list[itemCount] = NULL; sortList(item_list,itemCount); return(itemCount); } /********************************************************************** * sortList **********************************************************************/ void sortList( String *list, int num) { int i,j,theIndex; char *tempString; if(num == 1) return; for(i = 0;i < num;i++) { tempString = list[i]; theIndex = i; for(j = i + 1;j < num; j++) { if(strcmp(tempString,list[j]) > 0) { tempString = list[j]; theIndex = j; } } if(i != theIndex) { list[theIndex] = list[i]; list[i] = tempString; } } } /******************************************************************************* Name: LoadBatchCallback Description: Called when Load Batch is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void LoadBatchCallback( Widget w, XtPointer client_data, XtPointer call_data) { file_item = LOADBATCH; (void)FileSelect(); } /******************************************************************************* Name: LoadBinaryCallback Description: Called when Load Binary is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void LoadBinaryCallback( Widget w, XtPointer client_data, XtPointer call_data) { file_item = LOADBINARY; (void)FileSelect(); } /******************************************************************************* Name: LoadFactsCallback Description: Called when Load Facts is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void LoadFactsCallback( Widget w, XtPointer client_data, XtPointer call_data) { file_item = LOADFACTS; (void)FileSelect(); } /******************************************************************************* Name: LoadRulesCallback Description: Called when Load Rules is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void LoadRulesCallback( Widget w, XtPointer client_data, XtPointer call_data) { file_item = LOADRULES; (void)FileSelect(); } /******************************************************************************* Name: DribbleCallback Description: Called when Dribble is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void DribbleCallback( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); MoveEndOfFile(dialog_text, &TheEvent); file_item = DRIBBLEON; if (Dribble_status) { XtSetArg(TheArgs[0], XtNleftBitmap, None); XtSetValues(file_dribble, TheArgs, 1); SetCommandString(theEnv,"(dribble-off)\n"); if(!CommandLineData(theEnv)->EvaluatingTopLevelCommand) EnvPrintRouter(theEnv,"wclips","(dribble-off)\n"); quit_get_event = True; Dribble_status = !Dribble_status; } else FileSelect(); } /******************************************************************************* Name: SaveBinaryCallback Description: Called when Save Binary is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void SaveBinaryCallback( Widget w, XtPointer client_data, XtPointer call_data) { file_item = SAVEBINARY; ClipsSave(); } /******************************************************************************* Name: SaveFactsCallback Description: Called when Save Facts is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void SaveFactsCallback( Widget w, XtPointer client_data, XtPointer call_data) { file_item = SAVEFACTS; ClipsSave(); } /******************************************************************************* Name: SaveRulesCallback Description: Called when Save Rules is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void SaveRulesCallback( Widget w, XtPointer client_data, XtPointer call_data) { file_item = SAVERULES; ClipsSave(); } /******************************************************************************* Name: QuitCallback Description: Called when Quit is selected form File menu Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void QuitCallback( Widget w, XtPointer client_data, XtPointer call_data) { Widget confirmshell, confirm; confirmshell = XtCreatePopupShell("Confirmation", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNlabel, "Quit XCLIPS.\nAre you sure?"); XtSetArg(TheArgs[1], XtNicon, clips_logo); confirm = XtCreateManagedWidget("confirm", dialogWidgetClass, confirmshell, TheArgs, 2); XawDialogAddButton(confirm, "Quit", Quit, (XtPointer) confirm); XawDialogAddButton(confirm, "Restart", Restart, (XtPointer) confirm); XawDialogAddButton(confirm, "Cancel", CancelPopupSelect, (XtPointer) confirm); XtPopup(confirmshell, XtGrabNonexclusive); } /******************************************************************************* Name: ClipsSave Description: Prompts for file name to execute CLIPS' bsave, save-facts, or save functions Arguments: None Returns: None *******************************************************************************/ static void ClipsSave() { Widget popup, file_dialog; popup = XtCreatePopupShell("File", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNlabel, "Enter file name:"); XtSetArg(TheArgs[1], XtNvalue, ""); XtSetArg(TheArgs[2], XtNicon, clips_logo); file_dialog = XtCreateManagedWidget("file_dialog", dialogWidgetClass, popup, TheArgs, 3); XawDialogAddButton(file_dialog, "Save", IntSave, (XtPointer)NULL); XawDialogAddButton(file_dialog, "Cancel", CancelPopupSelect, (XtPointer)file_dialog); XtPopup(popup, XtGrabNonexclusive); } /******************************************************************************* Name: IntSave Description: Eexecutes CLIPS' bsave, save-facts, or save functions Arguments: w - Dialog Widget client_data - Not Used call_data - Not Used Returns: None *******************************************************************************/ void IntSave( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); char *filename = XawDialogGetValueString(XtParent(w)); switch(file_item) { case SAVEBINARY: EnvPrintRouter(theEnv,"wclips", "(bsave "); SetCommandString(theEnv,"(bsave"); AppendCommandString(theEnv,"\""); EnvPrintRouter(theEnv,"wclips", "\""); AppendCommandString(theEnv,filename); EnvPrintRouter(theEnv,"wclips", filename); AppendCommandString(theEnv,"\""); EnvPrintRouter(theEnv,"wclips", "\""); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips", ")\n"); quit_get_event = True; break; case SAVEFACTS: EnvPrintRouter(theEnv,"wclips", "(save-facts "); SetCommandString(theEnv,"(save-facts"); AppendCommandString(theEnv,"\""); EnvPrintRouter(theEnv,"wclips", "\""); AppendCommandString(theEnv,filename); EnvPrintRouter(theEnv,"wclips", filename); AppendCommandString(theEnv,"\""); EnvPrintRouter(theEnv,"wclips", "\""); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips", ")\n"); quit_get_event = True; break; case SAVERULES: EnvPrintRouter(theEnv,"wclips", "(save "); SetCommandString(theEnv,"(save"); AppendCommandString(theEnv,"\""); EnvPrintRouter(theEnv,"wclips", "\""); AppendCommandString(theEnv,filename); EnvPrintRouter(theEnv,"wclips", filename); AppendCommandString(theEnv,"\""); EnvPrintRouter(theEnv,"wclips", "\""); AppendCommandString(theEnv,")\n"); EnvPrintRouter(theEnv,"wclips", ")\n"); quit_get_event = True; break; } XtDestroyWidget(XtParent(XtParent(w))); } /******************************************************************************* Name: FileSelect Description: Pops up window in center of the Dialog Window for file selection by user Arguments: None Returns: None Contrubuting Programmers: Albert Leigh - MacDonnell Douglas Stan Smith - Barrios some guy upstairs ******************************************************************************/ void FileSelect() { Widget file_form, file_dialog, view; /*XDefineCursor(XtDisplay(toplevel),toplevel,XC_watch);*/ TheFile = XtCreatePopupShell("File", topLevelShellWidgetClass, toplevel, NULL, 0); file_form = XtCreateManagedWidget("file_form", formWidgetClass, TheFile, NULL, 0); XtSetArg(TheArgs[0], XtNforceBars, True); XtSetArg(TheArgs[1], XtNbottom, XtChainBottom); XtSetArg(TheArgs[2], XtNheight,150); XtSetArg(TheArgs[3], XtNallowHoriz,True); XtSetArg(TheArgs[4],XtNallowVert,True); view = XtCreateManagedWidget("view", viewportWidgetClass, file_form, TheArgs, 5); /* =============================================================== * * Create the Select/Cancel dialog box in the file selection * * dialog box. * * =============================================================== */ XtSetArg(TheArgs[0], XtNresizable, True); XtSetArg(TheArgs[1], XtNlabel, "Enter File Name"); XtSetArg(TheArgs[2], XtNvalue, ""); XtSetArg(TheArgs[3], XtNfromVert, view); XtSetArg(TheArgs[4], XtNicon, clips_logo); XtSetArg(TheArgs[5], XtNleft, XtChainLeft); XtSetArg(TheArgs[6], XtNright, XtChainRight); XtSetArg(TheArgs[7], XtNtop, XtChainBottom); XtSetArg(TheArgs[8], XtNbottom, XtChainBottom); file_dialog = XtCreateManagedWidget("file_dialog", dialogWidgetClass, file_form, TheArgs, 9); XawDialogAddButton(file_dialog, "SELECT", MenuFunc, (XtPointer) file_dialog); XawDialogAddButton(file_dialog, "CANCEL", CancelPopupSelect, (XtPointer) file_form); XtSetArg(TheArgs[0], XtNfromHoriz, file_dialog); XtSetArg(TheArgs[1], XtNfromVert, view); /* =============================================================== * * Get the path of the current dirrectory * * =============================================================== */ if(getwd(path) == NULL) printf("Error getting current working directory '%s'\n", path); if(path[strlen(path) - 1] != '/') strcat(path, "/"); /* =============================================================== * * Create the file dialog list box * * =============================================================== */ XtSetArg(TheArgs[0], XtNdefaultColumns, 4); XtSetArg(TheArgs[1], XtNlist, GetDirectory()); XtSetArg(TheArgs[2], XtNforceColumns, False); XtSetArg(TheArgs[3], XtNverticalList, True); XtSetArg(TheArgs[4], XtNinternalWidth, 10); file_list = XtCreateManagedWidget("file_dialog", listWidgetClass, view, TheArgs, 5); XtAddCallback(file_list, XtNcallback, FileToDialog, (XtPointer) file_dialog); XtPopup(TheFile, XtGrabNonexclusive); /*XDefineCursor(XtDisplay(toplevel),toplevel,None);*/ } /******************************************************************************* Name: GetDirectory Description: used with FileSelect to create list of filenames in a specific directory Arguments: None Returns: None Contrubuting Programmers: Albert Leigh - MacDonnell Douglas Lac Nguyen - Computer Science Corp. Stan Smith - Barrios some guy upstairs *******************************************************************************/ static char **GetDirectory() { int fcount; char *fullpath; DIR *dirp; struct direct *entry; int namelength = 0; if ((dirp = opendir(path)) == NULL) { number_entries = 1; filenames = (char **) calloc(1,sizeof(char **)); filenames[0] = (char *) malloc(sizeof(char) * 14); strcpy(filenames[0], ".."); return(filenames); } /*======================================================*/ /* Determine the number of file names in the directory. */ /*======================================================*/ fcount = 0; while ((entry = readdir(dirp)) != NULL) { namelength = MAX(namelength,strlen(entry->d_name)); fcount++; } /*==================================================================*/ /* Make sure the memory allocated for the filename will contain it. */ /*==================================================================*/ namelength = MAX((namelength + 2), 14); if (strcmp(path,"/") == 0) { fcount--; } number_entries = fcount - 1; rewinddir(dirp); filenames = (char **)calloc(fcount, sizeof(char *)); filenames[0] = (char *)malloc(sizeof(char *) * fcount * namelength); fullpath = (char *) malloc(sizeof(char) * (strlen(path) + namelength)); fcount = 0; /*=========================================================*/ /* Get the list of file or directory names in a directory. */ /*=========================================================*/ while ((entry = readdir(dirp)) != NULL) { if (strcmp(entry->d_name, ".")) { if ((strcmp(path,"/") != 0)|| (strcmp (entry->d_name,"..") != 0)) { filenames[fcount] = *filenames + (fcount * namelength); strcpy(filenames[fcount], entry->d_name); sprintf(fullpath, "%s%s", path, entry->d_name); if (IsDirectory(fullpath)) { strcat(filenames[fcount], "/"); } fcount++; } } } closedir(dirp); qsort(*filenames, fcount, (sizeof(char) * namelength), (int (*)(const void *, const void *)) strcmp); return(filenames); } /******************************************************************************* Name: IsDirectory Description: used with FileSelect to test for directory Arguments: temppath - directory temppath to check for Returns: 0 - for directory 1 - for not directory Contrubuting Programmers: Albert Leigh - MacDonnell Douglas Stan Smith - Barrios some guy upstairs *******************************************************************************/ int IsDirectory( char *temppath) { struct stat sbuf; if(!stat(temppath, &sbuf) && ((sbuf.st_mode & S_IFMT) == S_IFDIR)) return(1); else return(0); } /******************************************************************************* Name: FileToDialog Description: copies selected list string to dialog's asciitext window Arguments: w - list widget client_data - dialog widget call_data - list string selected Returns: None Contrubuting Programmers: Albert Leigh - MacDonnell Douglas Stan Smith - Barrios some guy upstairs *******************************************************************************/ static void FileToDialog( Widget w, XtPointer client_data, XtPointer call_data) { XawListReturnStruct *item = (XawListReturnStruct *)call_data; char *ptr; if (!strcmp(item->string, "../")) { path[strlen(path) - 1] = '\0'; ptr = strrchr(path, '/'); ptr++; *(ptr) = '\0'; /* for(i = 0; i < number_entries; i++) free(filenames[i]); */ if (filenames != NULL) { free(filenames[0]); free(filenames); } XawListChange(w, GetDirectory(), 0, 0, True); } else if (strrchr(item->string, '/')) { strcat(path, item->string); XawListChange(w, GetDirectory(), 0, 0, True); } else { XtSetArg(TheArgs[0], XtNvalue, item->string); XtSetValues((Widget)client_data, TheArgs, 1); } } /******************************************************************************* Name: LoadBatch Description: Loads batch file into CLIPS Arguments: str - file to load Returns: None *******************************************************************************/ void LoadBatch( char *str) { void *theEnv = GetCurrentEnvironment(); EnvPrintRouter(theEnv,"wclips", "(batch "); SetCommandString(theEnv,"(batch"); GetFileForCLIPS(str); EnvPrintRouter(theEnv,"wclips", ")\n"); AppendCommandString(theEnv,")\n"); quit_get_event = True; } /******************************************************************************* Name: LoadBinary Description: Loads binary file into CLIPS Arguments: str - file to load Returns: None *******************************************************************************/ void LoadBinary( char *str) { void *theEnv = GetCurrentEnvironment(); EnvPrintRouter(theEnv,"wclips", "(bload "); SetCommandString(theEnv,"(bload"); GetFileForCLIPS(str); EnvPrintRouter(theEnv,"wclips", ")\n"); AppendCommandString(theEnv,")\n"); quit_get_event = True; } /******************************************************************************* Name: LoadTheFacts Description: Loads facts file into CLIPS Arguments: str - file to load Returns: None *******************************************************************************/ void LoadTheFacts( char *str) { void *theEnv = GetCurrentEnvironment(); EnvPrintRouter(theEnv,"wclips", "(load-facts "); SetCommandString(theEnv,"(load-facts"); GetFileForCLIPS(str); EnvPrintRouter(theEnv,"wclips", ")\n"); AppendCommandString(theEnv,")\n"); quit_get_event = True; } /******************************************************************************* Name: LoadRules Description: Loads rules into CLIPS Arguments: str - file to load Returns: None *******************************************************************************/ void LoadRules( char *str) { void *theEnv = GetCurrentEnvironment(); EnvPrintRouter(theEnv,"wclips", "(load "); SetCommandString(theEnv,"(load"); GetFileForCLIPS(str); EnvPrintRouter(theEnv,"wclips", ")\n"); AppendCommandString(theEnv,")\n"); quit_get_event = True; } /******************************************************************************* Name: IntDribbleOn Description: Turns on dribble Arguments: str - file to dribble to Returns: None *******************************************************************************/ void IntDribbleOn( String str) { void *theEnv = GetCurrentEnvironment(); if(!CommandLineData(theEnv)->EvaluatingTopLevelCommand) EnvPrintRouter(theEnv,"wclips", "(dribble-on "); SetCommandString(theEnv,"(dribble-on"); GetFileForCLIPS(str); if(!CommandLineData(theEnv)->EvaluatingTopLevelCommand) EnvPrintRouter(theEnv,"wclips", ")\n"); AppendCommandString(theEnv,")\n"); quit_get_event = True; if (((access(str, 02) == 0) || (access(str, 00))) && (strcmp(str, "\0") != 0)) { Dribble_status = True; XtSetArg(TheArgs[0], XtNleftBitmap, checker); XtSetValues(file_dribble, TheArgs, 1); } } /******************************************************************************* Name: GetFileForCLIPS Description: Gets file for CLIPS to load Arguments: file - File to get Returns: None *******************************************************************************/ static void GetFileForCLIPS( char *file) { void *theEnv = GetCurrentEnvironment(); AppendCommandString(theEnv,"\""); AppendCommandString(theEnv,file); AppendCommandString(theEnv,"\""); if(!CommandLineData(theEnv)->EvaluatingTopLevelCommand) { EnvPrintRouter(theEnv,"wclips", "\""); EnvPrintRouter(theEnv,"wclips", file); EnvPrintRouter(theEnv,"wclips", "\""); } } /****************************************************************************** Name: Restart Description: Restarts CLIPS Arguments: w - not used client_data - popup widget call_data - not used Returns: None *******************************************************************************/ void Restart( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); system("xclips&"); XclipsExit(theEnv,0); } /****************************************************************************** Name: Quit Description: Quits CLIPS Arguments: None Returns: None ******************************************************************************/ void Quit( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); XclipsExit(theEnv,0); } clips-6.24/x-prjct/xinterface/xmenu.c0000755000175000017500000006254610444323570015746 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains all the functions that create top level */ /* menus. */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _XMENU_SOURCE_ #include #include #include #include "setup.h" #include "constrct.h" #include "filecom.h" #include "xsetup.h" #include "xclips.h" #include "xmenu.h" #include "xedit.h" #include "xclipstext.h" #include "xmenu_wind.h" #include "xmenu_exec.h" #include "xmenu_file.h" #include "xmenu_watch.h" #include "xmenu_opt.h" #include "xmenu_exec.h" #include "xmain.h" #include #include #include #include #include /********** local functions not visible outside this function **********/ static void AboutXCLIPS(Widget,XtPointer,XtPointer); static void CreateFileMenu(Widget); static void CreateExecutionMenu(Widget); static void CreateBrowseMenu(Widget); static void CreateWindowsMenu(Widget); /********** Variables defined in this file is available to others ***********/ Widget defrule_manager = NULL, deffact_manager = NULL, deftemplate_manager = NULL, deffunction_manager = NULL, defgeneric_manager = NULL, definstances_manager = NULL, defclass_manager = NULL, agenda_manager = NULL,defglobal_manager = NULL; Widget button_form, button; Widget FileItemWidgets[7]; Widget ExecItemWidgets[5]; String about_info[] = { "XCLIPS for CLIPS version 6.24", "", "Developers:", "", " XCLIPS: BeBe Ly & Daniel McCoy", "", " CLIPS: Gary Riley & Brian Donnell ", "", NULL, }; /******************************************************************************* Name: CreatePullDownMenus Description: Creates all pulldown menus arguements: parent - widget all menu buttons will be in Returns: None *******************************************************************************/ void CreatePullDownMenus( Widget parent) { button_form = XtCreateManagedWidget("buttonForm",formWidgetClass, parent,NULL, 0); XtSetArg(TheArgs[0], XtNbitmap, clips_logo); XtSetArg(TheArgs[1], XtNinternalHeight, 0); XtSetArg(TheArgs[2], XtNinternalWidth, 0); XtSetArg(TheArgs[3], XtNshapeStyle, XmuShapeOval); XtSetArg(TheArgs[4], XtNborderWidth, 0); button = XtCreateManagedWidget("button",commandWidgetClass, button_form,TheArgs, 5); XtAddCallback(button, XtNcallback, AboutXCLIPS, NULL); CreateFileMenu(button_form); CreateExecutionMenu(button_form); CreateBrowseMenu(button_form); CreateWindowsMenu(button_form); } /******************************************************************************* Name: CreateFileMenu Description: Creates File menu arguements: parent - form widget the menu button will be in Returns: None *******************************************************************************/ static void CreateFileMenu( Widget parent) { Widget line, menu; int i = 0; XtSetArg(TheArgs[0], XtNfromHoriz, button); XtSetArg(TheArgs[1], XtNlabel, "File"); button = XtCreateManagedWidget("button",menuButtonWidgetClass, parent,TheArgs, 2); menu = XtCreatePopupShell("menu",simpleMenuWidgetClass, button,NULL, 0); XtSetArg(TheArgs[0], XtNleftMargin, 15); /*====================================*/ /* Create Edit item in the file menu. */ /*====================================*/ FileItemWidgets[i] = XtCreateManagedWidget("Edit... ^V", smeBSBObjectClass,menu,TheArgs,1); XtAddCallback(FileItemWidgets[i++], XtNcallback, EditCallback, NULL); /*========================================*/ /* Create Complete item in the file menu. */ /*========================================*/ FileItemWidgets[i] = XtCreateManagedWidget("Complete... ^C",smeBSBObjectClass, menu,TheArgs, 1); XtAddCallback(FileItemWidgets[i++], XtNcallback, CompletionDialogCallback,(XtPointer)NULL); line = XtCreateManagedWidget("line",smeLineObjectClass,menu,NULL,0); /*====================================*/ /* Create Load item in the file menu. */ /*====================================*/ FileItemWidgets[i] = XtCreateManagedWidget("Load... ^L", smeBSBObjectClass,menu,TheArgs,1); XtAddCallback(FileItemWidgets[i++], XtNcallback, LoadRulesCallback, NULL); /*==========================================*/ /* Create Load batch item in the file menu. */ /*==========================================*/ FileItemWidgets[i] = XtCreateManagedWidget("Load Batch...", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(FileItemWidgets[i++], XtNcallback, LoadBatchCallback, NULL); /*===========================================*/ /* Create Load Binary item in the file menu */ /*===========================================*/ FileItemWidgets[i] = XtCreateManagedWidget("Load Binary...", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(FileItemWidgets[i++], XtNcallback, LoadBinaryCallback, NULL); /*===========================================*/ /* Create Dribble item in the file menu */ /*===========================================*/ file_dribble = XtCreateManagedWidget("Dribble... ^D", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(file_dribble, XtNcallback, DribbleCallback, NULL); line = XtCreateManagedWidget("line", smeLineObjectClass, menu, NULL, 0); /*===========================================*/ /* Create Save binary item in the file menu */ /*===========================================*/ FileItemWidgets[i] = XtCreateManagedWidget("Save Binary...", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(FileItemWidgets[i++], XtNcallback, SaveBinaryCallback, NULL); line = XtCreateManagedWidget("line", smeLineObjectClass, menu, NULL, 0); /*===========================================*/ /* Create Quit item in the file menu */ /*===========================================*/ FileItemWidgets[i] = XtCreateManagedWidget("Quit ^Q", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(FileItemWidgets[i], XtNcallback, QuitCallback, NULL); } /******************************************************************************* Name: CreateExecutionMenu Description: Creates Execution menu arguements: parent - form widget the menu button will be in Returns: None *******************************************************************************/ static void CreateExecutionMenu( Widget parent) { Widget line, menu, entry; int i = 0; XtSetArg(TheArgs[0], XtNfromHoriz, button); XtSetArg(TheArgs[1], XtNlabel, "Execution"); button = XtCreateManagedWidget("button", menuButtonWidgetClass, parent, TheArgs, 2); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, button, NULL, 0); ExecItemWidgets[i] = XtCreateManagedWidget("Reset ^E", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(ExecItemWidgets[i], XtNcallback, ResetCallback, NULL); i++; ExecItemWidgets[i] = XtCreateManagedWidget("Run ^R", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(ExecItemWidgets[i], XtNcallback, RunCallback, NULL); i++; ExecItemWidgets[i] = XtCreateManagedWidget("Step ^T", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(ExecItemWidgets[i], XtNcallback, StepCallback, NULL); i++; entry = XtCreateManagedWidget("Watch...", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(entry,XtNcallback,WatchWindow,NULL); entry = XtCreateManagedWidget("Options...", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(entry,XtNcallback,OptionsWindow,NULL); line = XtCreateManagedWidget("line", smeLineObjectClass, menu, NULL, 0); ExecItemWidgets[i] = XtCreateManagedWidget("Clear CLIPS ^K", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(ExecItemWidgets[i], XtNcallback, ClearCLIPSCallback, NULL); i++; ExecItemWidgets[i] = XtCreateManagedWidget("Clear Window ^N", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(ExecItemWidgets[i],XtNcallback,ClearScreenCallback,NULL); } /******************************************************************************* Name: CreateBrowseMenu Description: Creates Browse menu arguements: parent - form widget the menu button will be in Returns: None *******************************************************************************/ static void CreateBrowseMenu( Widget parent) { Widget menu,entry,line; XtSetArg(TheArgs[0], XtNfromHoriz, button); XtSetArg(TheArgs[1], XtNlabel, "Browse"); button = XtCreateManagedWidget("button", menuButtonWidgetClass, parent, TheArgs, 2); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, button, NULL, 0); entry = XtCreateManagedWidget("Module...", smeBSBObjectClass, menu, NULL, 0); XtAddCallback(entry, XtNcallback, ModuleCallback, NULL); line = XtCreateManagedWidget("line", smeLineObjectClass, menu, NULL, 0); XtSetArg(TheArgs[0], XtNleftMargin, 15); XtSetArg(TheArgs[1], XtNsensitive, False); defrule_manager = XtCreateManagedWidget("Defrule Manager...", smeBSBObjectClass, menu, TheArgs, 2); XtAddCallback(defrule_manager, XtNcallback, DefruleManagerCallback, NULL); deffact_manager = XtCreateManagedWidget("Deffacts Manager...", smeBSBObjectClass, menu, TheArgs, 2); XtAddCallback(deffact_manager, XtNcallback, DeffactManagerCallback, NULL); deftemplate_manager = XtCreateManagedWidget("Deftemplates Manager...", smeBSBObjectClass, menu, TheArgs, 2); XtAddCallback(deftemplate_manager, XtNcallback, DeftemplateManagerCallback, NULL); deffunction_manager = XtCreateManagedWidget("Deffunction Manager...", smeBSBObjectClass, menu, TheArgs, 2); XtAddCallback(deffunction_manager, XtNcallback, DeffunctionManagerCallback, NULL); defglobal_manager = XtCreateManagedWidget("Defglobal Manager...", smeBSBObjectClass, menu, TheArgs, 2); XtAddCallback(defglobal_manager, XtNcallback, DefglobalManagerCallback, NULL); defgeneric_manager = XtCreateManagedWidget("Defgeneric Manager...", smeBSBObjectClass, menu, TheArgs, 2); XtAddCallback(defgeneric_manager, XtNcallback, DefgenericManagerCallback, NULL); defclass_manager = XtCreateManagedWidget("Defclass Manager...", smeBSBObjectClass, menu, TheArgs, 2); XtAddCallback(defclass_manager, XtNcallback, DefclassManagerCallback, NULL); definstances_manager = XtCreateManagedWidget("Definstances Manager...", smeBSBObjectClass, menu, TheArgs, 2); XtAddCallback(definstances_manager, XtNcallback, DefinstancesManagerCallback, NULL); agenda_manager = XtCreateManagedWidget("Agenda Manager...", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(agenda_manager, XtNcallback, AgendaManagerCallback, NULL); } /******************************************************************************* Name: CreateWindowsMenu Description: Creates the Windows menu arguements: parent - form widget the menu button will be in Returns: None *******************************************************************************/ static void CreateWindowsMenu( Widget parent) { Widget line,menu, entry,all,none; XtSetArg(TheArgs[0], XtNfromHoriz, button); XtSetArg(TheArgs[1], XtNlabel, "Windows"); button = XtCreateManagedWidget("button", menuButtonWidgetClass, parent, TheArgs, 2); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, button, NULL, 0); /*==================================*/ /* Create the "Fact Window" button. */ /*==================================*/ XtSetArg(TheArgs[0], XtNleftMargin, 15); facts_window = XtCreateManagedWidget("Facts Window", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(facts_window, XtNcallback, FactsWindowCallback, NULL); /*====================================*/ /* Create the "Agenda Window" button. */ /*====================================*/ agenda_window = XtCreateManagedWidget("Agenda Window", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(agenda_window, XtNcallback, AgendaWindowCallback, NULL); /*=======================================*/ /* Create the "Instances Window" button. */ /*=======================================*/ instances_window = XtCreateManagedWidget("Instances Window", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(instances_window, XtNcallback,InstancesWindowCallback,NULL); /*===========================================*/ /* Create the "Global Window" button */ /*===========================================*/ globals_window = XtCreateManagedWidget("Global Window", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(globals_window, XtNcallback,GlobalsWindowCallback,NULL); /*===========================================*/ /* Create the "Focus Window" button */ /*===========================================*/ focus_window = XtCreateManagedWidget("Focus Window", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(focus_window, XtNcallback,FocusWindowCallback,NULL); line = XtCreateManagedWidget("line", smeLineObjectClass, menu, NULL, 0); /*===========================================*/ /* Create the "All Windows" button */ /*===========================================*/ all = XtCreateManagedWidget("All Windows", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(all,XtNcallback,AllWindowsCallback,NULL); /*===========================*/ /* Create the "None" button. */ /*===========================*/ none = XtCreateManagedWidget("None", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(none,XtNcallback,NoWindowsCallback,NULL); line = XtCreateManagedWidget("line", smeLineObjectClass, menu, NULL, 0); /*===========================================*/ /* Create the "Command Line CLIPS" button */ /*===========================================*/ entry = XtCreateManagedWidget("Command Line CLIPS ^Z", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(entry, XtNcallback, CommandLineCLIPSCallback, NULL); /*======================================*/ /* Create the "Color Utilities" button. */ /*======================================*/ entry = XtCreateManagedWidget("Color Utility", smeBSBObjectClass, menu, TheArgs, 1); XtAddCallback(entry, XtNcallback, ColorUtilityCallback, NULL); } /******************************************************************************* Name: AboutXCLIPS Description: Called when CLIPS logo is selected form menu form. It displays the general information about CLIPS. Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ static void AboutXCLIPS( Widget w, XtPointer client_data, XtPointer call_data) { Widget about, about_form, about_list; about = XtCreatePopupShell("About XCLIPS", topLevelShellWidgetClass, toplevel, NULL, 0); XtSetArg(TheArgs[0], XtNdefaultDistance, 0); about_form = XtCreateManagedWidget("about_form", formWidgetClass, about, TheArgs, 1); XtSetArg(TheArgs[0], XtNborderWidth, 0); XtSetArg(TheArgs[1], XtNdefaultColumns, 1); XtSetArg(TheArgs[2], XtNforceColumns, True); XtSetArg(TheArgs[3], XtNlist, about_info); XtSetArg(TheArgs[4], XtNallowVert, True); XtSetArg(TheArgs[5], XtNallowHoriz, True); about_list = XtCreateManagedWidget("menu", listWidgetClass, about_form, TheArgs, 6); XtAddCallback(about_list, XtNcallback, CancelPopupSelect, (XtPointer)about_form); XtPopup(about, XtGrabNone); } /******************************************************************************* Name: DialogReturn Description: This function will be executed when return was pressed while cursor is in the dialog box of the file select window. Arguments: w - Widget that caused action to be called event - Not used params - Dialog widget num_params - Not used Returns: None *******************************************************************************/ void DialogReturn( Widget w, XEvent *event, String *params, Cardinal *num_params) { MenuFunc(w, params, (XtPointer)NULL); } /******************************************************************************* Name: MenuFunc Description: Simulates callbacks for the dialog box of the file select window. which callback function is executed depends on which menu item from the file menu of the main CLIPS window is activated. Arguments: w - Dialog widget client_data - Dialog widget call_data - Not Used Returns: None *******************************************************************************/ void MenuFunc( Widget w, XtPointer client_data, XtPointer call_data) { void *theEnv = GetCurrentEnvironment(); String filename = XawDialogGetValueString(XtParent(w)); char fullpath[255]; Widget popup = XtParent(XtParent(XtParent(w))); if (filename[0] == 0) { return; } chdir(path); strcpy(fullpath, path); strcat(fullpath, filename); MoveEndOfFile(dialog_text, &TheEvent); switch(file_item) { case EDIT: XtDestroyWidget(popup); EditNewFile(w, client_data, call_data); break; case LOADBATCH: XtDestroyWidget(popup); LoadBatch(fullpath); break; case LOADBINARY: XtDestroyWidget(popup); LoadBinary(fullpath); break; case LOADFACTS: XtDestroyWidget(popup); LoadTheFacts(fullpath); break; case LOADRULES: XtDestroyWidget(popup); LoadRules(fullpath); break; case DRIBBLEON: XtDestroyWidget(popup); EnvDribbleOn(theEnv,fullpath); break; case SAVERULES: IntSave(w,client_data,call_data); break; case SAVEBINARY: IntSave(w,client_data,call_data); break; case SAVEFACTS: IntSave(w, client_data, call_data); break; } } /******************************************************************************* Name: CancelPopupSelect Description: Destroys a the parent of the widget sent Arguments: w - Not Used client_data - Child of widget to destroy call_data - Not Used Returns: None *******************************************************************************/ void CancelPopupSelect( Widget w, XtPointer client_data, XtPointer call_data) { XtDestroyWidget(XtParent((Widget) client_data)); } /******************************************************************************* Name: PopdownSelect Description: Popdown the parent of the widget sent Arguments: w - Not Used client_data - Child of widget to destroy call_data - Not Used Returns: None *******************************************************************************/ void PopdownSelect( Widget w, XtPointer client_data, XtPointer call_data) { XtPopdown(XtParent((Widget) client_data)); } clips-6.24/x-prjct/xinterface/xedit.h0000755000175000017500000000503410444323575015726 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.0 01/31/02 */ /* */ /* XEDIT HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ void EditNewFile(Widget,XtPointer,XtPointer); void EditorSaveCallback(Widget,XtPointer,XtPointer); void EditorSaveAsCallback(Widget,XtPointer,XtPointer); void EditorRevertCallback(Widget,XtPointer,XtPointer); int FindSelection(void *,char *); int SelectionGetc(void *,char *); int SelectionUngetc(void *,int,char *); void EditorCompileSelectionCallback(Widget,XtPointer,XtPointer); int FileFind(void *,char *); int FileGetc(void *,char *); int FileUngetc(void *,int,char *); void EditorCompileFileCallback(Widget,XtPointer,XtPointer); int LoadXFile(char *,char *); void EditorBatchSelectionCb(Widget,XtPointer,XtPointer); void EditorExitCallback(Widget,XtPointer,XtPointer); void EditorCutCallback(Widget,XtPointer,XtPointer); void EditorPasteCallback(Widget,XtPointer,XtPointer); void EditorSearchReplaceCallback(Widget,XtPointer,XtPointer); void FindMatchingParenthesisCallback(Widget,XtPointer,XtPointer); int SearchForward(Widget,XawTextBlock *,XawTextPosition); void WarningWindow(char *); int SearchBackward(Widget,XawTextBlock *,XawTextPosition); void EditorBeginingOfFileCallback(Widget,XtPointer,XtPointer); void EditorEndOfFileCallback(Widget,XtPointer,XtPointer); void EditorHelpSelect(Widget,XtPointer,XtPointer); void EditorSaveAs(Widget,XtPointer,XtPointer); void EditorRevert(Widget,XtPointer,XtPointer); clips-6.24/x-prjct/xinterface/xmain.c0000755000175000017500000002545110444323570015720 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMAIN MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ /***************************************************************************/ /* */ /* Permission is hereby granted, free of charge, to any person obtaining */ /* a copy of this software and associated documentation files (the */ /* "Software"), to deal in the Software without restriction, including */ /* without limitation the rights to use, copy, modify, merge, publish, */ /* distribute, and/or sell copies of the Software, and to permit persons */ /* to whom the Software is furnished to do so. */ /* */ /* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS */ /* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF */ /* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT */ /* OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY */ /* CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES */ /* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN */ /* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF */ /* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* */ /***************************************************************************/ #define _XMAIN_SOURCE_ #include #include "setup.h" #include "sysdep.h" #include "commline.h" #include "symbol.h" #include #include "xsetup.h" #include "xmain.h" #include "xmenu_file.h" #include "xclipstext.h" #include "xmenu.h" #include "xclips.h" Boolean Dribble_status; Boolean Browse_status[WINDOW_NUM] = {False,False,False,False,False}; /* [0] : agenda_window * * [1] : fact_window * * [2] : instances_window * * [3] : globals_window * * [4] : focus_number */ /********** Global variables **********/ Widget toplevel = NULL, dialog = NULL; Widget dialog_form = NULL, dialog_text = NULL; Arg TheArgs[10]; XtAppContext app_con; XEvent TheEvent; KeySym TheKeysym; /* Key code id event is a keypress */ XComposeStatus compose_status; Pixmap checker, clips_logo; char *clips_sel_buf; Boolean quit_get_event = False; unsigned long clips_count = 0; /* This variable is for the interface */ unsigned long clips_last_pos = 0; Boolean send_to_clips = False; XtActionsRec actionTable[] = { {"DialogReturn", DialogReturn}, {"MatchDialogReturnD",MatchDialogReturnD}, {"MatchDialogReturnE",MatchDialogReturnE}, }; char *xclips_translation1 = "\ CtrlA: no-op() \n\ CtrlB: no-op() \n\ CtrlC: complete-construct-dialog() \n\ CtrlD: dribble() \n\ CtrlE: reset() \n\ CtrlF: no-op() \n\ CtrlG: no-op() \n\ CtrlH: stop-execution() \n\ CtrlI: no-op() \n\ CtrlJ: no-op() \n\ CtrlK: clear-clips() \n\ CtrlL: load-constructs() \n\ CtrlM: no-op() \n\ CtrlN: clear-screen() \n\ CtrlO: no-op() \n\ CtrlP: no-op() \n\ CtrlQ: quit() \n\ CtrlR: run() \n\ CtrlS: save-rules() \n\ CtrlT: step() \n\ CtrlU: no-op() \n\ CtrlV: edit() \n\ CtrlW: no-op() \n\ CtrlX: no-op() \n\ CtrlY: no-op() \n\ CtrlZ: command-line-clips() \n\ MetaI: no-op() \n\ MetaK: no-op() \n\ MetaQ: no-op() \n\ :Metad: no-op() \n\ :MetaD: no-op() \n\ :Metah: no-op() \n\ :MetaH: no-op() \n\ :Meta]: no-op() \n\ :Meta[: no-op() \n\ ~Shift MetaDelete: no-op() \n\ Shift MetaDelete: no-op() \n\ ~Shift MetaBackSpace: no-op() \n\ Shift MetaBackSpace: no-op() \n\ Return: Clipsnewline() \n\ Linefeed: Clipsnewline() \n\ Delete: delete-clips-previous-character() \n\ BackSpace: delete-clips-previous-character() \n\ : insert-clips-char() \n\ : insert-clips-selection(PRIMARY, CUT_BUFFER0) \n\ "; String fallback_resources[] = { "*allowHoriz: True", "*allowVert: True", "*borderWidth: 4", "*lineWidth: 4", "*defaultColumns: 1", "*forceColumns: True", "*showGrip: off", "*MenuButton.width: 75", "*MenuButton3D.width: 75", "*watchButton.width: 75", "*Form.file_dialog*translations: #override \\n Return: DialogReturn(client_data)", "*Form.match_dialog*translations: #override \\n Return: MatchDialogReturnD(client_data)", "*Form.match_editor*translations: #override \\n Return: MatchDialogReturnE(client_data)", "*manager_viewport.height: 300", "*manager_viewport.width: 300", "*manager_form.Command.width: 150", "*Paned*internalBorderWidth: 0", NULL, }; #define clips_logo_width 30 #define clips_logo_height 27 static char clips_logo_bits[] = { 0x80, 0xff, 0x01, 0x00, 0xe0, 0xff, 0x07, 0x00, 0x70, 0x20, 0x1d, 0x00, 0x38, 0xb0, 0x3c, 0x00, 0x1c, 0x48, 0x72, 0x00, 0x8c, 0x2f, 0xf9, 0x00, 0x8e, 0xba, 0xc4, 0x00, 0x66, 0xf8, 0xc6, 0x01, 0x37, 0x29, 0x61, 0x03, 0xb3, 0xb6, 0x31, 0x03, 0x4f, 0x88, 0x18, 0x06, 0x23, 0x6c, 0x0c, 0x0f, 0x13, 0x22, 0x86, 0x0c, 0x1f, 0xbf, 0xc3, 0x1c, 0x86, 0x08, 0x60, 0x32, 0x86, 0x04, 0x10, 0x31, 0x7c, 0x02, 0xd8, 0x31, 0x18, 0x05, 0xc4, 0x1d, 0xb8, 0x8a, 0x36, 0x0e, 0x70, 0x93, 0x11, 0x06, 0xe0, 0xee, 0x11, 0x06, 0xc0, 0xa9, 0x09, 0x06, 0x80, 0x73, 0x04, 0x06, 0x00, 0x23, 0x02, 0x06, 0x00, 0x1b, 0xf9, 0x07, 0x00, 0x8b, 0xfc, 0x03, 0x00, 0x87, 0x0c, 0x00}; /******************************************************************************* Name: main Description: main function - Creates the interface for CLIPS Arguments: argc - number of arguments argv - arguments Returns: 0 on exit *******************************************************************************/ int main( int argc, char **argv) { void *theEnv; /*================================*/ /* Create top level shell widget. */ /*================================*/ toplevel = XtAppInitialize(&app_con,"Xclips",NULL,0,&argc,argv, fallback_resources,NULL,0); /*===========================*/ /* Add the new action table. */ /*===========================*/ XtAppAddActions(app_con, actionTable, XtNumber(actionTable)); XtAppAddActions(app_con, ClipsTxtActsTable, ClipsTxtActsTableCount); /*==========================*/ /* Create the checker icon. */ /*==========================*/ checker = XCreateBitmapFromData(XtDisplay(toplevel), RootWindowOfScreen(XtScreen(toplevel)), xlogo11_bits, xlogo11_width, xlogo11_height); /*=========================*/ /* Create clips logo icon. */ /*=========================*/ clips_logo = XCreateBitmapFromData(XtDisplay(toplevel), RootWindowOfScreen(XtScreen(toplevel)), clips_logo_bits, clips_logo_width, clips_logo_height); /*==================================================*/ /* Create the frame for the main I/O dialog window. */ /*==================================================*/ dialog = XtCreateManagedWidget("dialog",panedWidgetClass, toplevel,NULL,0); /*=============================*/ /* Create the Pull down menus. */ /*=============================*/ CreatePullDownMenus(dialog); XtSetArg(TheArgs[0], XtNlabel, "Xclips - CLIPS Version 6.24"); (void) XtCreateManagedWidget("menu",labelWidgetClass,dialog,TheArgs,1); /*====================================*/ /* Create the main I/O dialog window. */ /*====================================*/ dialog_form = XtCreateManagedWidget("dialog_form", formWidgetClass, dialog, NULL, 0); dialog_text = XtVaCreateManagedWidget("dialog_text", asciiTextWidgetClass, dialog_form, XtNheight, 500, XtNwidth, 600, XtNeditType, XawtextEdit, XtNtype, XawAsciiString, XtNscrollHorizontal, XawtextScrollNever, XtNscrollVertical, XawtextScrollWhenNeeded, XtNwrap, XawtextWrapWord, XtNresize, XawtextResizeNever, NULL); XtOverrideTranslations(dialog_text, XtParseTranslationTable(xclips_translation1)); XtSetKeyboardFocus(dialog_form, dialog_text); XtRealizeWidget(toplevel); theEnv = CreateEnvironment(); InitializeInterface(); RerouteStdin(theEnv,argc,argv); CommandLoop(theEnv); return(-1); } clips-6.24/x-prjct/xinterface/xsetup.h0000755000175000017500000000411410444323575016137 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.0 01/31/02 */ /* */ /* XSETUP HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #include #include #include #include #include #ifdef XAW3D #include #include #include #include #include #include #include #include #include #include #include #else #include #include #include #include #include #include #include #include #include #include #include #endif /*End XAW3D*/ /*#include "FileSel.h"*/ clips-6.24/x-prjct/xinterface/xclips.h0000755000175000017500000000713310444323575016115 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XCLIPS HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_xclips #define _H_xclips void InitializeInterface(void); int XclipsQuery(void *,char *); int XclipsPrint(void *,char *,char *); int XclipsGetc(void *,char *); int XclipsUngetc(void *,int,char *); int XclipsExit(void *,int); int PrintChangedAgenda(void); int PrintChangedFacts(void); int PrintChangedInstances(void); int PrintChangedGlobals(void); int PrintChangedFocus(void); void UpdateMenus(void); void UpdateOptionsMenu(void); int set_clips_command(int); int get_clips_command(void); #ifndef TRUE #define TRUE 1 #endif #ifndef FALSE #define FALSE 0 #endif #ifndef EOS #define EOS '\0' #endif #define DELETE '\d' #define BACKSPACE '\b' #define NEWLINE '\n' #define CR '\r' #define FORMFEED '\f' #define BLANK ' ' #define TAB '\t' #define ESC '\033' #define LOW_PRN_ASCII ' ' #define HIGH_PRN_ASCII '~' #define LOG_TABLE_SIZE 15 #define MAX_CHAR_IN_BUF 512 #define XFacts 0 #define Rules 1 #define Activations 2 #define Compilations 3 #define RULEMNGR 0 #define DEFFACTSMNGR 1 #define DEFTEMPMNGR 2 #define AGENDAMNGR 3 #define EDIT 0 #define LOADBATCH 1 #define LOADBINARY 2 #define LOADFACTS 3 #define LOADRULES 4 #define DRIBBLEON 5 #define SAVEAS 6 #define SAVEBINARY 7 #define SAVEFACTS 8 #define SAVERULES 9 #define REVERT 10 #define INT_STA_CONSTRAINT_CHK 0 #define INT_DYN_CONSTRAINT_CHK 1 #define INT_RESET_GLOBALS 2 #define INT_SEQUENCE_OPT_REG 3 #define INT_INCREMENTAL_RESET 4 #define INT_AUTO_FLOAT_DIV 5 #define INT_FACT_DUPLICATION 6 #define SALIENCE_FLAG 0 #define STRATEGY_FLAG 1 #define MAX_WATCH 14 #define AGENDA_WIN 0 #define FACT_WIN 1 #define INSTANCE_WIN 2 #define GLOBAL_WIN 3 #define FOCUS_WIN 4 #define WINDOW_NUM 5 #define streq(a, b) (strcmp((a), (b)) == 0) #define balloc(nm,bk) (bk*)malloc (sizeof(bk)*((unsigned)nm)) #define release(node) free((char *)node) typedef struct logname { char *name; struct logname *next; }LogName, *LogNamePtr; #define salience_width 153 #define salience_height 18 #define strategy_width 153 #define strategy_height 18 #ifndef _XCLIPS_SOURCE_ extern XtActionsRec ClipsTxtActsTable[]; extern Cardinal ClipsTxtActsTableCount; extern Boolean periodicChecking; #endif #endif clips-6.24/x-prjct/xinterface/xclipstext.c0000755000175000017500000006555110444323570017020 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XCLIPSTEXT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _XCLIPSTEXT_SOURCE_ #include #include #include #include #include #include #include #include #include #include #include #ifdef XAW3D #include #else #include #endif #include "setup.h" #include "commline.h" #include "evaluatn.h" #include "filertr.h" #include "router.h" #include "xclips.h" #include "xedit.h" #include "xmenu_file.h" #include "xmenu_exec.h" #include "xmenu_wind.h" #include "xclipstext.h" #include "xmain.h" static void StartAction(TextWidget,XEvent *); static void EndAction(TextWidget); static void StuffFromBuffer(TextWidget,int); static void _SelectionReceived(Widget,caddr_t,Atom *,Atom *,caddr_t,unsigned long *,int *); static void _ClipsSelectionReceived(Widget,caddr_t,Atom *,Atom *,caddr_t,unsigned long *,int *); static void GetSelection(Widget,Time,String *,Cardinal); static void ClipsGetSelection(Widget,Time,String *,Cardinal); static void InsertClipsSelection(Widget,XEvent *,String *,Cardinal *); static void Move(TextWidget,XEvent *,XawTextScanDirection,XawTextScanType,Boolean); static void _DeleteOrKill(TextWidget,XawTextPosition, XawTextPosition,Boolean); static void DeleteOrKill(TextWidget,XEvent *,XawTextScanDirection,XawTextScanType,Boolean,Boolean); static void DeleteClipsBackwardChar(Widget,XEvent *); static void InsertClipsNewLine(Widget,XEvent *); static void AutoFill(TextWidget); static void InsertClipsChar(Widget,XEvent *); static void Clear_CLIPS(Widget,XEvent *); static void IntReset(Widget,XEvent *); static void FactsWindow(Widget,XEvent *); static void AgendaWindow(Widget,XEvent *); static void LoadRulesProc(Widget,XEvent *); static void Dribble(Widget,XEvent *); static void QuitProc(Widget,XEvent *); static void IntRun(Widget,XEvent *); static void SaveRules(Widget,XEvent *); static void Step(Widget,XEvent *); static void Edit(Widget,XEvent *); static void CommandLineCLIPS(Widget,XEvent *); static void FindBalance(Widget,XEvent *); static void CompleteConstructInDialog(Widget,XEvent *); static void CompleteConstructInEditor(Widget,XEvent *); static void ClearScreen(Widget,XEvent *); static void StopExecution(Widget,XEvent *); #define SrcScan XawTextSourceScan #define FindDist XawTextSinkFindDistance #define FindPos XawTextSinkFindPosition /* * These are defined in xclips.c */ static void StartAction( TextWidget ctx, XEvent *event) { _XawTextPrepareToUpdate(ctx); if (event != NULL) { switch (event->type) { case ButtonPress: case ButtonRelease: ctx->text.time = event->xbutton.time; ctx->text.ev_x = event->xbutton.x; ctx->text.ev_y = event->xbutton.y; break; case KeyPress: case KeyRelease: ctx->text.time = event->xkey.time; ctx->text.ev_x = event->xkey.x; ctx->text.ev_y = event->xkey.y; break; case MotionNotify: ctx->text.time = event->xmotion.time; ctx->text.ev_x = event->xmotion.x; ctx->text.ev_y = event->xmotion.y; break; case EnterNotify: case LeaveNotify: ctx->text.time = event->xcrossing.time; ctx->text.ev_x = event->xcrossing.x; ctx->text.ev_y = event->xcrossing.y; } } } static void EndAction( TextWidget ctx) { _XawTextCheckResize(ctx); _XawTextExecuteUpdate(ctx); ctx->text.mult = 1; } /* * These functions are superceeded by insert-selection. */ static void StuffFromBuffer( TextWidget ctx, int buffer) { XawTextBlock text; text.ptr = XFetchBuffer(XtDisplay(ctx), &(text.length), buffer); text.firstPos = 0; if (_XawTextReplace(ctx, ctx->text.insertPos, ctx->text.insertPos, &text)) { XBell(XtDisplay(ctx), 0); return; } ctx->text.insertPos = SrcScan(ctx->text.source, ctx->text.insertPos, XawstPositions, XawsdRight, text.length, TRUE); XtFree(text.ptr); } void UnKill( TextWidget ctx, XEvent *event) { StartAction(ctx, event); StuffFromBuffer(ctx, 1); EndAction(ctx); } void Stuff( TextWidget ctx, XEvent *event) { StartAction(ctx, event); StuffFromBuffer(ctx, 0); EndAction(ctx); } struct _SelectionList { String *params; Cardinal count; Time time; }; /* ARGSUSED */ static void _SelectionReceived( Widget w, caddr_t client_data, Atom *selection, Atom *type, caddr_t value, unsigned long *length, int *format) { TextWidget ctx = (TextWidget)w; XawTextBlock text; if (*type == 0 /*XT_CONVERT_FAIL*/ || *length == 0) { struct _SelectionList* list = (struct _SelectionList*)client_data; if (list != NULL) { GetSelection(w, list->time, list->params, list->count); XtFree(client_data); } return; } StartAction(ctx, NULL); text.ptr = (char*)value; text.firstPos = 0; text.length = *length; text.format = FMT8BIT; if (_XawTextReplace(ctx, ctx->text.insertPos, ctx->text.insertPos, &text)) { XBell(XtDisplay(ctx), 0); return; } ctx->text.insertPos = SrcScan(ctx->text.source, ctx->text.insertPos, XawstPositions, XawsdRight, text.length, TRUE); EndAction(ctx); _XawTextSetScrollBars(ctx); XtFree(client_data); XtFree(value); } static void _ClipsSelectionReceived( Widget w, caddr_t client_data, Atom *selection, Atom *type, caddr_t value, unsigned long *length, int *format) { TextWidget ctx = (TextWidget)w; XawTextBlock text; char *cmdstr; if (*type == 0 /*XT_CONVERT_FAIL*/ || *length == 0) { struct _SelectionList* list = (struct _SelectionList*)client_data; if (list != NULL) { ClipsGetSelection(w, list->time, list->params, list->count); XtFree(client_data); } return; } StartAction(ctx, NULL); text.ptr = (char*)value; if(send_to_clips) { cmdstr = GetCommandString(GetCurrentEnvironment()); if(cmdstr == NULL) { SetCommandString(GetCurrentEnvironment(),text.ptr); } else { AppendCommandString(GetCurrentEnvironment(),text.ptr); } send_to_clips = False; } text.firstPos = 0; text.length = *length; text.format = FMT8BIT; if (_XawTextReplace(ctx, ctx->text.insertPos, ctx->text.insertPos, &text)) { XBell(XtDisplay(ctx), 0); return; } ctx->text.insertPos = SrcScan(ctx->text.source, ctx->text.insertPos, XawstPositions, XawsdRight, text.length, TRUE); EndAction(ctx); _XawTextSetScrollBars(ctx); XtFree(client_data); XtFree(value); } static void GetSelection( Widget w, Time time, String *params, /* selections in precedence order */ Cardinal num_params) { Atom selection; int buffer; XmuInternStrings(XtDisplay(w), params, (Cardinal)1, &selection); switch (selection) { case XA_CUT_BUFFER0: buffer = 0; break; case XA_CUT_BUFFER1: buffer = 1; break; case XA_CUT_BUFFER2: buffer = 2; break; case XA_CUT_BUFFER3: buffer = 3; break; case XA_CUT_BUFFER4: buffer = 4; break; case XA_CUT_BUFFER5: buffer = 5; break; case XA_CUT_BUFFER6: buffer = 6; break; case XA_CUT_BUFFER7: buffer = 7; break; default: buffer = -1; } if (buffer >= 0) { int nbytes; unsigned long length; int fmt8 = 8; Atom type = XA_STRING; char *line = XFetchBuffer(XtDisplay(w), &nbytes, buffer); if ((length = nbytes) != 0) _SelectionReceived(w, NULL, &selection, &type, (caddr_t)line, &length, &fmt8); else if (num_params > 1) GetSelection(w, time, params+1, num_params-1); } else { struct _SelectionList* list; if (--num_params) { list = XtNew(struct _SelectionList); list->params = params + 1; list->count = num_params; list->time = time; } else list = NULL; XtGetSelectionValue(w, selection, XA_STRING, (XtSelectionCallbackProc)_SelectionReceived, (XtPointer)list, time); } } static void ClipsGetSelection( Widget w, Time time, String *params, /* selections in precedence order */ Cardinal num_params) { Atom selection; int buffer; /* XmuInternStrings(XtDisplay(w), params, (Cardinal)1, &selection);*/ selection = XInternAtom(XtDisplay(w), *params, False); switch (selection) { case XA_CUT_BUFFER0: buffer = 0; break; case XA_CUT_BUFFER1: buffer = 1; break; case XA_CUT_BUFFER2: buffer = 2; break; case XA_CUT_BUFFER3: buffer = 3; break; case XA_CUT_BUFFER4: buffer = 4; break; case XA_CUT_BUFFER5: buffer = 5; break; case XA_CUT_BUFFER6: buffer = 6; break; case XA_CUT_BUFFER7: buffer = 7; break; default: buffer = -1; } if (buffer >= 0) { int nbytes; unsigned long length; int fmt8 = 8; Atom type = XA_STRING; char *line = XFetchBuffer(XtDisplay(w), &nbytes, buffer); if ((length = nbytes) != 0) _ClipsSelectionReceived(w, NULL, &selection, &type, (caddr_t)line, &length, &fmt8); else if (num_params > 1) ClipsGetSelection(w, time, params+1, num_params-1); } else { struct _SelectionList* list; if (--num_params) { list = (struct _SelectionList*)XtNew(struct _SelectionList); list->params = params + 1; list->count = num_params; list->time = time; } else list = NULL; XtGetSelectionValue(w, selection, XA_STRING, (XtSelectionCallbackProc)_ClipsSelectionReceived, (XtPointer)list, time); } } static void InsertClipsSelection( Widget w, XEvent *event, String *params, Cardinal *num_params) { MoveEndOfFile(dialog_text,event); StartAction((TextWidget) w, event); /* Get Time. */ ClipsGetSelection(w, ((TextWidget) w)->text.time, params, *num_params); EndAction((TextWidget) w); } /************************************************************ * * Routines for Moving Around. * ************************************************************/ static void Move( TextWidget ctx, XEvent *event, XawTextScanDirection dir, XawTextScanType type, Boolean include) { StartAction(ctx, event); ctx->text.insertPos = SrcScan(ctx->text.source, ctx->text.insertPos, type, dir, ctx->text.mult, include); EndAction(ctx); } void MoveBeginningOfFile( Widget w, XEvent *event) { Move((TextWidget) w, event, XawsdLeft, XawstAll, TRUE); } void MoveEndOfFile( Widget w, XEvent *event) { Move((TextWidget) w, event, XawsdRight, XawstAll, TRUE); } /************************************************************ * * Delete Routines. * ************************************************************/ static void _DeleteOrKill( TextWidget ctx, XawTextPosition from, XawTextPosition to, Boolean kill) { XawTextBlock text; char *ptr; if (kill && from < to) { ptr = (char *) _XawTextGetText(ctx, from, to); XStoreBuffer(XtDisplay(ctx), ptr, strlen(ptr), 1); XtFree(ptr); } text.length = 0; text.firstPos = 0; if (_XawTextReplace(ctx, from, to, &text)) { XBell(XtDisplay(ctx), 50); return; } ctx->text.insertPos = from; ctx->text.showposition = TRUE; } static void DeleteOrKill( TextWidget ctx, XEvent *event, XawTextScanDirection dir, XawTextScanType type, Boolean include, Boolean kill) { XawTextPosition from, to; StartAction(ctx, event); to = SrcScan(ctx->text.source, ctx->text.insertPos, type, dir, ctx->text.mult, include); if (dir == XawsdLeft) { from = to; to = ctx->text.insertPos; } else from = ctx->text.insertPos; _DeleteOrKill(ctx, from, to, kill); _XawTextSetScrollBars(ctx); EndAction(ctx); } static void DeleteClipsBackwardChar( Widget w, XEvent *event) { TextWidget ctx = (TextWidget)w; char *cmdstr,strbuf[2]; MoveEndOfFile(w,event); strbuf[1] = 0; if(RouterData(GetCurrentEnvironment())->CommandBufferInputCount == 0) return; if((!quit_get_event)&&(get_clips_command())&& (!GetManagerList())) { cmdstr = GetCommandString(GetCurrentEnvironment()); if((cmdstr != NULL) ? (cmdstr[0] != EOS) :FALSE) { strbuf[0] = (char) XK_BackSpace; ExpandCommandString(GetCurrentEnvironment(),strbuf[0]); } } DeleteOrKill(ctx, event, XawsdLeft, XawstPositions, TRUE, FALSE); } void DeleteCurrentSelection( Widget w, XEvent *event) { _XawTextZapSelection( (TextWidget) w, event, FALSE); } /************************************************************ * * Insertion Routines. * ************************************************************/ static int InsertNewLineAndBackupInternal( TextWidget ctx) { int count, error = XawEditDone; XawTextBlock text; char *buf, *ptr; ptr = buf = XtMalloc(sizeof(char) * ctx->text.mult); for (count = 0; count < ctx->text.mult; count++, ptr++) ptr[0] = '\n'; text.length = ctx->text.mult; text.ptr = buf; text.firstPos = 0; text.format = FMT8BIT; if (_XawTextReplace(ctx, ctx->text.insertPos, ctx->text.insertPos, &text)) { XBell( XtDisplay(ctx), 50); error = XawEditError; } else ctx->text.showposition = TRUE; XtFree(buf); return(error); } int LocalClipsInsertNewLine( TextWidget ctx, XEvent *event) { StartAction(ctx, event); if (InsertNewLineAndBackupInternal(ctx) == XawEditError) return(XawEditError); ctx->text.insertPos = SrcScan(ctx->text.source, ctx->text.insertPos, XawstPositions, XawsdRight, ctx->text.mult, TRUE); EndAction(ctx); _XawTextSetScrollBars(ctx); return(XawEditDone); } static void InsertClipsNewLine( Widget w, XEvent *event) { TextWidget ctx = (TextWidget)w; char strbuf[2]; strbuf[1] = 0; MoveEndOfFile(w,event); if((!quit_get_event)&&(get_clips_command())&& (!GetManagerList())) { strbuf[0] = (char) XK_Linefeed; ExpandCommandString(GetCurrentEnvironment(),strbuf[0]); quit_get_event = True; } (void)LocalClipsInsertNewLine(ctx,event); } /************************************************************ * * Misc. Routines. * ************************************************************/ XComposeStatus compose_status = {NULL, 0}; /* Function Name: AutoFill * Description: Breaks the line at the previous word boundry when * called inside InsertChar. * Arguments: ctx - The text widget. * Returns: none */ static void AutoFill( TextWidget ctx) { int width, height, x, line_num, max_width; XawTextPosition ret_pos; XawTextBlock text; if ( !((ctx->text.auto_fill) && (ctx->text.mult == 1)) ) return; for ( line_num = 0; line_num < ctx->text.lt.lines ; line_num++) if ( ctx->text.lt.info[line_num].position >= ctx->text.insertPos ) break; line_num--; /* backup a line. */ max_width = Max(0, ctx->core.width - HMargins(ctx)); x = ctx->text.margin.left; XawTextSinkFindPosition( ctx->text.sink,ctx->text.lt.info[line_num].position, x, max_width, TRUE, &ret_pos, &width, &height); if ( ret_pos >= ctx->text.insertPos ) return; text.ptr = "\n"; text.length = 1; text.firstPos = 0; text.format = FMT8BIT; _XawTextReplace(ctx, ret_pos - 1, ret_pos, &text); } static void InsertClipsChar( Widget w, XEvent *event) { TextWidget ctx = (TextWidget) w; char *ptr, strbuf[BUFSIZ]; int count, error; KeySym keysym; XawTextBlock text; MoveEndOfFile(w, event); if ( (text.length = XLookupString (&event->xkey, strbuf, BUFSIZ, &keysym, &compose_status)) == 0) return; if((!quit_get_event)&&(get_clips_command())&& (!GetManagerList())) { strbuf[1] = 0; if((keysym>= XK_space) && (keysym<= XK_asciitilde)) { ExpandCommandString(GetCurrentEnvironment(),strbuf[0]); } } else return; text.ptr = ptr = XtMalloc(sizeof(char) * text.length * ctx->text.mult); for (count = 0 ; count < ctx->text.mult ; count++) { strncpy(ptr, strbuf, text.length); ptr += text.length; } text.length = text.length * ctx->text.mult; text.firstPos = 0; text.format = FMT8BIT; StartAction(ctx, event); error = _XawTextReplace(ctx, ctx->text.insertPos,ctx->text.insertPos, &text); if (error == XawEditDone) { ctx->text.insertPos = SrcScan(ctx->text.source, ctx->text.insertPos, XawstPositions, XawsdRight, text.length, TRUE); AutoFill(ctx); } else XBell(XtDisplay(ctx), 50); XtFree(text.ptr); EndAction(ctx); _XawTextSetScrollBars(ctx); } /*ARGSUSED*/ void InsertClipsString( Widget w, XEvent *event, String *params, Cardinal *num_params) { TextWidget ctx = (TextWidget) w; XawTextBlock text; int i; text.firstPos = 0; StartAction(ctx, event); for (i = *num_params; i; i--, params++) { unsigned char hexval; if ((*params)[0] == '0' && (*params)[1] == 'x' && (*params)[2] != '\0') { char c, *p; hexval = 0; for (p = *params+2; (c = *p); p++) { hexval *= 16; if (c >= '0' && c <= '9') hexval += c - '0'; else if (c >= 'a' && c <= 'f') hexval += c - 'a' + 10; else if (c >= 'A' && c <= 'F') hexval += c - 'A' + 10; else break; } if (c == '\0') { text.ptr = (char*)&hexval; text.length = 1; } else text.length = strlen(text.ptr = *params); } else text.length = strlen(text.ptr = *params); if (text.length == 0) continue; if (_XawTextReplace(ctx, ctx->text.insertPos, ctx->text.insertPos, &text)) { XBell(XtDisplay(ctx), 50); EndAction(ctx); return; } ctx->text.insertPos = SrcScan(ctx->text.source, ctx->text.insertPos, XawstPositions, XawsdRight, text.length, TRUE); } EndAction(ctx); } /* CLIPS key bound functions for the menus */ /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void Clear_CLIPS( Widget w, XEvent *event) { ClearCLIPSCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void IntReset( Widget w, XEvent *event) { ResetCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void FactsWindow( Widget w, XEvent *event) { FactsWindowCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void AgendaWindow( Widget w, XEvent *event) { AgendaWindowCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void LoadRulesProc( Widget w, XEvent *event) { LoadRulesCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void Dribble( Widget w, XEvent *event) { DribbleCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void QuitProc( Widget w, XEvent *event) { QuitCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void IntRun( Widget w, XEvent *event) { RunCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void SaveRules( Widget w, XEvent *event) { SaveRulesCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void Step( Widget w, XEvent *event) { StepCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void Edit( Widget w, XEvent *event) { EditCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void CommandLineCLIPS( Widget w, XEvent *event) { CommandLineCLIPSCallback(w, (XtPointer)NULL, (XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void FindBalance( Widget w, XEvent *event) { FindMatchingParenthesisCallback(w,(XtPointer)w,(XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void CompleteConstructInDialog( Widget w, XEvent *event) { CompletionDialogCallback(w,NULL,(XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void CompleteConstructInEditor( Widget w, XEvent *event) { CompletionEditCallback(w,(XtPointer)w,(XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void ClearScreen( Widget w, XEvent *event) { ClearScreenCallback(w,(XtPointer)w,(XtPointer)NULL); } /***************************************************************************** * Name: Description: Arguments: Return: ****************************************************************************** */ static void StopExecution( Widget w, XEvent *event) { if(periodicChecking) { SetHaltExecution(GetCurrentEnvironment(),TRUE); CloseAllFiles(GetCurrentEnvironment()); } } /***************************************************************************** * Action Table ****************************************************************************** */ XtActionsRec ClipsTxtActsTable[] = { /* delete bindings */ {"delete-clips-previous-character", (XtActionProc)DeleteClipsBackwardChar}, /* new line stuff */ {"Clipsnewline", (XtActionProc)InsertClipsNewLine}, /* Selection stuff */ {"insert-clips-selection", (XtActionProc)InsertClipsSelection}, /* Miscellaneous */ {"insert-clips-string", (XtActionProc)InsertClipsString}, {"insert-clips-char", (XtActionProc)InsertClipsChar}, /* CLIPS Dialog Window key bindings for menus */ {"clear-clips", (XtActionProc)Clear_CLIPS}, {"reset", (XtActionProc)IntReset}, {"facts-window", (XtActionProc)FactsWindow}, {"agenda-window", (XtActionProc)AgendaWindow}, {"load-constructs", (XtActionProc)LoadRulesProc}, {"dribble", (XtActionProc)Dribble}, {"quit", (XtActionProc)QuitProc}, {"run", (XtActionProc)IntRun}, {"save-rules", (XtActionProc)SaveRules}, {"step", (XtActionProc)Step}, {"edit", (XtActionProc)Edit}, {"command-line-clips", (XtActionProc)CommandLineCLIPS}, {"balance", (XtActionProc)FindBalance}, {"clear-screen", (XtActionProc)ClearScreen}, {"complete-construct-dialog", (XtActionProc)CompleteConstructInDialog}, {"complete-construct-editor", (XtActionProc)CompleteConstructInEditor}, {"stop-execution", (XtActionProc)StopExecution}, }; Cardinal ClipsTxtActsTableCount = XtNumber(ClipsTxtActsTable); clips-6.24/x-prjct/xinterface/xmenu.h0000755000175000017500000000416310444323575015747 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_xmenu #define _H_xmenu void DialogReturn(Widget,XEvent *,String *,Cardinal *); void CreatePullDownMenus(Widget); void CancelPopupSelect(Widget,XtPointer,XtPointer); void PopdownSelect(Widget,XtPointer,XtPointer); void MenuFunc(Widget,XtPointer,XtPointer); #ifndef _XMENU_SOURCE_ extern Widget defrule_manager; extern Widget deffact_manager; extern Widget deftemplate_manager; extern Widget deffunction_manager; extern Widget defgeneric_manager; extern Widget definstances_manager; extern Widget defclass_manager; extern Widget agenda_manager; extern Widget defglobal_manager; extern Widget FileItemWidgets[]; extern Widget ExecItemWidgets[]; #endif #endif clips-6.24/x-prjct/xinterface/xmenu_watch.h0000755000175000017500000000266610444323575017143 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.0 01/31/02 */ /* */ /* XMENU_WATCH HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ void WatchWindow(Widget,XtPointer,XtPointer); void OkWatchCallback(Widget,XtPointer,XtPointer); void WatchAllCallback(Widget,XtPointer,XtPointer); void WatchNoneCallback(Widget,XtPointer,XtPointer); clips-6.24/x-prjct/xinterface/._xclipstext.c0000400000175000017500000000061410444323570017205 0ustar jfsjfsMac OS X  2 R:TEXT22֑D2MWBB clips-6.24/x-prjct/xinterface/._xclips.c0000400000175000017500000000012210444323570016272 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/xinterface/xmenu_opt.c0000755000175000017500000004727710444323570016634 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMENU_OPT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _XMENU_OPT_SOURCE_ #include #include "xsetup.h" #include "xclips.h" #include "xmenu.h" #include "xmenu_opt.h" #include "xclipstext.h" #include "xmain.h" #include "setup.h" #include "engine.h" #include "crstrtgy.h" #include "commline.h" #include "router.h" #include "globlcom.h" #include "facthsh.h" #include "exprnpsr.h" #include "bmathfun.h" #include "incrrset.h" Widget optionsShell = NULL,optionsForm = NULL; Widget option_widgets[7]; Widget strategy_widgets[7]; Widget sal_opt_widgets[3]; int optionFlags[2] = {DEPTH_STRATEGY,WHEN_DEFINED}; static char strategy_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0x1b, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0xfe, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0x18, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0xfe, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0x78, 0x7c, 0x3c, 0x0f, 0x8f, 0x6b, 0x06, 0xfe, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x19, 0xcc, 0x60, 0x83, 0xd9, 0x6c, 0x06, 0xfc, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1b, 0x0c, 0x7c, 0x83, 0xdf, 0x6c, 0x06, 0xf8, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1b, 0x0c, 0x66, 0x83, 0x81, 0x67, 0x06, 0xf0, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0x9b, 0x0d, 0x66, 0xb3, 0xd9, 0xc0, 0x07, 0xe0, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xf1, 0x0c, 0x7c, 0x1e, 0x8f, 0x07, 0x06, 0xc0, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x6c, 0x06, 0x80, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xc7, 0x03, 0x00, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; static char salience_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x07, 0x03, 0x00, 0x00, 0x00, 0xc0, 0x0f, 0x00, 0x70, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x66, 0x00, 0x06, 0x03, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x60, 0x00, 0x00, 0x03, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x60, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0xff, 0xff, 0x00, 0x06, 0x1e, 0x86, 0xc3, 0xf3, 0xf1, 0x78, 0xc0, 0x60, 0xe6, 0x61, 0xcc, 0x3c, 0x0f, 0x87, 0xe7, 0x03, 0xff, 0xff, 0x00, 0x3c, 0x30, 0x06, 0x63, 0x36, 0x9b, 0xcd, 0xc0, 0x67, 0x06, 0x63, 0xcc, 0x60, 0x03, 0xc6, 0x6c, 0x06, 0xff, 0xff, 0x00, 0x60, 0x3e, 0x06, 0xe3, 0x37, 0x1b, 0xfc, 0xc0, 0x60, 0xe6, 0x63, 0xcc, 0x7c, 0x03, 0xc6, 0x6c, 0x06, 0xfe, 0x7f, 0x00, 0x60, 0x33, 0x06, 0x63, 0x30, 0x1b, 0x0c, 0xc0, 0xc0, 0x33, 0x63, 0xcc, 0x66, 0x03, 0xc6, 0x6c, 0x06, 0xfc, 0x3f, 0x00, 0x66, 0x33, 0x06, 0x63, 0x36, 0x9b, 0xcd, 0xc0, 0xc0, 0x33, 0x63, 0xcc, 0x66, 0x33, 0xc6, 0x6c, 0x06, 0xf8, 0x1f, 0x00, 0x3c, 0xbe, 0xdf, 0xcf, 0x33, 0xf3, 0x78, 0xc0, 0x8f, 0xe1, 0xfb, 0xf9, 0x7c, 0x9e, 0x9f, 0x67, 0x06, 0xf0, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; /******************************************************************************* Name: OptionsWindow Description: Creates the Options menu arguements: w - Widget that invokes the callbaack function client,data - unused Returns: None *******************************************************************************/ void OptionsWindow( Widget w, XtPointer client, XtPointer data) { Widget Cancel,Okay,menu,salienceEval,strategy; int n, i; static char *optionList1[7] = {"Static Constraint Checking", "Dynamic Constraint Checking", "Reset Global Variables", "Sequence Expansion Operator Recognition", "Incremental Reset", "Auto-Float Dividend", "Fact Duplication"}; static char *optionList2[7] = {"Depth","Breadth","LEX","MEA","Complexity","Simplicity","Random"}; static char *optionList3[3] = {"When Defined","When Activated","Every Cycle"}; Pixmap SalienceBM,StrategyBM; /*===================================*/ /* If optionsShell exists pop it up. */ /*===================================*/ if (optionsShell != NULL) { UpdateOptionsMenu(); XtPopup(optionsShell,XtGrabNonexclusive); return; } /*================================================*/ /* If optionShell not available create one. */ /* The followings are the widget classes used in */ /* building the option menu */ /* topLevelShellWidgetClass */ /* formWidgetClass */ /* menuButtonWidgetClass */ /* simpleMenuWidgetClass */ /* smeBSBOjectClass */ /*================================================*/ n = 0; XtSetArg( TheArgs[n], XtNwidth,250); n++; XtSetArg( TheArgs[n], XtNheight,400); n++; optionsShell = XtCreatePopupShell("Execution Options",topLevelShellWidgetClass, XtParent(w),NULL,0); /*==============================================*/ /* Create the outside form for the option menu. */ /*==============================================*/ optionsForm = XtCreateManagedWidget("watch_form", formWidgetClass, optionsShell, TheArgs,n); SalienceBM = XCreateBitmapFromData(XtDisplay(toplevel), RootWindowOfScreen(XtScreen(toplevel)), salience_bits, salience_width, salience_height); /*==============================================*/ /* Create the salience Evaluation setting menu. */ /*==============================================*/ n = 0; XtSetArg(TheArgs[n],XtNbitmap,SalienceBM);n++; XtSetArg(TheArgs[n],XtNwidth,180);n++; salienceEval = XtCreateManagedWidget("salienceEvaluation", menuButtonWidgetClass, optionsForm, TheArgs, n); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, salienceEval, NULL,0); n = 0; XtSetArg(TheArgs[n],XtNleftMargin,15);n++; XtSetArg(TheArgs[n],XtNleftBitmap,checker);n++; for (i = 0; i < 3 ; i++) { sal_opt_widgets[i] = XtCreateManagedWidget(optionList3[i], smeBSBObjectClass, menu, TheArgs, n); XtAddCallback(sal_opt_widgets[i],XtNcallback,SetSalienceCallback,(XtPointer)i); n = 1; } /*===================================*/ /* Create the strategy setting menu. */ /*===================================*/ StrategyBM = XCreateBitmapFromData(XtDisplay(toplevel), RootWindowOfScreen(XtScreen(toplevel)), strategy_bits, strategy_width, strategy_height); n = 0; XtSetArg(TheArgs[n],XtNhorizDistance,10); n++; XtSetArg(TheArgs[n],XtNfromHoriz,salienceEval); n++; XtSetArg(TheArgs[n],XtNbitmap,StrategyBM); n++; XtSetArg(TheArgs[n],XtNwidth,150); n++; strategy = XtCreateManagedWidget("strategy", menuButtonWidgetClass, optionsForm, TheArgs, n); menu = XtCreatePopupShell("menu", simpleMenuWidgetClass, strategy, NULL, 0); n = 0; XtSetArg(TheArgs[n],XtNleftMargin, 15); n++; XtSetArg(TheArgs[n], XtNleftBitmap, checker); n++; for (i = 0; i < 7; i++) { strategy_widgets[i] = XtCreateManagedWidget(optionList2[i], smeBSBObjectClass, menu, TheArgs, n); XtAddCallback(strategy_widgets[i],XtNcallback,SetStrategyCallback,(XtPointer)i); n = 1; } /*=====================================*/ /* Create the rest of the option menu. */ /*=====================================*/ n = 0; XtSetArg(TheArgs[n],XtNwidth,200); n++; XtSetArg(TheArgs[n],XtNhorizDistance,80); n++; XtSetArg(TheArgs[n],XtNvertDistance,5); n++; XtSetArg(TheArgs[n],XtNfromVert,salienceEval); n++; for (i = 0; i < 7; i++) { if ((i == INT_STA_CONSTRAINT_CHK) || ( i == INT_AUTO_FLOAT_DIV) || (i == INT_INCREMENTAL_RESET) || ( i == INT_RESET_GLOBALS)) { XtSetArg(TheArgs[n], XtNstate,True); n++; } option_widgets[i] = XtCreateManagedWidget(optionList1[i], toggleWidgetClass, optionsForm, TheArgs, n); n = 3; XtSetArg(TheArgs[n],XtNfromVert,option_widgets[i]); n++; } /*=============================*/ /* Create the "Cancel" button. */ /*=============================*/ n = 0; XtSetArg(TheArgs[n],XtNshapeStyle,XmuShapeRoundedRectangle); n++; XtSetArg(TheArgs[n],XtNwidth,150); n++; XtSetArg(TheArgs[n],XtNfromVert,option_widgets[6]); n++; XtSetArg(TheArgs[n],XtNvertDistance,31);n++; XtSetArg(TheArgs[n],XtNlabel,"Cancel");n++; Cancel = XtCreateManagedWidget("watchButton", commandWidgetClass, optionsForm, TheArgs, n); XtAddCallback(Cancel,XtNcallback,PopdownSelect,(XtPointer)optionsForm); /* ====================================== */ /* Create the "OKay" button */ /* ====================================== */ n = 4; XtSetArg(TheArgs[n],XtNfromHoriz,Cancel);n++; XtSetArg(TheArgs[n],XtNhorizDistance,30);n++; XtSetArg(TheArgs[n],XtNlabel,"OKay");n++; Okay = XtCreateManagedWidget("watchButton", commandWidgetClass, optionsForm, TheArgs, n); XtAddCallback(Okay,XtNcallback,OkayOptionsCallback,(XtPointer)NULL); XtPopup(optionsShell,XtGrabNonexclusive); } /******************************************************************************* Name: SetStrategyCallback Description: Called when Depth Strategy is selected from Options menu. It marks the new selection in the Depth Strategy menu, but the value is changed only when the Okay button is pressed. Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void SetStrategyCallback( Widget w, XtPointer client_data, XtPointer call_data) { int i,n = 0,theIndex = (int)client_data; MoveEndOfFile(dialog_text, &TheEvent); XtSetArg(TheArgs[n], XtNleftBitmap, None);n++; for(i = 0 ; i <= RANDOM_STRATEGY;i++) XtSetValues(strategy_widgets[i], TheArgs, n); XtSetArg(TheArgs[0], XtNleftBitmap, checker);n++; XtSetValues(strategy_widgets[theIndex], TheArgs, n); optionFlags[STRATEGY_FLAG] = theIndex; quit_get_event = True; } /******************************************************************************* Name: SetSalienceCallback Description: Called when Evaluate When salience is set It marks the salience evaluation method to the new selected method, but the new value only changes when Okay button is pressed. Arguments: w - menu item that was selected client_data - entry number on menu call_data - not used Returns: None *******************************************************************************/ void SetSalienceCallback( Widget w, XtPointer client_data, XtPointer call_data) { int i,n = 0,theIndex = (int)client_data; MoveEndOfFile(dialog_text, &TheEvent); n = 0; XtSetArg(TheArgs[n], XtNleftBitmap, None);n++; for(i = 0; i <= EVERY_CYCLE; i++) { if(i != theIndex) XtSetValues(sal_opt_widgets[i],TheArgs,n); } n = 0; XtSetArg(TheArgs[n], XtNleftBitmap, checker);n++; XtSetValues(sal_opt_widgets[theIndex], TheArgs, n); optionFlags[SALIENCE_FLAG] = theIndex; quit_get_event = True; } /************************************************************************** OkayOptionsCallback Description : This function reset the option flags to the new values and remove the window from the screen. Arguments : w - widget that where the event happened Return : None **************************************************************************/ void OkayOptionsCallback( Widget w, XtPointer client, XtPointer call) { void *theEnv = GetCurrentEnvironment(); Boolean OnOff; int n; if((EnvGetStrategy(theEnv)) != optionFlags[STRATEGY_FLAG]) EnvSetStrategy(theEnv,optionFlags[STRATEGY_FLAG]); if((optionFlags[SALIENCE_FLAG]) != EnvGetSalienceEvaluation(theEnv)) EnvSetSalienceEvaluation(theEnv,optionFlags[SALIENCE_FLAG]); n = 0; /* ========================================================= */ XtSetArg(TheArgs[n],XtNstate,&OnOff);n++; XtGetValues(option_widgets[INT_FACT_DUPLICATION],TheArgs,n); if((OnOff)&&(! EnvGetFactDuplication(theEnv))) { EnvSetFactDuplication(theEnv,CLIPS_TRUE); } else if ((!OnOff)&&(EnvGetFactDuplication(theEnv))) { EnvSetFactDuplication(theEnv,CLIPS_FALSE); } /* ========================================================= */ XtGetValues(option_widgets[INT_DYN_CONSTRAINT_CHK],TheArgs,n); if((OnOff)&&(! EnvGetDynamicConstraintChecking(theEnv))) { EnvSetDynamicConstraintChecking(theEnv,CLIPS_TRUE); } else if((!OnOff) &&(EnvGetDynamicConstraintChecking(theEnv))) { EnvSetDynamicConstraintChecking(theEnv,CLIPS_FALSE); } /* ========================================================= */ XtGetValues(option_widgets[INT_STA_CONSTRAINT_CHK],TheArgs,n); if((OnOff)&&(! EnvGetStaticConstraintChecking(theEnv))) { EnvSetStaticConstraintChecking(theEnv,CLIPS_TRUE); } else if((!OnOff) &&(EnvGetStaticConstraintChecking(theEnv))) { EnvSetStaticConstraintChecking(theEnv,CLIPS_FALSE); } /* ========================================================= */ XtGetValues(option_widgets[INT_SEQUENCE_OPT_REG],TheArgs,n); if((OnOff)&&(!EnvGetSequenceOperatorRecognition(theEnv))) { EnvSetSequenceOperatorRecognition(theEnv,CLIPS_TRUE); } else if((!OnOff) &&(EnvGetSequenceOperatorRecognition(theEnv))) { EnvSetSequenceOperatorRecognition(theEnv,CLIPS_FALSE); } /* ========================================================= */ XtGetValues(option_widgets[INT_AUTO_FLOAT_DIV],TheArgs,n); if((OnOff)&&(!EnvGetAutoFloatDividend(theEnv))) { EnvSetAutoFloatDividend(theEnv,CLIPS_TRUE); } else if((!OnOff) &&(EnvGetAutoFloatDividend(theEnv))) { EnvSetAutoFloatDividend(theEnv,CLIPS_FALSE); } /* ========================================================= */ XtGetValues(option_widgets[INT_INCREMENTAL_RESET],TheArgs,n); if((OnOff)&&(!EnvGetIncrementalReset(theEnv))) { EnvSetIncrementalReset(theEnv,CLIPS_TRUE); } else if((!OnOff) &&(EnvGetIncrementalReset(theEnv))) { EnvSetIncrementalReset(theEnv,CLIPS_FALSE); } /* ========================================================= */ XtGetValues(option_widgets[INT_RESET_GLOBALS],TheArgs,n); if((OnOff)&&(!EnvGetResetGlobals(theEnv))) { EnvSetResetGlobals(theEnv,CLIPS_TRUE); } else if((!OnOff) &&(EnvGetResetGlobals(theEnv))) { EnvSetResetGlobals(theEnv,CLIPS_FALSE); } XtPopdown(XtParent(XtParent(w))); quit_get_event = True; } /**************************************************************************/ /**************************************************************************/ clips-6.24/x-prjct/xinterface/xmain.h0000755000175000017500000000407610444323575015732 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.01 06/15/03 */ /* */ /* XMAIN HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_xmain #define _H_xmain #ifdef LOCALE #undef LOCALE #endif #ifdef _XMAIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _XMAIN_SOURCE_ extern Pixmap clips_logo; extern Widget dialog_text; extern Arg TheArgs[]; extern XEvent TheEvent; extern Widget toplevel; extern Boolean quit_get_event; extern Boolean Browse_status[]; extern Widget dialog; extern Pixmap checker; extern Boolean Dribble_status; extern Boolean send_to_clips; extern XtAppContext app_con; extern KeySym TheKeysym; extern XComposeStatus compose_status; #endif #endif clips-6.24/x-prjct/xinterface/._xmenu.c0000400000175000017500000000012210444323570016124 0ustar jfsjfsMac OS X  2 RTEXTclips-6.24/x-prjct/._.DS_Store0000400000175000017500000000012210444324564014163 0ustar jfsjfsMac OS X  2 R@clips-6.24/x-prjct/color/0000755000175000017500000000000010060646470013415 5ustar jfsjfsclips-6.24/x-prjct/color/xdefault.h0000755000175000017500000000777306544406075015432 0ustar jfsjfs#define DIALOG_FG 0 #define DIALOG_BG 1 #define DIALOG_BDR 2 #define FACTS_FG 3 #define FACTS_BG 4 #define FACTS_BDR 5 #define INSTANCES_FG 6 #define INSTANCES_BG 7 #define INSTANCES_BDR 8 #define GLOBALS_FG 9 #define GLOBALS_BG 10 #define GLOBALS_BDR 11 #define AGENDA_FG 12 #define AGENDA_BG 13 #define AGENDA_BDR 14 #define FOCUS_FG 15 #define FOCUS_BG 16 #define FOCUS_BDR 17 #define BUTTON_FRM_BG 18 #define MENU_BUTTON_FG 19 #define MENU_BUTTON_BG 20 #define MENU_BUTTON_BDR 21 #define SMEBSB_FG 22 #define LINE_FG 23 #define MENU_FG 24 #define MENU_BG 25 #define MENU_BDR 26 #define MANGR_LIST_FG 27 #define MANGR_LIST_BG 28 #define MANGR_LIST_BDR 29 #define MANGR_VP_BDR 30 #define CONFIRM_FG 31 #define CONFIRM_BG 32 #define FILE_DIALOG_FG 33 #define FILE_DIALOG_BG 34 #define FILE_FORM_BG 35 #define MANGR_BUTTN_FG 36 #define MANGR_BUTTN_BG 37 #define MANGR_BUTTN_BDR 38 #define MANGR_CANCL_FG 39 #define MANGR_CANCL_BG 40 #define MANGR_CANCL_BDR 41 #define WATCH_FORM_FG 42 #define WATCH_FORM_BG 43 #define WATCH_FORM_BDR 44 #define TOGGLE_FG 45 #define TOGGLE_BG 46 #define TOGGLE_BDR 47 #define WATCH_FG 48 #define WATCH_BG 49 #define WATCH_BDR 50 #define NUMRES 51 static String defaultstring[NUMRES+1] = { "blue", /* Xclips*dialog_text*foreground */ "white", /* Xclips*dialog_text*background */ "blue", /* Xclips*dialog_text*borderColor */ "slateblue", /* Xclips*facts_text*foreground */ "seashell1", /* Xclips*facts_text*background */ "slateblue", /* Xclips*facts_text*borderColor */ "slateblue", /* Xclips*instances_text*foreground */ "seashell1", /* Xclips*instances_text*background */ "slateblue", /* Xclips*instances_text*borderColor */ "slateblue", /* Xclips*global_text*foreground */ "seashell1", /* Xclips*global_text*background */ "slateblue", /* Xclips*global_text*borderColor */ "maroon", /* Xclips*agenda_text*foreground */ "gray", /* Xclips*agenda_text*background */ "maroon", /* Xclips*agenda_text*borderColor */ "maroon", /* Xclips*focus_text*foreground */ "gray", /* Xclips*focus_text*background */ "maroon", /* Xclips*focus_text*borderColor */ "royalblue", /* Xclips*buttonForm.background */ "yellow", /* Xclips*MenuButton.foreground */ "royalblue", /* Xclips*MenuButton.background */ "yellow", /* Xclips*MenuButton.borderColor */ "yellow", /* Xclips*SmeBSB.foreground */ "yellow", /* Xclips*line.foreground */ "yellow", /* Xclips*menu.foreground */ "royalblue", /* Xclips*menu.background */ "yellow", /* Xclips*menu.borderColor */ "white", /* Xclips*manager_list.foreground */ "maroon", /* Xclips*manager_list.background */ "maroon", /* Xclips*manager_form.background */ "cadetblue", /* Xclips*manager_viewport.borderColor */ "yellow", /* Xclips*confirm*foreground */ "red", /* Xclips*confirm*background */ "black", /* Xclips*file_dialog*foreground */ "wheat", /* Xclips*file_dialog*background */ "wheat", /* Xclips*file_form.background */ "blue", /* Xclips*managerButton.foreground */ "white", /* Xclips*managerButton.background */ "blue", /* Xclips*managerButton.borderColor */ "red", /* Xclips*managerCancel.foreground */ "white", /* Xclips*managerCancel.background */ "red", /* Xclips*managerCancel.borderColor */ "black", /* Xclips*watch_form.foreground */ "cyan", /* Xclips*watch_form.background */ "blue", /* Xclips*watch_form.borderColor */ "yellow", /* Xclips*Toggle.foreground*/ "blue", /* Xclips*Toggle.background */ "yellow", /* Xclips*Toggle.borderColor */ "yellow", /*Xclips*watchButton.foreground*/ "blue", /*Xclips*watchButton.background */ "yellow", /*Xclips*watchButton.borderColor */ NULL}; clips-6.24/x-prjct/color/color.c0000755000175000017500000014306107422463007014710 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* X Windows Version 2.0 01/31/02 */ /* */ /* COLOR UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Bebe Ly */ /* Daniel J. McCoy */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #include #include #include #include #include #include #include #include #include #include #include #include #include #include "colors.h" #include "xdefault.h" #define streq(a, b) (strcmp((a), (b)) == 0) static void MakeTopCommandButtons(void); static void MakeColorList(void); static void MakeDummyCLIPSInterface(void); static void MakeBottomCommandButtons(void); static void MakePopups(void); static void Initialize(Widget); static void CreateCallbacks(); static void Choice(Widget,XtPointer,XtPointer); static void SetGround(Widget,XtPointer,XtPointer); static void Defaults(Widget,XtPointer,XtPointer); static void SetBox(Widget,XtPointer,XtPointer); static int Convert(Widget,char *); static void Quit(Widget,XtPointer,XtPointer); static void Saveyes(Widget,XtPointer,XtPointer); static void Saveno(Widget,XtPointer,XtPointer); static void ChooseFile(void); static void NextSave(Widget,XtPointer,XtPointer); static void Cancel(Widget,XtPointer,XtPointer); static void Quitno(Widget,XtPointer,XtPointer); String fallback_resources[] = { "*background: gray", "*list.foreground: white", "*list.background: blue", "*Command*foreground: white", "*Command*background: blue", "*Command*borderWidth: 0", "*Command*width: 105", "*Command*height: 26", "*Toggle*foreground: white", "*Toggle*background: blue", "*Toggle*borderWidth: 0", "*Toggle*width: 105", "*Toggle*height: 26", "*Label*internalHeight: 0", "*Label*internalWidth: 0", "*Label*borderWidth: 4", "*Button.background: white", "*Cancel.background: white", NULL}; static String resourcestring[NUMRES+1] = { "Xclips*dialog_text*foreground:", "Xclips*dialog_text*background:", "Xclips*dialog_text*borderColor:", "Xclips*facts_text*foreground:", "Xclips*facts_text*background:", "Xclips*facts_text*borderColor:", "Xclips*instances_text*foreground:", "Xclips*instances_text*background:", "Xclips*instances_text*borderColor:", "Xclips*globals_text*foreground:", "Xclips*globals_text*background:", "Xclips*globals_text*borderColor:", "Xclips*agenda_text*foreground:", "Xclips*agenda_text*background:", "Xclips*agenda_text*borderColor:", "Xclips*focus_text*foreground:", "Xclips*focus_text*background:", "Xclips*focus_text*borderColor:", "Xclips*buttonForm.background:", "Xclips*MenuButton.foreground:", "Xclips*MenuButton.background:", "Xclips*MenuButton.borderColor:", "Xclips*SmeBSB.foreground:", "Xclips*line.foreground:", "Xclips*menu.foreground:", "Xclips*menu.background:", "Xclips*menu.borderColor:", "Xclips*manager_list.foreground:", "Xclips*manager_list.background:", "Xclips*manager_form.background:", "Xclips*manager_viewport.borderColor:", "Xclips*confirm*foreground:", "Xclips*confirm*background:", "Xclips*file_dialog*foreground:", "Xclips*file_dialog*background:", "Xclips*file_form.background:", "Xclips*managerButton.foreground:", "Xclips*managerButton.background:", "Xclips*managerButton.borderColor:", "Xclips*managerCancel.foreground:", "Xclips*managerCancel.background:", "Xclips*managerCancel.borderColor:", "Xclips*watch_form.foreground:", "Xclips*watch_form.background:", "Xclips*watch_form.borderColor:", "Xclips*Toggle.foreground:", "Xclips*Toggle.background:", "Xclips*Toggle.borderColor:", "Xclips*watchButton.foreground:", "Xclips*watchButton.background:", "Xclips*watchButton.borderColor:", NULL}; static String temp[1] = {" "}; static String resourcecolor[NUMRES+1]; Widget root, form, viewport, list; Widget foreground, background, border, defaults, quit; Widget button_form, menuButton1, menuButton2, menuButton3, menuButton4, menu_label, dialog_label, facts_label,instances_label, globals_label, agenda_label, focus_label, manager_button_label, manager_cancel_label, manager_label, confirm_label, file_label, watch_options_label,W_O_toggle_label,W_O_button_label; Widget file, dialog, facts, instances,globals,focus, agenda, buttonBox, buttons, menu, manager, confirm, manager_buttons,watch_options,watch_option_buttons; Widget QUIT, quitform, quitno, saveyes, saveno, filesave, file_form, file_dialog; XtAppContext app_con; Arg args[5]; int ground_setting = FOREGROUND, widget_setting = DIALOG_WIN, i; Position x, y; FILE *f; char filename[60]; /***************************************************************** * MAIN ***************************************************************** */ int main( int argc, char **argv) { for (i = 0; i < NUMRES; i++) resourcecolor[i] = XtMalloc(40); (void) strcpy(filename, getenv("HOME")); (void) strcat(filename, "/Xclips"); XtSetArg(args[0], XtNminWidth, 709); XtSetArg(args[1], XtNminHeight, 506); XtSetArg(args[2], XtNmaxWidth, 709); XtSetArg(args[3], XtNmaxHeight, 506); root = XtAppInitialize(&app_con, "color", NULL, 0, &argc, argv, fallback_resources, args, 4); MakeColorList(); MakeTopCommandButtons(); MakeDummyCLIPSInterface(); MakeBottomCommandButtons(); MakePopups(); Initialize(root); CreateCallbacks(); XtRealizeWidget(root); XtAppMainLoop(app_con); return(-1); } /******************************************************************************** Name: MakeColorList Description: Creates main window and places list of color selections in window Arguements: None Returns: None ********************************************************************************/ static void MakeColorList() { form = XtCreateManagedWidget("form", formWidgetClass, root, NULL, 0); XtSetArg(args[0], XtNheight, 520); XtSetArg(args[1], XtNallowVert, True); XtSetArg(args[2], XtNborderWidth, 0); viewport = XtCreateManagedWidget("viewport", viewportWidgetClass, form, args, 3); XtSetArg(args[0], XtNlist, items); XtSetArg(args[1], XtNdefaultColumns, 1); XtSetArg(args[2], XtNforceColumns, True); list = XtCreateManagedWidget("list", listWidgetClass, viewport, args, 3); } /******************************************************************************** Name: MakeTopCommandButtons Description: Creates top row of command widgets for Foreground, Background, Border, Default, and Quit/Save Arguements: None Returns: None ********************************************************************************/ static void MakeTopCommandButtons() { XtSetArg(args[0], XtNfromHoriz, viewport); XtSetArg(args[1], XtNradioGroup, border); XtSetArg(args[2], XtNstate, True); foreground = XtCreateManagedWidget("Foreground", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, foreground); XtSetArg(args[1], XtNradioGroup, foreground); background = XtCreateManagedWidget("Background", toggleWidgetClass, form, args, 2); XtSetArg(args[0], XtNfromHoriz, background); XtSetArg(args[1], XtNradioGroup, background); border = XtCreateManagedWidget("Border", toggleWidgetClass, form, args, 2); XtSetArg(args[0], XtNfromHoriz, border); defaults = XtCreateManagedWidget("Default", commandWidgetClass, form, args, 1); XtSetArg(args[0], XtNfromHoriz, defaults); quit = XtCreateManagedWidget("Quit/Save", commandWidgetClass, form, args, 1); } /******************************************************************************** Name: MakeDummyCLIPSInterface Description: Creates windows to look like the CLIPS X-Interface Arguements: None Returns: None ********************************************************************************/ static void MakeDummyCLIPSInterface() { /* ========================================= */ /* Create the button form and button labels */ /* ========================================= */ XtSetArg(args[0], XtNfromHoriz, viewport); XtSetArg(args[1], XtNfromVert, foreground); XtSetArg(args[2], XtNborderWidth, 0); button_form = XtCreateManagedWidget("button_form", formWidgetClass, form, args, 3); XtSetArg(args[0], XtNwidth, 63); menuButton1 = XtCreateManagedWidget("button", labelWidgetClass, button_form, args, 1); XtSetArg(args[1], XtNfromHoriz, menuButton1); menuButton2 = XtCreateManagedWidget("button", labelWidgetClass, button_form, args, 2); XtSetArg(args[1], XtNfromHoriz, menuButton2); menuButton3 = XtCreateManagedWidget("button", labelWidgetClass, button_form, args, 2); XtSetArg(args[1], XtNfromHoriz, menuButton3); menuButton4 = XtCreateManagedWidget("button", labelWidgetClass, button_form, args, 2); /* ======================================= */ /* Create the label for the menu */ /* ======================================= */ XtSetArg(args[0], XtNfromHoriz, viewport); XtSetArg(args[1], XtNfromVert, button_form); XtSetArg(args[2], XtNheight, 100); XtSetArg(args[3], XtNwidth, 75); menu_label = XtCreateManagedWidget("Menu", labelWidgetClass, form, args, 4); /* ======================================= */ /* Create the lable for the toggle button */ /* ======================================= */ XtSetArg(args[0], XtNfromHoriz,menu_label); XtSetArg(args[1], XtNfromVert, button_form); W_O_toggle_label = XtCreateManagedWidget("Toggle Button",labelWidgetClass, form, args,2); /* ======================================= */ /* Create the lable for command button */ /* ======================================= */ XtSetArg(args[0], XtNfromHoriz,menu_label); XtSetArg(args[1], XtNfromVert,W_O_toggle_label); W_O_button_label = XtCreateManagedWidget("Command button",labelWidgetClass,form,args,2); /* ======================================= */ /* Create the lable for the W/O button */ /* ======================================= */ XtSetArg(args[0], XtNfromHoriz,menu_label); XtSetArg(args[1], XtNfromVert, button_form); XtSetArg(args[2], XtNheight, 100); XtSetArg(args[3], XtNwidth, 150); watch_options_label = XtCreateManagedWidget("Watch/Option", labelWidgetClass, form, args, 4); /* ======================================= */ /* Create the lable for the Clips Dialog */ /* ======================================= */ XtSetArg(args[1], XtNfromVert, button_form); XtSetArg(args[0], XtNfromHoriz,viewport); XtSetArg(args[2], XtNheight, 250); XtSetArg(args[3], XtNwidth, 296); dialog_label = XtCreateManagedWidget("Dialog", labelWidgetClass, form, args, 4); /* ======================================= */ /* Create the lable for the fact window */ /* ======================================= */ XtSetArg(args[0], XtNfromHoriz, dialog_label); XtSetArg(args[1], XtNfromVert, quit); XtSetArg(args[2], XtNheight, 126); XtSetArg(args[3], XtNwidth, 100); facts_label = XtCreateManagedWidget("Facts", labelWidgetClass, form, args, 4); /* ======================================= */ /* Create the lable for the instances win */ /* ======================================= */ XtSetArg(args[0], XtNfromHoriz, dialog_label); XtSetArg(args[1], XtNfromVert,facts_label); XtSetArg(args[2], XtNheight, 126); XtSetArg(args[3], XtNwidth, 100); instances_label = XtCreateManagedWidget("Instances",labelWidgetClass,form,args, 4); /* ======================================= */ /* Create the lable for the global window */ /* ======================================= */ XtSetArg(args[0], XtNfromHoriz, dialog_label); XtSetArg(args[1], XtNfromVert,instances_label); XtSetArg(args[2], XtNheight, 125); XtSetArg(args[3], XtNwidth, 100); globals_label = XtCreateManagedWidget("globals",labelWidgetClass,form,args,4); /* ======================================= */ /* Create the lable for the agenda window */ /* ======================================= */ XtSetArg(args[0], XtNfromVert, dialog_label); XtSetArg(args[1], XtNfromHoriz, viewport); XtSetArg(args[2], XtNheight, 102); XtSetArg(args[3], XtNwidth, 196); agenda_label = XtCreateManagedWidget("Agenda", labelWidgetClass, form, args, 4); /* ===================================== */ /* Create the Focus window label */ /* ===================================== */ XtSetArg(args[1],XtNfromHoriz,agenda_label); XtSetArg(args[3],XtNwidth,90); focus_label = XtCreateManagedWidget("Focus", labelWidgetClass, form, args, 4); /* ======================================== */ /* Create the label for the manager button */ /* ======================================== */ XtSetArg(args[0], XtNfromHoriz, facts_label); XtSetArg(args[1], XtNfromVert, foreground); manager_button_label = XtCreateManagedWidget("Button", labelWidgetClass, form, args, 2); /* ======================================== */ /* Create the label for the cancel button */ /* ======================================== */ XtSetArg(args[0], XtNfromHoriz, facts_label); XtSetArg(args[1], XtNfromVert, manager_button_label); manager_cancel_label = XtCreateManagedWidget("Cancel", labelWidgetClass, form, args, 2); XtSetArg(args[0], XtNfromHoriz, facts_label); XtSetArg(args[1], XtNfromVert, foreground); XtSetArg(args[2], XtNheight, 193); XtSetArg(args[3], XtNwidth, 115); manager_label = XtCreateManagedWidget("Manager", labelWidgetClass, form, args, 4); XtSetArg(args[1], XtNfromVert, manager_label); XtSetArg(args[2], XtNheight, 98); XtSetArg(args[3], XtNwidth, 123); XtSetArg(args[4], XtNborderWidth, 0); confirm_label = XtCreateManagedWidget("Confirmation", labelWidgetClass, form, args, 5); XtSetArg(args[1], XtNfromVert, confirm_label); XtSetArg(args[2], XtNheight, 98); XtSetArg(args[3], XtNwidth, 123); XtSetArg(args[4], XtNborderWidth, 0); file_label = XtCreateManagedWidget("File Selection", labelWidgetClass, form, args, 5); } /******************************************************************************** Name: MakeBottomCommandButtons Description: Creates botton rows of command buttons for Dialog Window, Facts Window, Agenda Window, Button Box, Menu Buttons, Pulldown Menus, Managers, Confirmations, File Selection, and Editors Arguements: None Returns: None ********************************************************************************/ static void MakeBottomCommandButtons() { XtSetArg(args[0], XtNfromHoriz, viewport); XtSetArg(args[1], XtNfromVert, agenda_label); XtSetArg(args[2], XtNradioGroup, file); XtSetArg(args[3], XtNstate, True); dialog = XtCreateManagedWidget("Dialog Window", toggleWidgetClass, form, args, 4); XtSetArg(args[0], XtNfromHoriz, dialog); XtSetArg(args[2], XtNradioGroup, dialog); facts = XtCreateManagedWidget("Facts Window", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, facts); XtSetArg(args[2], XtNradioGroup, facts); instances = XtCreateManagedWidget("Instances Win.", toggleWidgetClass, form, args,3); XtSetArg(args[0], XtNfromHoriz, instances); XtSetArg(args[2], XtNradioGroup, instances); globals = XtCreateManagedWidget("Globals Window", toggleWidgetClass, form, args,3); XtSetArg(args[0], XtNfromHoriz, globals); XtSetArg(args[2], XtNradioGroup, globals); agenda = XtCreateManagedWidget("Agenda Window", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, viewport); XtSetArg(args[1], XtNfromVert, dialog); XtSetArg(args[2], XtNradioGroup, agenda); focus = XtCreateManagedWidget("Focus Window",toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, focus); XtSetArg(args[1], XtNfromVert, dialog); XtSetArg(args[2], XtNradioGroup, agenda); buttonBox = XtCreateManagedWidget("Button Box", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, buttonBox); XtSetArg(args[2], XtNradioGroup, buttonBox); buttons = XtCreateManagedWidget("Menu Buttons", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, buttons); XtSetArg(args[2], XtNradioGroup, buttons); menu = XtCreateManagedWidget("Pulldown Menus", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, menu); XtSetArg(args[2], XtNradioGroup, menu); manager = XtCreateManagedWidget("Managers", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, viewport); XtSetArg(args[1], XtNfromVert,focus); XtSetArg(args[2], XtNradioGroup, manager); manager_buttons = XtCreateManagedWidget("Manager Button", toggleWidgetClass,form,args,3); XtSetArg(args[0], XtNfromHoriz, manager_buttons); XtSetArg(args[2], XtNradioGroup,manager_buttons); confirm = XtCreateManagedWidget("Confirmations", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz, confirm); XtSetArg(args[2], XtNradioGroup, confirm); file = XtCreateManagedWidget("File", toggleWidgetClass, form, args, 3); XtSetArg(args[0], XtNfromHoriz,file); XtSetArg(args[2], XtNradioGroup,file); watch_options = XtCreateManagedWidget("Watch/Options", toggleWidgetClass,form,args,3); XtSetArg(args[0], XtNfromHoriz,watch_options); XtSetArg(args[2], XtNradioGroup,watch_options); watch_option_buttons = XtCreateManagedWidget("Wtch/Opt Bttns",toggleWidgetClass, form,args,3); } /******************************************************************************** Name: MakePopups Description: Create pop-up widgets QUIT and filesave Arguements: None Returns: None ********************************************************************************/ static void MakePopups() { XtSetArg(args[0], XtNborderWidth, 0); QUIT = XtCreatePopupShell("QUIT", overrideShellWidgetClass, root, args, 1); quitform = XtCreateManagedWidget("quitform", formWidgetClass, QUIT, NULL, 0); quitno = XtCreateManagedWidget("Do NOT Quit", commandWidgetClass, quitform, args, 0); XtSetArg(args[0], XtNfromVert, quitno); saveyes = XtCreateManagedWidget("Save and Quit", commandWidgetClass, quitform, args, 1); XtSetArg(args[0], XtNfromVert, saveyes); saveno = XtCreateManagedWidget("Quit", commandWidgetClass, quitform, args, 1); filesave = XtCreatePopupShell("filesave", overrideShellWidgetClass, root, args, 2); XtSetArg(args[0], XtNborderWidth, 0); file_form = XtCreateManagedWidget("file_form", formWidgetClass, filesave, args, 1); XtSetArg(args[0], XtNvalue, ""); XtSetArg(args[1], XtNlabel, "ERROR! Enter new [path]filename."); XtSetArg(args[2], XtNborderWidth, 0); file_dialog = XtCreateManagedWidget("file_dialog", dialogWidgetClass, file_form, args, 3); XawDialogAddButton(file_dialog, "OK", NextSave, (XtPointer) file_form); XawDialogAddButton(file_dialog, "CANCEL", Cancel, (XtPointer) file_form); } /******************************************************************************** Name: CreateCallbacks Description: Contains XtAddCallbacks Arguements: None Returns: None ********************************************************************************/ static void CreateCallbacks() { XtAddCallback(list, XtNcallback, Choice, NULL); XtAddCallback(foreground, XtNcallback, SetGround, NULL); XtAddCallback(background, XtNcallback, SetGround, NULL); XtAddCallback(border, XtNcallback, SetGround, NULL); XtAddCallback(defaults, XtNcallback, Defaults, NULL); XtAddCallback(quit, XtNcallback, Quit, NULL); XtAddCallback(buttonBox, XtNcallback, SetBox, NULL); XtAddCallback(buttons, XtNcallback, SetBox, NULL); XtAddCallback(dialog, XtNcallback, SetBox, NULL); XtAddCallback(facts, XtNcallback, SetBox, NULL); XtAddCallback(instances, XtNcallback, SetBox, NULL); XtAddCallback(globals, XtNcallback, SetBox, NULL); XtAddCallback(agenda, XtNcallback, SetBox, NULL); XtAddCallback(focus,XtNcallback,SetBox,NULL); XtAddCallback(menu, XtNcallback, SetBox, NULL); XtAddCallback(manager, XtNcallback, SetBox, NULL); XtAddCallback(confirm, XtNcallback, SetBox, NULL); XtAddCallback(file, XtNcallback, SetBox, NULL); XtAddCallback(manager_buttons, XtNcallback, SetBox, NULL); XtAddCallback(watch_options,XtNcallback,SetBox,NULL); XtAddCallback(watch_option_buttons,XtNcallback,SetBox,NULL); XtAddCallback(saveyes, XtNcallback, Saveyes, NULL); XtAddCallback(saveno, XtNcallback, Saveno, NULL); XtAddCallback(quitno, XtNcallback, Quitno, (XtPointer) QUIT); } /******************************************************************************** Name: Initialize Description: reads the file "Xclips" if able, loads colors into resourcecolor, and sets colors on display Arguements: w - Not used except as a dummy widget Returns: None ********************************************************************************/ static void Initialize( Widget w) { char tempcolor[50]; if ((f = fopen(filename, "r")) != NULL) { for (i = 0; i < NUMRES; i++) fscanf(f, "%s%s", temp[0], resourcecolor[i]); fclose(f); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[DIALOG_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[DIALOG_BG])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[DIALOG_BDR])); XtSetValues(dialog_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[FACTS_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[FACTS_BG])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[FACTS_BDR])); XtSetValues(facts_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[INSTANCES_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[INSTANCES_BG])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[INSTANCES_BDR])); XtSetValues(instances_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[GLOBALS_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[GLOBALS_BG])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[GLOBALS_BDR])); XtSetValues(globals_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[AGENDA_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[AGENDA_BG])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[AGENDA_BDR])); XtSetValues(agenda_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[FOCUS_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[FOCUS_BG])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[FOCUS_BDR])); XtSetValues(focus_label, args, 3); XtSetArg(args[0], XtNbackground, Convert(w, resourcecolor[BUTTON_FRM_BG])); XtSetValues(button_form, args, 1); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[MENU_BUTTON_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[MENU_BUTTON_BG])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[MENU_BUTTON_BDR])); XtSetValues(menuButton1, args, 3); XtSetValues(menuButton2, args, 3); XtSetValues(menuButton3, args, 3); XtSetValues(menuButton4, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[SMEBSB_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[MENU_BG])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[MENU_BDR])); XtSetValues(menu_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[MANGR_LIST_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[MANGR_LIST_BDR])); XtSetArg(args[2], XtNborder, Convert(w, resourcecolor[MANGR_VP_BDR])); XtSetValues(manager_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[CONFIRM_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[CONFIRM_BG])); XtSetValues(confirm_label, args, 2); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[FILE_DIALOG_FG])); XtSetArg(args[1], XtNbackground, Convert(w, resourcecolor[FILE_DIALOG_BG])); XtSetValues(file_label, args, 2); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[MANGR_BUTTN_FG])); XtSetArg(args[2], XtNbackground, Convert(w, resourcecolor[ MANGR_BUTTN_BG])); XtSetArg(args[1], XtNborder, Convert(w, resourcecolor[MANGR_BUTTN_BDR])); XtSetValues(manager_button_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, resourcecolor[MANGR_CANCL_FG])); XtSetArg(args[2], XtNbackground, Convert(w, resourcecolor[MANGR_CANCL_BG])); XtSetArg(args[1], XtNborder, Convert(w, resourcecolor[MANGR_CANCL_BDR])); XtSetValues(manager_cancel_label, args, 3); XtSetArg(args[0],XtNbackground, Convert(w, resourcecolor[WATCH_FORM_BG])); XtSetArg(args[1],XtNborder, Convert(w, resourcecolor[WATCH_FORM_BDR])); XtSetArg(args[2],XtNforeground,Convert(w, resourcecolor[WATCH_FORM_FG])); XtSetValues(watch_options_label,args,3); XtSetArg(args[0],XtNbackground, Convert(w, resourcecolor[TOGGLE_BG])); XtSetArg(args[1],XtNborder, Convert(w, resourcecolor[TOGGLE_BDR])); XtSetArg(args[2],XtNforeground,Convert(w, resourcecolor[TOGGLE_FG])); XtSetValues(W_O_toggle_label,args,3); XtSetArg(args[0],XtNbackground, Convert(w, resourcecolor[WATCH_BG])); XtSetArg(args[1],XtNborder, Convert(w, resourcecolor[WATCH_BDR])); XtSetArg(args[2],XtNforeground,Convert(w, resourcecolor[WATCH_FG])); XtSetValues(W_O_button_label,args,3); } else Defaults(w, NULL, NULL); } /******************************************************************************** Name: Choice Description: Upon selecting a color this will make the proper changes on the display and store the new color Arguements: w - Not used except as a dummy widget client_data - Not used call_data - selected color Returns: None ********************************************************************************/ static void Choice( Widget w, XtPointer client_data, XtPointer call_data) { XawListReturnStruct *item = (XawListReturnStruct*)call_data; XrmValue from, to; from.size = strlen(item->string) + 1; from.addr = item->string; XtConvert(w, XtRString, (XrmValuePtr) &from, XtRPixel, (XrmValuePtr) &to); if (to.addr != NULL) if (ground_setting == FOREGROUND) { XtSetArg(args[0], XtNforeground, (int) *((Pixel *) to.addr)); switch (widget_setting) { case MANAGER_BUTTON : XtSetArg(args[1], XtNborder, (int) *((Pixel *) to.addr)); XtSetValues(manager_button_label, args, 2); resourcecolor[MANGR_BUTTN_FG] = item->string; resourcecolor[MANGR_BUTTN_BDR] = item->string; break; case WATCH_OPTION_BUTTONS : XtSetArg(args[1], XtNborder, (int) *((Pixel *) to.addr)); XtSetValues(W_O_toggle_label,args,2); resourcecolor[TOGGLE_FG] = item->string; resourcecolor[TOGGLE_BDR] = item->string; break; case MENU_BUTTON : XtSetValues(menuButton1, args, 1); XtSetValues(menuButton2, args, 1); XtSetValues(menuButton3, args, 1); XtSetValues(menuButton4, args, 1); resourcecolor[MENU_BUTTON_FG] = item->string; break; case DIALOG_WIN : XtSetValues(dialog_label, args, 1); resourcecolor[DIALOG_FG] = item->string; break; case FACTS_WIN : XtSetValues(facts_label, args, 1); resourcecolor[FACTS_FG] = item->string; break; case INSTANCES_WIN : XtSetValues(instances_label, args, 1); resourcecolor[INSTANCES_FG] = item->string; break; case GLOBALS_WIN : XtSetValues(globals_label, args, 1); resourcecolor[GLOBALS_FG] = item->string; break; case AGENDA_WIN : XtSetValues(agenda_label, args, 1); resourcecolor[AGENDA_FG] = item->string; break; case FOCUS_WIN: XtSetValues(focus_label,args,1); resourcecolor[FOCUS_FG] = item->string; break; case PULLDOWN_MENUS : XtSetValues(menu_label, args, 1); resourcecolor[SMEBSB_FG] = item->string; resourcecolor[LINE_FG] = item->string; resourcecolor[MENU_FG] = item->string; break; case WATCH_OPTIONS: XtSetValues(watch_options_label, args, 1); resourcecolor[WATCH_FORM_FG] = item->string; break; case MANAGERS : XtSetValues(manager_label, args, 1); resourcecolor[MANGR_LIST_FG] = item->string; break; case CONFIRMATION : XtSetValues(confirm_label, args, 1); resourcecolor[CONFIRM_FG] = item->string; break; case FILE_WIN : XtSetValues(file_label, args, 1); resourcecolor[FILE_DIALOG_FG] = item->string; break; } } else if (ground_setting == BACKGROUND) { XtSetArg(args[0], XtNbackground, (int) *((Pixel *) to.addr)); switch (widget_setting) { case MANAGER_BUTTON : XtSetValues(manager_button_label, args, 1); XtSetValues(manager_cancel_label, args, 1); resourcecolor[MANGR_BUTTN_BG] = item->string; resourcecolor[MANGR_CANCL_BG] = item->string; break; case WATCH_OPTION_BUTTONS : XtSetValues(W_O_toggle_label,args,1); XtSetValues(W_O_button_label,args,1); resourcecolor[TOGGLE_BG] = item->string; resourcecolor[WATCH_BG] = item->string; break; case BUTTON_BOX : XtSetValues(button_form, args, 1); resourcecolor[BUTTON_FRM_BG] = item->string; break; case MENU_BUTTON : XtSetValues(menuButton1, args, 1); XtSetValues(menuButton2, args, 1); XtSetValues(menuButton3, args, 1); XtSetValues(menuButton4, args, 1); resourcecolor[MENU_BUTTON_BG] = item->string; break; case DIALOG_WIN : XtSetValues(dialog_label, args, 1); resourcecolor[DIALOG_BG] = item->string; break; case FACTS_WIN : XtSetValues(facts_label, args, 1); resourcecolor[FACTS_BG] = item->string; break; case INSTANCES_WIN : XtSetValues(instances_label, args, 1); resourcecolor[INSTANCES_BG] = item->string; break; case GLOBALS_WIN : XtSetValues(globals_label, args, 1); resourcecolor[GLOBALS_BG] = item->string; break; case AGENDA_WIN : XtSetValues(agenda_label, args, 1); resourcecolor[AGENDA_BG] = item->string; break; case FOCUS_WIN : XtSetValues(focus_label, args, 1); resourcecolor[FOCUS_BG] = item->string; break; case PULLDOWN_MENUS : XtSetValues(menu_label, args, 1); resourcecolor[MENU_BG] = item->string; break; case MANAGERS : XtSetValues(manager_label, args, 1); resourcecolor[MANGR_LIST_BG] = item->string; resourcecolor[MANGR_LIST_BDR] = item->string; break; case WATCH_OPTIONS: XtSetValues(watch_options_label,args,1); resourcecolor[WATCH_FORM_BG] = item->string; break; case CONFIRMATION : XtSetValues(confirm_label, args, 1); resourcecolor[CONFIRM_BG] = item->string; break; case FILE_WIN : XtSetValues(file_label, args, 1); resourcecolor[FILE_DIALOG_BG] = item->string; resourcecolor[FILE_FORM_BG] = item->string; break; } } else if (ground_setting == BORDER) { XtSetArg(args[0], XtNborder, (int) *((Pixel *) to.addr)); switch (widget_setting) { case MANAGER_BUTTON : XtSetArg(args[1], XtNforeground, (int) *((Pixel *) to.addr)); XtSetValues(manager_cancel_label, args, 2); resourcecolor[MANGR_CANCL_FG] = item->string; resourcecolor[MANGR_CANCL_BDR] = item->string; break; case WATCH_OPTION_BUTTONS : XtSetArg(args[1], XtNforeground, (int) *((Pixel *) to.addr)); XtSetValues(W_O_button_label,args,2); resourcecolor[WATCH_FG] = item->string; resourcecolor[WATCH_BDR] = item->string; break; case MENU_BUTTON : XtSetValues(menuButton1, args, 1); XtSetValues(menuButton2, args, 1); XtSetValues(menuButton3, args, 1); XtSetValues(menuButton4, args, 1); resourcecolor[MENU_BUTTON_BDR] = item->string; break; case DIALOG_WIN : XtSetValues(dialog_label, args, 1); resourcecolor[DIALOG_BDR] = item->string; break; case FACTS_WIN : XtSetValues(facts_label, args, 1); resourcecolor[GLOBALS_BDR] = item->string; break; case INSTANCES_WIN : XtSetValues(instances_label, args, 1); resourcecolor[INSTANCES_BDR] = item->string; break; case GLOBALS_WIN : XtSetValues(globals_label, args, 1); resourcecolor[GLOBALS_BDR] = item->string; break; case AGENDA_WIN : XtSetValues(agenda_label, args, 1); resourcecolor[AGENDA_BDR] = item->string; break; case FOCUS_WIN: XtSetValues(focus_label, args, 1); resourcecolor[FOCUS_BDR] = item->string; break; case PULLDOWN_MENUS : XtSetValues(menu_label, args, 1); resourcecolor[MENU_BDR] = item->string; break; case MANAGERS : XtSetValues(manager_label, args, 1); resourcecolor[MANGR_VP_BDR] = item->string; break; case WATCH_OPTIONS: XtSetValues(watch_options_label,args,1); resourcecolor[WATCH_FORM_BDR] = item->string; break; } } } /******************************************************************************** Name: SetGround Description: Sets current ground selection Arguements: w - Not used client_data - Not used call_data - Not used Returns: None *******************************************************************************/ static void SetGround( Widget w, XtPointer client_data, XtPointer call_data) { if (streq(XtName(w), "Foreground")) ground_setting = FOREGROUND; else if (streq(XtName(w), "Background")) ground_setting = BACKGROUND; else if (streq(XtName(w), "Border")) ground_setting = BORDER; else ground_setting = NOT_AVAILABLE; } /******************************************************************************** Name: Defaults Description: Sets current selection and highlighted button to default Arguements: w - Not used except as a dummy widget client_data - Not used call_data - Not used Returns: None *******************************************************************************/ static void Defaults( Widget w, XtPointer client_data, XtPointer call_data) { XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[DIALOG_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[DIALOG_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[DIALOG_BDR])); XtSetValues(dialog_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[FACTS_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[FACTS_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[FACTS_BDR])); XtSetValues(facts_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[INSTANCES_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[INSTANCES_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[INSTANCES_BDR])); XtSetValues(instances_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[GLOBALS_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[GLOBALS_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[GLOBALS_BDR])); XtSetValues(globals_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[AGENDA_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[AGENDA_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[AGENDA_BDR])); XtSetValues(agenda_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[FOCUS_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[FOCUS_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[FOCUS_BDR])); XtSetValues(focus_label, args, 3); XtSetArg(args[0], XtNbackground, Convert(w, defaultstring[BUTTON_FRM_BG])); XtSetValues(button_form, args, 1); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[MENU_BUTTON_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[MENU_BUTTON_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[MENU_BUTTON_BDR])); XtSetValues(menuButton1, args, 3); XtSetValues(menuButton2, args, 3); XtSetValues(menuButton3, args, 3); XtSetValues(menuButton4, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[SMEBSB_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[MENU_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[MENU_BDR])); XtSetValues(menu_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[MANGR_LIST_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[MANGR_LIST_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[MANGR_LIST_BDR])); XtSetValues(manager_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[CONFIRM_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[CONFIRM_BG])); XtSetValues(confirm_label, args, 2); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[FILE_DIALOG_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[FILE_DIALOG_BG])); XtSetValues(file_label, args, 2); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[MANGR_BUTTN_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[MANGR_BUTTN_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[MANGR_BUTTN_BDR])); XtSetValues(manager_button_label, args, 3); XtSetArg(args[0], XtNforeground, Convert(w, defaultstring[MANGR_CANCL_FG])); XtSetArg(args[1], XtNbackground, Convert(w, defaultstring[MANGR_CANCL_BG])); XtSetArg(args[2], XtNborder, Convert(w, defaultstring[MANGR_CANCL_BDR])); XtSetValues(manager_cancel_label, args, 3); XtSetArg(args[0], XtNbackground, Convert(w, defaultstring[WATCH_FORM_BG])); XtSetArg(args[1], XtNborderColor, Convert(w, defaultstring[WATCH_FORM_BDR])); XtSetArg(args[2], XtNforeground,Convert(w, defaultstring[WATCH_FORM_FG])); XtSetValues(watch_options_label, args,3); XtSetArg(args[0], XtNbackground, Convert(w, defaultstring[TOGGLE_BG])); XtSetArg(args[1], XtNborderColor, Convert(w, defaultstring[TOGGLE_BDR])); XtSetArg(args[2], XtNforeground,Convert(w, defaultstring[TOGGLE_FG])); XtSetValues(W_O_toggle_label,args,3); XtSetArg(args[0], XtNbackground, Convert(w, defaultstring[WATCH_BG])); XtSetArg(args[1], XtNborderColor, Convert(w, defaultstring[WATCH_BDR])); XtSetArg(args[2], XtNforeground,Convert(w, defaultstring[WATCH_FG])); XtSetValues(W_O_button_label,args,3); for (i = 0; i < NUMRES; i++) resourcecolor[i] = defaultstring[i]; } /******************************************************************************** Name: SetBox Description: Sets current box selection Arguements: w - Not used client_data - Not used call_data - Not used Returns: None *******************************************************************************/ static void SetBox( Widget w, XtPointer client_data, XtPointer call_data) { XtSetArg(args[0], XtNlabel, "Foreground"); XtSetValues(foreground, args, 1); XtSetArg(args[0], XtNlabel, "Background"); XtSetValues(background, args, 1); XtSetArg(args[0], XtNlabel, "Border"); XtSetValues(border, args, 1); if (streq(XtName(w), "Manager Button")) { widget_setting = MANAGER_BUTTON; XtSetArg(args[0], XtNlabel, "Button"); XtSetValues(foreground, args, 1); XtSetArg(args[0], XtNlabel, "Cancel"); XtSetValues(border, args, 1); } else if (streq(XtName(w), "Wtch/Opt Bttns")) { widget_setting = WATCH_OPTION_BUTTONS; XtSetArg(args[0], XtNlabel, "ToggleButton"); XtSetValues(foreground, args, 1); XtSetArg(args[0], XtNlabel, "CommandButton"); XtSetValues(border, args, 1); } else if (streq(XtName(w), "Button Box")) { widget_setting = BUTTON_BOX; XtSetArg(args[0], XtNlabel, "N/A"); XtSetValues(foreground, args, 1); XtSetArg(args[0], XtNlabel, "N/A"); XtSetValues(border, args, 1); } else if (streq(XtName(w), "Menu Buttons")) widget_setting = MENU_BUTTON; else if (streq(XtName(w), "Dialog Window")) widget_setting = DIALOG_WIN; else if (streq(XtName(w), "Facts Window")) widget_setting = FACTS_WIN; else if (streq(XtName(w), "Instances Window")) widget_setting = INSTANCES_WIN; else if (streq(XtName(w), "Globals Window")) widget_setting = GLOBALS_WIN; else if (streq(XtName(w), "Agenda Window")) widget_setting = AGENDA_WIN; else if (streq(XtName(w), "Focus Window")) widget_setting = FOCUS_WIN; else if (streq(XtName(w), "Pulldown Menus")) widget_setting = PULLDOWN_MENUS; else if (streq(XtName(w), "Managers")) widget_setting = MANAGERS; else if (streq(XtName(w), "Watch/Options")) widget_setting = WATCH_OPTIONS; else if (streq(XtName(w), "Confirmations")) { widget_setting = CONFIRMATION; XtSetArg(args[0], XtNlabel, "N/A"); XtSetValues(border, args, 1); } else if (streq(XtName(w), "File")) { widget_setting = FILE_WIN; XtSetArg(args[0], XtNlabel, "N/A"); XtSetValues(border, args, 1); } } /******************************************************************************** Name: Convert Description: Converts string of a color to Pixel value Arguements: w - Not used except as a dummy widget color - string of a color Returns: Pixel value of a valid color or -1 for an invalid color *******************************************************************************/ static int Convert( Widget w, char *color) { XrmValue from, to; from.size = strlen(color) + 1; from.addr = color; XtConvert(w, XtRString, (XrmValuePtr) &from, XtRPixel, (XrmValuePtr) &to); if (to.addr == NULL) return(-1); return((int) *((Pixel *) to.addr)); } /******************************************************************************** Name: Quit Description: Pops a widget with command buttons to select "Save", "Do NOT Save", and "Do NOT Quit" Arguements: w - Not used client_data - Not used call_data - Not used Returns: None ********************************************************************************/ static void Quit( Widget w, XtPointer client_data, XtPointer call_data) { XtTranslateCoords(quit, (Position) 0, (Position) 0, &x, &y); XtSetArg(args[0], XtNx, x-4); XtSetArg(args[1], XtNy, y-4); XtSetValues(QUIT, args, 2); XtPopup(QUIT, XtGrabNonexclusive); } /******************************************************************************** Name: Saveyes Description: Writes currently selected colors to "Xclips" and exits program or, if write error, calls ChooseFile for new path and filename Arguements: w - Not used client_data - Not used call_data - Not used Returns: None ********************************************************************************/ static void Saveyes( Widget w, XtPointer client_data, XtPointer call_data) { if ((f = fopen(filename, "w")) != NULL) { for (i = 0; i < NUMRES; i++) fprintf(f, "%s\t%s\n", resourcestring[i], resourcecolor[i]); fclose(f); XtDestroyApplicationContext(app_con); exit(1); } else { XtPopdown(QUIT); ChooseFile(); } } /******************************************************************************** Name: Saveno Description: Exits program without writing new colors Arguements: w - Not used client_data - Not used call_data - Not used Returns: None ********************************************************************************/ static void Saveno( Widget widget, XtPointer client_data, XtPointer call_data) { XtDestroyApplicationContext(app_con); exit(1); } /******************************************************************************** Name: Quitno Description: Pops down QUIT widget Arguements: w - Not used client_data - Not used call_data - Not used Returns: None ********************************************************************************/ static void Quitno( Widget widget, XtPointer client_data, XtPointer call_data) { XtPopdown(QUIT); } /******************************************************************************** Name: ChooseFile Description: If write error this pops a widget allowing a new path and filename to be selected Arguements: None Returns: None ********************************************************************************/ static void ChooseFile() { XtTranslateCoords(defaults, (Position) 0, (Position) 0, &x, &y); XtSetArg(args[0], XtNx, x); XtSetArg(args[1], XtNy, y); XtSetValues(filesave, args, 2); XtPopup(filesave, XtGrabNonexclusive); } /******************************************************************************** Name: NextSave Description: Saves colors to "Xclips" and exits the program or, if write error calls ChooseFile Arguements: w - Not used client_data - Not used call_data - Not used Returns: None ********************************************************************************/ static void NextSave( Widget w, XtPointer client_data, XtPointer call_data) { String filename = XawDialogGetValueString(file_dialog); if ((f = fopen(filename, "w")) != NULL) { for (i = 0; i < NUMRES; i++) fprintf(f, "%s\t%s\n", resourcestring[i], resourcecolor[i]); fclose(f); XtDestroyApplicationContext(app_con); exit(1); } else { XtPopdown(filesave); ChooseFile(); } } /******************************************************************************** Name: Cancel Description: Pops down a widget sent through client_data Arguements: w - Not used client_data - Widget to cancel call_data - Not used Returns: None ********************************************************************************/ static void Cancel( Widget w, XtPointer client_data, XtPointer call_data) { XtPopdown(XtParent((Widget) client_data)); } clips-6.24/x-prjct/color/colors.h0000755000175000017500000001045406544406074015104 0ustar jfsjfs#define MANAGER_BUTTON 0 #define BUTTON_BOX 1 #define MENU_BUTTON 2 #define DIALOG_WIN 3 #define FACTS_WIN 4 #define INSTANCES_WIN 5 #define GLOBALS_WIN 6 #define AGENDA_WIN 7 #define FOCUS_WIN 8 #define PULLDOWN_MENUS 9 #define MANAGERS 10 #define CONFIRMATION 11 #define FILE_WIN 12 #define WATCH_OPTIONS 13 #define WATCH_OPTION_BUTTONS 14 #define FOREGROUND 0 #define BACKGROUND 1 #define BORDER 2 #define NOT_AVAILABLE 3 static String items[] = { "aliceblue", "antiquewhite", "aquamarine1", "aquamarine2", "aquamarine3", "aquamarine4", "azure1", "azure2", "azure3", "azure4", "beige", "bisque1", "bisque2", "bisque3", "bisque4", "black", "blanchedalmond", "blueviolet", "blue1", "blue2", "blue3", "blue4", "brown", "brown1", "brown2", "brown3", "brown4", "burlywood", "burlywood1", "burlywood2", "burlywood3", "burlywood4", "cadetblue", "chartreuse1", "chartreuse2", "chartreuse3", "chartreuse4", "chocolate", "chocolate1", "chocolate2", "chocolate3", "chocolate4", "coral", "coral1", "coral2", "coral3", "coral4", "cornflowerblue", "cornsilk1", "cornsilk2", "cornsilk3", "cornsilk4", "cyan1", "cyan2", "cyan3", "cyan4", "darkgoldenrod", "darkgreen", "darkkhaki", "darkolivegreen", "darkorange", "darkorchid", "darksalmon", "darkseagreen", "darkslateblue", "darkslategray", "darkturquoise", "darkviolet", "firebrick", "firebrick1", "firebrick2", "firebrick3", "firebrick4", "floralwhite", "forestgreen", "gainsboro", "ghostwhite", "gold1", "gold2", "gold3", "gold4", "goldenrod", "goldenrod1", "goldenrod2", "goldenrod3", "goldenrod4", "gray", "gray1", "gray2", "gray3", "gray4", "gray5", "gray6", "gray7", "gray8", "gray9", "gray10", "gray11", "gray12", "gray13", "gray14", "gray15", "gray16", "gray17", "gray18", "gray19", "gray20", "gray21", "gray22", "gray23", "gray24", "gray25", "gray26", "gray27", "gray28", "gray29", "gray30", "gray31", "gray32", "gray33", "gray34", "gray35", "gray36", "gray37", "gray38", "gray39", "gray40", "gray41", "gray42", "gray43", "gray44", "gray45", "gray46", "gray47", "gray48", "gray49", "gray50", "gray51", "gray52", "gray53", "gray54", "gray55", "gray56", "gray57", "gray58", "gray59", "gray60", "gray61", "gray62", "gray63", "gray64", "gray65", "gray66", "gray67", "gray68", "gray69", "gray70", "gray71", "gray72", "gray73", "gray74", "gray75", "gray76", "gray77", "gray78", "gray79", "gray80", "gray81", "gray82", "gray83", "gray84", "gray85", "gray86", "gray87", "gray88", "gray89", "gray90", "gray91", "gray92", "gray93", "gray94", "gray95", "gray96", "gray97", "gray98", "gray99", "greenyellow", "green1", "green2", "green3", "green4", "honeydew1", "honeydew2", "honeydew3", "honeydew4", "hotpink", "indianred", "ivory1", "ivory2", "ivory3", "ivory4", "khaki", "khaki1", "khaki2", "khaki3", "khaki4", "lavender", "lawngreen", "lightblue", "lightcoral", "lightgoldenrod", "lightgoldenrodyellow", "lightgray", "lightpink", "lightseagreen", "lightskyblue", "lightslateblue", "lightslategray", "lightsteelblue", "lightyellow", "limegreen", "linen", "magenta1", "magenta2", "magenta3", "magenta4", "maroon", "maroon1", "maroon2", "maroon3", "maroon4", "mediumorchid", "mediumpurple", "mediumseagreen", "mediumslateblue", "mediumspringgreen", "mediumturquoise", "mediumvioletred", "midnightblue", "mintcream", "mistyrose", "moccasin", "navy", "oldlace", "olivedrab", "orangered", "orange1", "orange2", "orange3", "orange4", "orchid", "orchid1", "orchid2", "orchid3", "orchid4", "palegoldenrod", "palegreen", "paleturquoise", "palevioletred", "papayawhip", "pink", "pink1", "pink2", "pink3", "pink4", "plum", "plum1", "plum2", "plum3", "plum4", "powderblue", "purple", "purple1", "purple2", "purple3", "purple4", "red1", "red2", "red3", "red4", "rosybrown", "royalblue", "salmon", "salmon1", "salmon2", "salmon3", "salmon4", "sandybrown", "seashell1", "seashell2", "seashell3", "seashell4", "sienna", "sienna1", "sienna2", "sienna3", "sienna4", "skyblue", "slateblue", "slategray", "snow1", "snow2", "snow3", "snow4", "steelblue", "tan", "tan1", "tan2", "tan3", "tan4", "thistle", "thistle1", "thistle2", "thistle3", "thistle4", "tomato1", "tomato2", "tomato3", "tomato4", "turquoise", "turquoise1", "turquoise2", "turquoise3", "turquoise4", "violet", "violetred", "wheat", "wheat1", "wheat2", "wheat3", "wheat4", "white", "yellow1", "yellow2", "yellow3", "yellow4", NULL}; clips-6.24/clipssrc/0000755000175000017500000000000010444326200012522 5ustar jfsjfsclips-6.24/clipssrc/modulbsc.c0000755000175000017500000001470710177533450014524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* DEFMODULE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the defmodule */ /* construct such as clear, reset, save, ppdefmodule */ /* list-defmodules, and get-defmodule-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _MODULBSC_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include "constrct.h" #include "extnfunc.h" #include "modulbin.h" #include "prntutil.h" #include "modulcmp.h" #include "router.h" #include "argacces.h" #include "bload.h" #include "envrnmnt.h" #include "modulbsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ClearDefmodules(void *); #if DEFMODULE_CONSTRUCT static void SaveDefmodules(void *,void *,char *); #endif /*****************************************************************/ /* DefmoduleBasicCommands: Initializes basic defmodule commands. */ /*****************************************************************/ globle void DefmoduleBasicCommands( void *theEnv) { EnvAddClearFunction(theEnv,"defmodule",ClearDefmodules,2000); #if DEFMODULE_CONSTRUCT AddSaveFunction(theEnv,"defmodule",SaveDefmodules,1100); #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-defmodule-list",'m',PTIEF EnvGetDefmoduleList,"EnvGetDefmoduleList","00"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-defmodules",'v', PTIEF ListDefmodulesCommand,"ListDefmodulesCommand","00"); EnvDefineFunction2(theEnv,"ppdefmodule",'v',PTIEF PPDefmoduleCommand,"PPDefmoduleCommand","11w"); #endif #endif #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DefmoduleBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefmoduleCompilerSetup(theEnv); #endif } /*********************************************************/ /* ClearDefmodules: Defmodule clear routine for use with */ /* the clear command. Creates the MAIN module. */ /*********************************************************/ static void ClearDefmodules( void *theEnv) { #if (BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY) && (! RUN_TIME) if (Bloaded(theEnv) == TRUE) return; #endif #if (! RUN_TIME) RemoveAllDefmodules(theEnv); CreateMainModule(theEnv); DefmoduleData(theEnv)->MainModuleRedefinable = TRUE; #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } #if DEFMODULE_CONSTRUCT /******************************************/ /* SaveDefmodules: Defmodule save routine */ /* for use with the save command. */ /******************************************/ static void SaveDefmodules( void *theEnv, void *theModule, char *logicalName) { char *ppform; ppform = EnvGetDefmodulePPForm(theEnv,theModule); if (ppform != NULL) { PrintInChunks(theEnv,logicalName,ppform); EnvPrintRouter(theEnv,logicalName,"\n"); } } /*************************************************/ /* EnvGetDefmoduleList: H/L and C access routine */ /* for the get-defmodule-list function. */ /*************************************************/ globle void EnvGetDefmoduleList( void *theEnv, DATA_OBJECT_PTR returnValue) { OldGetConstructList(theEnv,returnValue,EnvGetNextDefmodule,EnvGetDefmoduleName); } #if DEBUGGING_FUNCTIONS /********************************************/ /* PPDefmoduleCommand: H/L access routine */ /* for the ppdefmodule command. */ /********************************************/ globle void PPDefmoduleCommand( void *theEnv) { char *defmoduleName; defmoduleName = GetConstructName(theEnv,"ppdefmodule","defmodule name"); if (defmoduleName == NULL) return; PPDefmodule(theEnv,defmoduleName,WDISPLAY); return; } /*************************************/ /* PPDefmodule: C access routine for */ /* the ppdefmodule command. */ /*************************************/ globle int PPDefmodule( void *theEnv, char *defmoduleName, char *logicalName) { void *defmodulePtr; defmodulePtr = EnvFindDefmodule(theEnv,defmoduleName); if (defmodulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",defmoduleName); return(FALSE); } if (EnvGetDefmodulePPForm(theEnv,defmodulePtr) == NULL) return(TRUE); PrintInChunks(theEnv,logicalName,EnvGetDefmodulePPForm(theEnv,defmodulePtr)); return(TRUE); } /***********************************************/ /* ListDefmodulesCommand: H/L access routine */ /* for the list-defmodules command. */ /***********************************************/ globle void ListDefmodulesCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"list-defmodules",EXACTLY,0) == -1) return; EnvListDefmodules(theEnv,WDISPLAY); } /***************************************/ /* EnvListDefmodules: C access routine */ /* for the list-defmodules command. */ /***************************************/ globle void EnvListDefmodules( void *theEnv, char *logicalName) { void *theModule; int count = 0; for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule)); EnvPrintRouter(theEnv,logicalName,"\n"); count++; } PrintTally(theEnv,logicalName,count,"defmodule","defmodules"); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFMODULE_CONSTRUCT */ clips-6.24/clipssrc/object.h0000755000175000017500000001274707416733016014173 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* OBJECT SYSTEM DEFINITIONS */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_object #define _H_object typedef struct defclassModule DEFCLASS_MODULE; typedef struct defclass DEFCLASS; typedef struct packedClassLinks PACKED_CLASS_LINKS; typedef struct classLink CLASS_LINK; typedef struct slotName SLOT_NAME; typedef struct slotDescriptor SLOT_DESC; typedef struct messageHandler HANDLER; typedef struct instance INSTANCE_TYPE; typedef struct instanceSlot INSTANCE_SLOT; /* Maximum # of simultaneous class hierarchy traversals should be a multiple of BITS_PER_BYTE and less than MAX_INT */ #define MAX_TRAVERSALS 256 #define TRAVERSAL_BYTES 32 /* (MAX_TRAVERSALS / BITS_PER_BYTE) */ #define VALUE_REQUIRED 0 #define VALUE_PROHIBITED 1 #define VALUE_NOT_REQUIRED 2 #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_multifld #include "multifld.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #define GetInstanceSlotLength(sp) GetMFLength(sp->value) struct packedClassLinks { unsigned short classCount; DEFCLASS **classArray; }; struct defclassModule { struct defmoduleItemHeader header; }; struct defclass { struct constructHeader header; unsigned installed : 1; unsigned system : 1; unsigned abstract : 1; unsigned reactive : 1; unsigned traceInstances : 1; unsigned traceSlots : 1; unsigned short id; unsigned busy, hashTableIndex; PACKED_CLASS_LINKS directSuperclasses, directSubclasses, allSuperclasses; SLOT_DESC *slots, **instanceTemplate; unsigned *slotNameMap; unsigned slotCount, localInstanceSlotCount, instanceSlotCount, maxSlotNameID; INSTANCE_TYPE *instanceList, *instanceListBottom; HANDLER *handlers; unsigned *handlerOrderMap; unsigned handlerCount; DEFCLASS *nxtHash; BITMAP_HN *scopeMap; char traversalRecord[TRAVERSAL_BYTES]; }; struct classLink { DEFCLASS *cls; struct classLink *nxt; }; struct slotName { unsigned hashTableIndex, use, id; SYMBOL_HN *name, *putHandlerName; struct slotName *nxt; long bsaveIndex; }; struct instanceSlot { SLOT_DESC *desc; unsigned valueRequired : 1; unsigned override : 1; unsigned type : 6; void *value; }; struct slotDescriptor { unsigned shared : 1; unsigned multiple : 1; unsigned composite : 1; unsigned noInherit : 1; unsigned noWrite : 1; unsigned initializeOnly : 1; unsigned dynamicDefault : 1; unsigned defaultSpecified : 1; unsigned noDefault : 1; unsigned reactive : 1; unsigned publicVisibility : 1; unsigned createReadAccessor : 1; unsigned createWriteAccessor : 1; unsigned overrideMessageSpecified : 1; DEFCLASS *cls; SLOT_NAME *slotName; SYMBOL_HN *overrideMessage; void *defaultValue; CONSTRAINT_RECORD *constraint; unsigned sharedCount; long bsaveIndex; INSTANCE_SLOT sharedValue; }; struct instance { struct patternEntity header; void *partialMatchList; INSTANCE_SLOT *basisSlots; unsigned installed : 1; unsigned garbage : 1; unsigned initSlotsCalled : 1; unsigned initializeInProgress : 1; unsigned reteSynchronized : 1; SYMBOL_HN *name; int depth; unsigned hashTableIndex; unsigned busy; DEFCLASS *cls; INSTANCE_TYPE *prvClass,*nxtClass, *prvHash,*nxtHash, *prvList,*nxtList; INSTANCE_SLOT **slotAddresses, *slots; }; struct messageHandler { unsigned system : 1; unsigned type : 2; unsigned mark : 1; unsigned trace : 1; unsigned busy; SYMBOL_HN *name; DEFCLASS *cls; int minParams, maxParams, localVarCount; EXPRESSION *actions; char *ppForm; struct userData *usrData; }; #endif clips-6.24/clipssrc/textpro.c0000755000175000017500000021047510443575746014433 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* TEXT PROCESSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* 6.23: Modified error messages so that they were */ /* directly printed rather than storing them in */ /* a string buffer which might not be large */ /* enough to contain the entire message. DR0855 */ /* Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added get-region function. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /*************************************************************/ /**************************************************************************/ /**************************************************************************/ /* LOOKUP TABLE FUNCTIONS */ /* */ /* The functions contained in this file set up and access a hierarchical */ /* lookup system for multiple files. */ /* */ /* For usage see external documentation. */ /**************************************************************************/ /**************************************************************************/ #define _TEXTPRO_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include "argacces.h" #include "commline.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "router.h" #include "sysdep.h" #include "textpro.h" #if TEXTPRO_FUNCTIONS || HELP_FUNCTIONS #define NAMESIZE 80 #define NULLCHAR '\0' #define BLANK (' ') #define TAB ('\t') #define LNFEED ('\n') /*=========================================================*/ /*Status returns for the file loading and lookup functions */ /*=========================================================*/ #define NORMAL 0 /*Entry information found in file */ #define NO_FILE -10 /*File not found for reference */ #define NEW_FILE -15 /*File loaded onto internal lookup table*/ #define OLD_FILE -20 /*File was already on the lookup table */ #define NO_TOPIC -25 /*No entry information was found in file*/ #define EXIT -30 /*Branch-up from root; exit lookup table*/ #define BRANCH_UP -35 /*Move up from subtopic entry to parent */ #define BRANCH_DOWN -40 /*Move down from main topic to subtopic */ /*=================*/ /*Entry data types */ /*=================*/ #define MENU -45 /*Entry has subtopics*/ #define INFO -50 /*Entry is a leaf; contains only information*/ /*==========================================*/ /*Entry node type for internal lookup table */ /*==========================================*/ struct entries { int level; /*Level of entry node in the lookup tree */ int type; /*Entry node data type : menu or info */ char name[NAMESIZE]; /*Entry node name */ long int offset; /*Location of entry info in the file */ struct entries *child; /*Address of list of subtopic entries */ struct entries *parent; /*Address of parent topic entry */ struct entries *next; /*Address of next entry at the same level */ }; /*=========================================*/ /*File node type for internal lookup table */ /*=========================================*/ struct lists { char file[NAMESIZE]; /*File name */ struct entries *topics; /*Address of list of entry topics for file */ struct entries *curr_menu; /*Address of current main topic in file */ struct lists *next; /*Address of next file in the table */ }; /*==================================================*/ /*Delimeter strings for marking entries in the file */ /*==================================================*/ #define BDELIM "BEGIN-ENTRY-" #define BDLEN 12 #define EDELIM "END-ENTRY" #define EDLEN 9 #define BFORMAT "%d%1s%12s%s" /*Format string for sscanf*/ #define LIT_DELIM ('$') #if IBM_TBC #define OPEN_READ "rb" #else #define OPEN_READ "r" #endif #define TEXTPRO_DATA 8 struct textProcessingData { struct lists *headings; struct entries *parent; #if HELP_FUNCTIONS int HELP_INIT; char *help_file; #endif }; #define TextProcessingData(theEnv) ((struct textProcessingData *) GetEnvironmentData(theEnv,TEXTPRO_DATA)) int TextLookupFetch(void *,char *); int TextLookupToss(void *,char *); static FILE *GetEntries(void *,char *,char **,char *,int *); static FILE *GetCurrentMenu(void *,char *,int *); static char *grab_string(void *,FILE *,char *,int); static int findstr(char *,char *); static void upper(char *); static struct lists *NewFetchFile(void *,char *); static struct entries *AllocateEntryNode(void *,FILE *,char *,char *,int); static int AttachLeaf(void *,struct lists *,struct entries *,FILE *,char *,int); static long LookupEntry(void *,char *,char **,char *,int *); static void TossFunction(void *,struct entries *); static void DeallocateTextProcessingData(void *); /******************************************************************************/ /*============================================================================*/ /* INTERNAL ROUTINES */ /*============================================================================*/ /******************************************************************************/ /****************************************************************************/ /*LOAD FUNCTION : */ /* Input : 1) name of file to be loaded into the lookup table */ /* 2) caller-allocated buffer to contain an error message (if any) */ /* 3) size of error message buffer */ /* Output : */ /* This function attempts to load the file's topic information into the */ /* lookup table according to the format below : */ /* */ /* BEGIN-ENTRY- */ /* . */ /* . */ /* Entry information in the form in which */ /* it is to be displayed when referenced. */ /* . */ /* . */ /* END-ENTRY */ /* */ /* The function returns the number of entries loaded if the entire file was */ /* was correctly formatted, else it returns -1. */ /****************************************************************************/ globle int TextLookupFetch( void *theEnv, char *file) { FILE *fp; /*Pointer into stream of input file */ char str[256]; /*Buffer for storing input file lines */ int INFO_BEGIN, INFO_END; /*Flags used to check proper syntax */ struct lists *lnode; /*Used to store file node in list */ struct entries *enode; /*Used to store entry node in topic list */ int line_ct; /*Line count - used for error messages */ int entries_ct; /*Number of entries successfully loaded. */ fp = GenOpen(theEnv,file,OPEN_READ); if (fp == NULL) { PrintErrorID(theEnv,"TEXTPRO",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Could not open file \""); EnvPrintRouter(theEnv,WERROR,file); EnvPrintRouter(theEnv,WERROR,"\".\n"); return(-1); } if ((lnode = NewFetchFile(theEnv,file)) == NULL) { GenClose(theEnv,fp); PrintErrorID(theEnv,"TEXTPRO",2,FALSE); EnvPrintRouter(theEnv,WERROR,"File \""); EnvPrintRouter(theEnv,WERROR,file); EnvPrintRouter(theEnv,WERROR,"\" already loaded.\n"); return(-1); } /*===========================*/ /*Store the file entry topics*/ /*===========================*/ line_ct = 0; entries_ct = 0; INFO_BEGIN = FALSE; INFO_END = TRUE; while (fgets(str,256,fp) != NULL) { line_ct++; /*=============================================================*/ /*Forces the load function to ignore lines beginning with `$$' */ /*=============================================================*/ if ((str[0] != LIT_DELIM) || (str[1] != LIT_DELIM)) { if (findstr(str,EDELIM) >= 0) { if (INFO_BEGIN == TRUE) { INFO_BEGIN = FALSE; INFO_END = TRUE; entries_ct++; } else { GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Unmatched end marker.\n"); return(-1); } } else if (findstr(str,BDELIM) >= 0) { if (INFO_END == TRUE) { INFO_END = FALSE; INFO_BEGIN = TRUE; } else { GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Previous entry not closed.\n"); return(-1); } if ((enode=AllocateEntryNode(theEnv,fp,file,str,line_ct))==NULL) return(-1); /*=================================*/ /*Store new entry node in the tree */ /*=================================*/ if (AttachLeaf(theEnv,lnode,enode,fp,file,line_ct) == FALSE) return(-1); } } } GenClose(theEnv,fp); if (INFO_END == FALSE) { TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Previous entry not closed.\n"); return(-1); } if (entries_ct == 0) TextLookupToss(theEnv,file); return(entries_ct); } /******************************************************************************/ /*FUNCTION UNLOAD : */ /* Input : 1) name of file to be taken off the lookup table */ /* Output : This functions deletes a file and all entry-topics associated with*/ /* it from the lookup table and returns a boolean flag indicating */ /* failure or success. */ /******************************************************************************/ globle int TextLookupToss( void *theEnv, char *file) { struct lists *plptr, *clptr; int l_flag; clptr = TextProcessingData(theEnv)->headings; plptr = clptr; if (clptr != NULL) if (strcmp(clptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; while (l_flag > 0) { plptr = clptr; clptr = clptr->next; if (clptr != NULL) if (strcmp(clptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; } if (clptr == NULL) return(FALSE); TossFunction(theEnv,clptr->topics); if (plptr == clptr) TextProcessingData(theEnv)->headings = clptr->next; else plptr->next = clptr->next; rm(theEnv,(void *) clptr,(int) sizeof(struct lists)); return(TRUE); } /******************************************************************************/ /*FUNCTION GET_ENTRIES : */ /* Input : 1) name of file to be accessed for lookup of entry */ /* 2) caller allocated buffer for main topic name */ /* 3) name of the entry to be accessed in the file */ /* 4) caller allocated buffer for a status code (see LOOKUP). */ /* Output : 1) returns a pointer into the stream of the lookup file which */ /* indicates the starting position of the lookup information */ /* (NULL if the topic was not found) */ /* This function passes its input directly to LOOKUP. See its description */ /* for further detail. */ /* */ /******************************************************************************/ static FILE *GetEntries( void *theEnv, char *file, char **menu, char *name, int *code) { FILE *fp; /*Lookup file stream*/ long int offset; /*Offset from beginning of file to beginning of topic*/ offset = LookupEntry(theEnv,file,menu,name,code); if (offset < 0) return(NULL); fp = GenOpen(theEnv,file,OPEN_READ); if (fp == NULL) { *code = NO_FILE; return(NULL); } if (fseek(fp,offset,0) < 0) { GenClose(theEnv,fp); *code = NO_FILE; return(NULL); } return(fp); } /******************************************************************************/ /*FUNCTION GET_CURR_MENU : */ /* Input : 1) name of file to be accessed */ /* 2) caller allocated buffer for the current menu name */ /* 3) caller allocated buffer for status code : NO_FILE, NO_TOPIC, or */ /* NORMAL. */ /* Output : 1) returns a pointer into the file stream indicating the beginning*/ /* of the description of the current menu for the named file */ /* (returns NULL if there is no current menu) */ /******************************************************************************/ static FILE *GetCurrentMenu( void *theEnv, char *file, int *status) { struct lists *lptr; /*Used in searching the file list*/ FILE *fp; /*File stream*/ int l_flag; /*Used in looping through the file list*/ /*=====================================*/ /*Find the named file in the file list */ /*=====================================*/ lptr = TextProcessingData(theEnv)->headings; if (lptr != NULL) if (strcmp(lptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; while (l_flag > 0) { lptr = lptr->next; if (lptr != NULL) if (strcmp(lptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; } if (lptr == NULL) { *status = NO_FILE; return(NULL); } /*============================================================*/ /*Position the pointer in the file stream to the current menu */ /*============================================================*/ if (lptr->curr_menu == NULL) { *status = NO_TOPIC; return(NULL); } if ((fp = GenOpen(theEnv,file,OPEN_READ)) == NULL) { *status = NO_FILE; return(NULL); } if (fseek(fp,lptr->curr_menu->offset,0) < 0) { GenClose(theEnv,fp); *status = NO_FILE; return(NULL); } *status = NORMAL; return(fp); } /******************************************************************************/ /*FUNCTION GRAB_STRING : */ /* Input : 1) file stream pointer */ /* 2) caller allocated buffer for storage of read string */ /* 3) size of caller's buffer */ /* Output : This function grabs a line of text from the currently opened */ /* lookup file at the given file position in the stream. If it */ /* encounters EOF or the closing topic delimeter, it closes the file */ /* and returns NULL. Otherwise, the return value is simply the */ /* address of the caller's buffer. */ /* */ /* Notes : 1) This function expects a file pointer into a stream of a file */ /* already opened!! */ /* 2) The caller must close the file himself if he wishes to */ /* prematurely abort the complete reading of an entry. */ /******************************************************************************/ static char *grab_string( void *theEnv, FILE *fp, char *buf, int bufsize) { if (fgets(buf,bufsize,fp) == NULL) { GenClose(theEnv,fp); return(NULL); } if ((buf[0] == LIT_DELIM) && (buf[1] == LIT_DELIM)) { buf[0] = BLANK; buf[1] = BLANK; } else if (findstr(buf,EDELIM) >= 0) { buf = NULL; GenClose(theEnv,fp); } return(buf); } /**************************************************************************/ /*FINDSTR FUNCTION : */ /* Input : 1) string to be searched */ /* 2) string to be found */ /* Output : 1) returns index of string-1 where string-2 started, if found */ /* 2) returns -1, if not found */ /**************************************************************************/ static int findstr( char *s, char *t) { int i,j,k; for (i = 0; s[i] != '\0'; i++) { for (j = i, k = 0; t[k] != '\0' && s[j] == t[k]; j++, k++) ; if ((t[k] == '\0') && (k != 0)) return(i); } return(-1); } /**********************************************************************/ /*UPPER FUNCTION : */ /* Input : 1) alphanumeric string */ /* Output : 1) all alphabetic characters of string are capitalized */ /**********************************************************************/ static void upper( char *str) { int theIndex; for (theIndex = 0 ; str[theIndex] != NULLCHAR; theIndex++) if (islower(str[theIndex])) str[theIndex] = (char) toupper(str[theIndex]); } /******************************************************************************/ /*FILE_NODE FUNCTION : */ /* Input : 1) name of a file */ /* Output : 1) returns address of an initalized NewFetchFile, if the file was */ /* not already on the lookup table */ /* 2) returns the null address, if the file was already present */ /******************************************************************************/ static struct lists *NewFetchFile( void *theEnv, char *file) { struct lists *lptr = NULL, *lnode; if (TextProcessingData(theEnv)->headings != NULL) { lptr = TextProcessingData(theEnv)->headings; while (lptr->next != NULL) { if (strcmp(lptr->file,file) == 0) return(NULL); lptr = lptr->next; } if (strcmp(lptr->file,file) == 0) return(NULL); } lnode = (struct lists *) gm2(theEnv,(int) sizeof(struct lists)); strcpy(lnode->file,file); lnode->topics = NULL; lnode->curr_menu = NULL; lnode->next = NULL; if (TextProcessingData(theEnv)->headings == NULL) TextProcessingData(theEnv)->headings = lnode; else lptr->next = lnode; return(lnode); } /******************************************************************************/ /*ENTRIES_NODE FUNCTION : */ /* Input : 1) file pointer */ /* 2) file name */ /* 3) input string from the file */ /* 4) buffer for error messages */ /* 5) size of the error message buffer */ /* 6) line count in the file */ /* Output : */ /*This function scans the input string for the appropriate topic entry */ /*delimeter and, if it finds this to be correct, allocates a new entry node, */ /*and initializes it, and returns the address to the calling routine. If an */ /*error is detected, the function writes an appropriate message to the */ /*caller's buffer, deallocates the node, deletes all previous nodes from the */ /*current file from the lookup table, closes the file, and returns the null */ /*address. */ /******************************************************************************/ static struct entries *AllocateEntryNode( void *theEnv, FILE *fp, char *file, char *str, int line_ct) { struct entries *enode; char bmarker[BDLEN+1], /*Entry topic delimiting strings */ t_code[2]; /*Type of entry flag : menu or info */ /*================================================================*/ /*Allocate a new node and scan the delimeter string for tree info */ /*================================================================*/ enode = (struct entries *) gm2(theEnv,(int) sizeof(struct entries)); if (sscanf(str,BFORMAT, &enode->level,t_code,bmarker,enode->name) != 4) { rm(theEnv,(void *) enode,(int) sizeof(struct entries)); GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Invalid delimeter string.\n"); return(NULL); } if (t_code[0] == 'M') enode->type = MENU; else if (t_code[0] == 'I') enode->type = INFO; else { rm(theEnv,(void *) enode,(int) sizeof(struct entries)); GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Invalid entry type.\n"); return(NULL); } if (strcmp(bmarker,BDELIM) != 0) { rm(theEnv,(void *) enode,(int) sizeof(struct entries)); GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Invalid delimeter string.\n"); return(NULL); } /*===============================================================*/ /* For systems which have record file systems (such as VMS), */ /* the following statement is necessary to move the file pointer */ /* to the beginning of the next record. */ /*===============================================================*/ ungetc(getc(fp),fp); enode->offset = ftell(fp); enode->parent = NULL; enode->child = NULL; enode->next = NULL; upper(enode->name); return(enode); } /******************************************************************************/ /*FUNCTION ATTACH_LEAF : */ /* Input : 1) address of current NewFetchFile */ /* 2) address of current topic entry-node */ /* 3) file pointer */ /* 4) name of file */ /* 5) error message buffer */ /* 6) size of error message buffer */ /* 7) line count in the file */ /* Output : */ /*This function attaches the entry-node to its proper place in the tree of the*/ /*current file. The function returns a boolean flag indicating the success */ /*(or lack thereof) of this connection. In the case of an error, an error */ /*message is written to the caller's buffer, the file is closed, and the */ /*previous file entries are deleted from the lookup table. */ /******************************************************************************/ static int AttachLeaf( void *theEnv, struct lists *lnode, struct entries *enode, FILE *fp, char *file, int line_ct) { int p_flag; /*Used in searching the tree for a parent*/ /*====================*/ /*First topic for file*/ /*====================*/ if (lnode->topics == NULL) lnode->topics = enode; /*================================*/ /*Subtopic - branch down the tree */ /*================================*/ else if (enode->level > TextProcessingData(theEnv)->parent->level) if (TextProcessingData(theEnv)->parent->type == MENU) { enode->parent = TextProcessingData(theEnv)->parent; TextProcessingData(theEnv)->parent->child = enode; } else { rm(theEnv,(void *) enode,(int) sizeof(struct entries)); GenClose(theEnv,fp); TextLookupToss(theEnv,file); PrintErrorID(theEnv,"TEXTPRO",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Line "); PrintLongInteger(theEnv,WERROR,line_ct); EnvPrintRouter(theEnv,WERROR," : Non-menu entries cannot have subtopics.\n"); return(FALSE); } /*====================================*/ /*Brother-topic -- same level in tree */ /*====================================*/ else if (enode->level == TextProcessingData(theEnv)->parent->level) { enode->parent = TextProcessingData(theEnv)->parent->parent; enode->next = TextProcessingData(theEnv)->parent->next; TextProcessingData(theEnv)->parent->next = enode; } /*==========================================================*/ /*Topic is unrelated to previous topic - branch up the tree */ /*==========================================================*/ else { if (TextProcessingData(theEnv)->parent != NULL) p_flag = 1; else p_flag = 0; while (p_flag > 0) { TextProcessingData(theEnv)->parent = TextProcessingData(theEnv)->parent->parent; if (TextProcessingData(theEnv)->parent != NULL) if (enode->level < TextProcessingData(theEnv)->parent->level) p_flag = 1; else p_flag = 0; else p_flag = 0; } if (TextProcessingData(theEnv)->parent != NULL) /*========*/ /*Subtopic*/ /*========*/ if (TextProcessingData(theEnv)->parent->level < enode->level) { enode->parent = TextProcessingData(theEnv)->parent; enode->next = TextProcessingData(theEnv)->parent->child; TextProcessingData(theEnv)->parent->child = enode; } /*=============*/ /*Brother-topic*/ /*=============*/ else { enode->parent = TextProcessingData(theEnv)->parent->parent; enode->next = TextProcessingData(theEnv)->parent->next; TextProcessingData(theEnv)->parent->next = enode; } /*=========*/ /*Root Node*/ /*=========*/ else { enode->parent = NULL; enode->next = lnode->topics; lnode->topics = enode; } } TextProcessingData(theEnv)->parent = enode; return(TRUE); } /******************************************************************************/ /*FUNCTION LOOKUP : */ /* Input : 1) name of entry-topic file to be used for reference */ /* 2) caller allocated buffer to contain the main topic name */ /* 3) name of the entry-topic to be found */ /* 4) caller allocated buffer to store the return status */ /* Output : 1) offset from the beginning of the entry-topic file stream to the*/ /* beginning of the requested topic (-1 if the topic not found) */ /* 2) status code stored in caller's buffer indicating the result of */ /* the lookup : NO_FILE, NO_TOPIC, BRANCH_UP, BRANCH_DOWN, EXIT, */ /* or NORMAL. */ /* */ /* Notes : 1) If NULL is given as an entry-topic, the lookup routine branches */ /* up one level in the tree (status BRANCH_UP). If the current */ /* level of the tree is already the root, all paths are set to NULL*/ /* (status EXIT). */ /* 2) If an entry-topic is not found, the file position of the current*/ /* main topic (or menu) is returned (status NO_TOPIC). */ /******************************************************************************/ static long int LookupEntry( void *theEnv, char *file, char **menu, char *name, int *code) { struct lists *lptr; /*Local pointers used to move through the tree*/ struct entries *eptr; int l_flag, e_flag; /*Flags used in looping to find entry-topics*/ /*===============================*/ /*Find named file in lookup list */ /*===============================*/ lptr = TextProcessingData(theEnv)->headings; if (lptr != NULL) if (strcmp(lptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; while (l_flag > 0) { lptr = lptr->next; if (lptr != NULL) if (strcmp(lptr->file,file) != 0) l_flag = 1; else l_flag = 0; else l_flag = 0; } if (lptr == NULL) { *code = NO_FILE; return(-1); } /*==================================================================*/ /*If entry-topic was NULL, branch up one-level in the tree, or exit */ /*the tree if already at the root. */ /*==================================================================*/ if (name == NULL) { if (lptr->curr_menu == NULL) { *code = EXIT; return(-1); } else { if (lptr->curr_menu->parent == NULL) { *code = EXIT; lptr->curr_menu = NULL; *menu = NULL; return(-1); } lptr->curr_menu = lptr->curr_menu->parent; *code = BRANCH_UP; *menu = lptr->curr_menu->name; return(lptr->curr_menu->offset); } } /*========================================*/ /*Find the topic in the file's topic tree */ /*========================================*/ upper(name); if (lptr->curr_menu != NULL) eptr = lptr->curr_menu->child; else eptr = lptr->topics; if (eptr != NULL) if (findstr(eptr->name,name) == 0) e_flag = 0; else e_flag = 1; else e_flag = 0; while (e_flag > 0) { eptr = eptr->next; if (eptr != NULL) if (findstr(eptr->name,name) == 0) e_flag = 0; else e_flag = 1; else e_flag = 0; } /*===================================================================*/ /*If the topic was not found, return the position of the current menu*/ /*===================================================================*/ if (eptr == NULL) { *code = NO_TOPIC; if (lptr->curr_menu != NULL) { *menu = lptr->curr_menu->name; return(lptr->curr_menu->offset); } return(-1); } /*===============================================================*/ /*If the requested topic has children, branch down to its level. */ /*===============================================================*/ if (eptr->type == MENU) { *code = BRANCH_DOWN; lptr->curr_menu = eptr; } else *code = NORMAL; if (lptr->curr_menu != NULL) *menu = lptr->curr_menu->name; return(eptr->offset); } /******************************************************************************/ /*FUNCTION TOSS : */ /* Input : 1) entry-topic address */ /* Output : This function recursively deletes a node and all child nodes */ /******************************************************************************/ static void TossFunction( void *theEnv, struct entries *eptr) { struct entries *prev; while (eptr != NULL) { if (eptr->child != NULL) TossFunction(theEnv,eptr->child); prev = eptr; eptr = eptr->next; rm(theEnv,(void *) prev,(int) sizeof(struct entries)); } } /****************************************************************************/ /****************************************************************************/ /* TEXT PROCESSING FUNCTIONS */ /* */ /* The functions contained in this file can be called to handle */ /* external file referencing and accessing. FetchCommand() loads a file */ /* onto an internal run-time lookup table, TossCommand() removes the file, */ /* PrintRegionCommand accesses the loaded file to display a requested */ /* entry, and HelpFunction() provides an on-line help facility */ /* using the external help data file specified in the header file setup.h. */ /* For information on the format of the data file(s) required, see the */ /* internal documentation in LOOKUP.C and the external documentation. */ /* */ /* For usage of these functions, see the external documentation. */ /****************************************************************************/ /****************************************************************************/ #define SCREEN_LN 22 /*Typical terminal screen length -- 22 lines*/ /*Used for scrolling in the help facility */ /*==========================================*/ /*Topic node for help facility's query list */ /*==========================================*/ struct topics { char name[NAMESIZE]; /*Name of the node */ struct topics *end_list; /*Pointer to end of query list */ struct topics *next; /*Pointer to next topic in the list*/ }; /******************************************************************************/ /*============================================================================*/ /* FUNCTION DECLARATIONS */ /*============================================================================*/ /******************************************************************************/ #if HELP_FUNCTIONS static int RecognizeHelpRouters(void *,char *); static int HelpPrint(void *,char *,char *); static int HelpGetc(void *,char *); static int HelpUngetc(void *,int,char *); static struct topics *AskForNewHelpTopic(void *,struct topics *,char **); #endif static struct topics *GetCommandLineTopics(void *); static FILE *FindTopicInEntries(void *,char *,struct topics *,char **,int *); /******************************************************************************/ /*============================================================================*/ /* EXTERNAL ACCESS FUNCTIONS */ /*============================================================================*/ /******************************************************************************/ /******************************************************************************/ /*FUNCTION HelpFunction : (H/L function help) */ /* Input : Multiple or no topic requests may be passed to the help facility */ /* from the top level via a "stack" accessed by the */ /* system routines num_args() and rstring(). */ /* Output : This function loads the help file specified in setup.h into a */ /* a hierarchical tree structure using the routines of LOOKUP.C. */ /* It then queries the user for topics, and, using the LOOKUP */ /* routines, branches through the tree, displaying information where */ /* appropriate. The function returns control once the user */ /* has indicated an exit from the help tree. */ /* */ /* For usage see external documentation. */ /******************************************************************************/ #if HELP_FUNCTIONS globle void HelpFunction( void *theEnv) { int status; /*Return code from the lookup routines */ FILE *fp; /*Pointer in to the help file stream */ struct topics *main_topic, /*Pointer to the first requested topic */ *tptr; /*Used in deallocating the topic list */ char buf[256], /*Buffer for storing input strings from the help file */ *menu[1]; /*Buffer for the name of the current main topic */ #if ! WINDOW_INTERFACE char termbuf[2]; /*Buffer for storing the terminators of a scroll */ int line_cnt; /*Line count used for scrolling purposes */ #endif if (TextProcessingData(theEnv)->HELP_INIT == FALSE) { if (TextProcessingData(theEnv)->help_file == NULL) { TextProcessingData(theEnv)->help_file = (char *) gm2(theEnv,strlen(HELP_DEFAULT) + 1); strcpy(TextProcessingData(theEnv)->help_file,HELP_DEFAULT); } EnvPrintRouter(theEnv,WDIALOG,"Loading help file entries from "); EnvPrintRouter(theEnv,WDIALOG,TextProcessingData(theEnv)->help_file); EnvPrintRouter(theEnv,WDIALOG,".\nPlease wait...\n"); status = TextLookupFetch(theEnv,TextProcessingData(theEnv)->help_file); if (status <= 0) { return; } else { /* ================================================================ Enables logical name "whelp" as the destination for all help I/O ================================================================ */ EnvAddRouter(theEnv,"whelp",10,RecognizeHelpRouters,HelpPrint, HelpGetc,HelpUngetc,NULL); TextProcessingData(theEnv)->HELP_INIT = TRUE; } } EnvActivateRouter(theEnv,"whelp"); /* ==================================================================== The root node of the help-tree is MAIN (see external documentation.) Add this node to the front of the initial topic request list given by the user on the top level command line. ==================================================================== */ main_topic = (struct topics *) gm2(theEnv,(int) sizeof(struct topics)); strcpy(main_topic->name,"MAIN"); main_topic->next = GetCommandLineTopics(theEnv); main_topic->end_list = NULL; EnvPrintRouter(theEnv,"whelp","\n"); /*============================*/ /*Process user topic requests */ /*============================*/ do { fp = FindTopicInEntries(theEnv,TextProcessingData(theEnv)->help_file,main_topic,menu,&status); if (status == NO_FILE) { PrintErrorID(theEnv,"TEXTPRO",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to access help file.\n"); break; } if (status == EXIT) break; if (status == NO_TOPIC) { if (fp == NULL) { /*===================================================*/ /*The lookup routines return the file location of the*/ /*current main topic if the requested topic is not */ /*found. The help-tree has one root: MAIN (see */ /*external docs). This topic should always be */ /*available. Thus, if the topic was not found and */ /*there is no current menu, the help-file has been */ /*tampered with and should be corrected. */ /*===================================================*/ EnvPrintRouter(theEnv,"whelp","Root entry \"MAIN\" not found in "); EnvPrintRouter(theEnv,"whelp",TextProcessingData(theEnv)->help_file); EnvPrintRouter(theEnv,"whelp",".\nSee external documentation.\n"); break; } EnvPrintRouter(theEnv,"whelp","\nSorry, no information available.\n\n"); } if (status != BRANCH_UP) { #if ! WINDOW_INTERFACE line_cnt = 0; #endif /*======================================================*/ /*Print lines from the information entry stopping after */ /*every screenful of lines. The user at that point has */ /*the option to continue or abort the entry to continue */ /*at the current menu level. */ /*======================================================*/ while (grab_string(theEnv,fp,buf,256) != NULL) { #if ! WINDOW_INTERFACE if (line_cnt >= (SCREEN_LN + 1)) { EnvPrintRouter(theEnv,"whelp","PRESS FOR MORE. "); EnvPrintRouter(theEnv,"whelp","PRESS , TO ABORT."); RouterData(theEnv)->CommandBufferInputCount = 0; do { termbuf[0] = (char) EnvGetcRouter(theEnv,"whelp"); if (termbuf[0] != LNFEED) { if (termbuf[0] == 'a') termbuf[0] = 'A'; if (termbuf[0] != '\b') RouterData(theEnv)->CommandBufferInputCount++; else if (RouterData(theEnv)->CommandBufferInputCount != 0) RouterData(theEnv)->CommandBufferInputCount--; termbuf[1] = (char) EnvGetcRouter(theEnv,"whelp"); } } while ((termbuf[0] != LNFEED) && (termbuf[0] != 'A')); RouterData(theEnv)->CommandBufferInputCount = -1; line_cnt = 0; if (termbuf[0] == 'A') { GenClose(theEnv,fp); break; } } line_cnt++; #endif EnvPrintRouter(theEnv,"whelp",buf); } } else if (fp != NULL) /*==========================================================*/ /*If the user branched-up the help-tree, don't reprint that */ /*menu. However, the help file still needs to be closed. */ /*==========================================================*/ GenClose(theEnv,fp); main_topic = AskForNewHelpTopic(theEnv,main_topic,menu); if (EvaluationData(theEnv)->HaltExecution) { while (status != EXIT) if ((fp = GetEntries(theEnv,TextProcessingData(theEnv)->help_file,menu,NULL,&status)) != NULL) GenClose(theEnv,fp); } } while (status != EXIT); EnvDeactivateRouter(theEnv,"whelp"); /*========================================================*/ /*Release any space used by the user's topic request list */ /*========================================================*/ while (main_topic != NULL) { tptr = main_topic; main_topic = main_topic->next; rm(theEnv,(void *) tptr,(int) sizeof(struct topics)); } } /***************************************************************************/ /*FUNCTION HelpPathFunction : (function help-path) */ /* Input : Via the argument "stack", the name of the new help entries */ /* file, or no input. */ /* Output : This function redefines the lookup file for the help facility. */ /* If no argument is given, it displays the current file name. */ /***************************************************************************/ globle void HelpPathFunction( void *theEnv) { char *help_name; DATA_OBJECT arg_ptr; if (EnvRtnArgCount(theEnv) == 0) { EnvPrintRouter(theEnv,WDIALOG,"The current help entries file is "); if (TextProcessingData(theEnv)->help_file != NULL) EnvPrintRouter(theEnv,WDIALOG,TextProcessingData(theEnv)->help_file); else EnvPrintRouter(theEnv,WDIALOG,HELP_DEFAULT); EnvPrintRouter(theEnv,WDIALOG,"\n"); } else { if (TextProcessingData(theEnv)->help_file != NULL) { if (TextProcessingData(theEnv)->HELP_INIT == TRUE) { EnvPrintRouter(theEnv,WDIALOG,"Releasing help entries from file "); EnvPrintRouter(theEnv,WDIALOG,TextProcessingData(theEnv)->help_file); EnvPrintRouter(theEnv,WDIALOG,"...\n"); TextLookupToss(theEnv,TextProcessingData(theEnv)->help_file); EnvDeleteRouter(theEnv,"whelp"); TextProcessingData(theEnv)->HELP_INIT = FALSE; } rm(theEnv,(void *) TextProcessingData(theEnv)->help_file,strlen(TextProcessingData(theEnv)->help_file) + 1); } if (EnvArgTypeCheck(theEnv,"help-path",1,SYMBOL_OR_STRING,&arg_ptr) == FALSE) return; help_name = DOToString(arg_ptr); TextProcessingData(theEnv)->help_file = (char *) gm2(theEnv,strlen(help_name) + 1); strcpy(TextProcessingData(theEnv)->help_file,help_name); EnvPrintRouter(theEnv,WDIALOG,"Help entries file reset to "); EnvPrintRouter(theEnv,WDIALOG,help_name); EnvPrintRouter(theEnv,WDIALOG,"\n"); } } #endif #if TEXTPRO_FUNCTIONS /***************************************************************************/ /*FUNCTION FetchCommand : (H/L function fetch) */ /* Input : Name of the file to be stored in the lookup table - passed via */ /* the argument "stack" and result buffer */ /* Output : This function loads a file into the internal lookup table and */ /* returns a (float) boolean flag indicating failure or success. */ /***************************************************************************/ globle void FetchCommand( void *theEnv, DATA_OBJECT *result) { int load_ct; /*Number of entries loaded */ DATA_OBJECT arg_ptr; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"fetch",1,SYMBOL_OR_STRING,&arg_ptr) == FALSE) return; load_ct = TextLookupFetch(theEnv,DOToString(arg_ptr)); if (load_ct <= 0) { if (load_ct == 0) { PrintErrorID(theEnv,"TEXTPRO",3,FALSE); EnvPrintRouter(theEnv,WERROR,"No entries found.\n"); } return; } result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,(long) load_ct); } /******************************************************************************/ /*FUNCTION PrintRegionCommand : (H/L function print-region) */ /* Input : Via the argument "stack", logical name for the output, the name of the */ /* file to be accessed, and the name of the topic(s) to be looked up. */ /* Output : This function accesses a previously loaded file and prints the */ /* information of the topic entry requested to the screen. The tree */ /* structure must currently be at the correct level in order for the */ /* topic to be accessed. To branch down the tree, each topic in the */ /* path to the one desired must be named. Multiple arguments are */ /* allowed as in the help facility (see the external documentation.) */ /* To branch up the tree, the special topic character `^' must be */ /* specified for each upwards branch. Giving no topic name will */ /* cause a single branch-up in the tree. The `?' character given at */ /* the end of a path will return the current main topic menu. */ /* */ /* For usage, see the external documentation. */ /******************************************************************************/ globle int PrintRegionCommand( void *theEnv) { struct topics *params, /*Lookup file and list of topic requests */ *tptr; /*Used in deallocating the parameter list */ char buf[256]; /*Buffer for the topic entry strings */ FILE *fp; /*Stream for the input file */ char *menu[1]; /*Buffer for the current menu name */ int status, /*Lookup status return code */ com_code; /*Completion flag */ params = GetCommandLineTopics(theEnv); fp = FindTopicInEntries(theEnv,params->next->name,params->next->next,menu,&status); if ((status != NO_FILE) && (status != NO_TOPIC) && (status != EXIT)) { if (strcmp(params->name,"t") == 0) strcpy(params->name,"stdout"); EnvPrintRouter(theEnv,params->name,"\n"); while (grab_string(theEnv,fp,buf,256) != NULL) EnvPrintRouter(theEnv,params->name,buf); com_code = TRUE; } else { /* ================================================================== On NO_TOPIC results, the file is left open to point to the current menu. This used as a check by the Help System. In the case of print-region, however, we need to always make sure the file is closed. ================================================================== */ if (fp != NULL) GenClose(theEnv,fp); com_code = FALSE; } /* ======================================================= Release any space used by the user's topic request list ======================================================= */ while (params != NULL) { tptr = params; params = params->next; rm(theEnv,(void *) tptr,(int) sizeof(struct topics)); } return(com_code); } /******************************************************************************/ /*FUNCTION GetRegionCommand : (H/L functionget-region) */ /******************************************************************************/ globle void *GetRegionCommand( void *theEnv) { struct topics *params, /*Lookup file and list of topic requests */ *tptr; /*Used in deallocating the parameter list */ char buf[256]; /*Buffer for the topic entry strings */ FILE *fp; /*Stream for the input file */ char *menu[1]; /*Buffer for the current menu name */ int status; /*Lookup status return code */ char *theString = NULL; void *theResult; int oldPos = 0; unsigned oldMax = 0; unsigned sLength; params = GetCommandLineTopics(theEnv); fp = FindTopicInEntries(theEnv,params->name,params->next,menu,&status); if ((status != NO_FILE) && (status != NO_TOPIC) && (status != EXIT)) { while (grab_string(theEnv,fp,buf,256) != NULL) theString = AppendToString(theEnv,buf,theString,&oldPos,&oldMax); } else { /* ================================================================== On NO_TOPIC results, the file is left open to point to the current menu. This used as a check by the Help System. In the case of print-region, however, we need to always make sure the file is closed. ================================================================== */ if (fp != NULL) GenClose(theEnv,fp); } /* ======================================================= Release any space used by the user's topic request list ======================================================= */ while (params != NULL) { tptr = params; params = params->next; rm(theEnv,(void *) tptr,(int) sizeof(struct topics)); } if (theString == NULL) { theResult = EnvAddSymbol(theEnv,""); } else { sLength = strlen(theString); if ((sLength > 0) && (((theString[sLength-1] == '\r') && (theString[sLength-2] == '\n')) || ((theString[sLength-1] == '\n') && (theString[sLength-2] == '\r')))) { theString[sLength-2] = 0; } theResult = EnvAddSymbol(theEnv,theString); } if (theString != NULL) { genfree(theEnv,theString,oldMax); } return(theResult); } /***************************************************************************/ /*FUNCTION TossCommand : (H/L function toss) */ /* Input : Name of the file to be deleted from the lookup table (passed via*/ /* the argument "stack") */ /* Output : This function deletes the named file from the lookup table and */ /* returns a (float) boolean flag indicating failure or success. */ /***************************************************************************/ globle int TossCommand( void *theEnv) { char *file; /*Name of the file */ DATA_OBJECT arg_ptr; if (EnvArgTypeCheck(theEnv,"toss",1,SYMBOL_OR_STRING,&arg_ptr) == FALSE) return (FALSE); file = DOToString(arg_ptr); #if HELP_FUNCTIONS if (TextProcessingData(theEnv)->help_file != NULL) if ((strcmp(file,TextProcessingData(theEnv)->help_file) == 0) && (TextProcessingData(theEnv)->HELP_INIT == TRUE)) { rm(theEnv,(void *) TextProcessingData(theEnv)->help_file,strlen(TextProcessingData(theEnv)->help_file) + 1); TextProcessingData(theEnv)->help_file = NULL; TextProcessingData(theEnv)->HELP_INIT = FALSE; EnvDeleteRouter(theEnv,"whelp"); } #endif return(TextLookupToss(theEnv,file)); } #endif /******************************************************************************/ /* The following four functions are the router routines for the logical name */ /* "whelp". Currently, all they do is direct all accesses to standard I/O. */ /******************************************************************************/ #if HELP_FUNCTIONS #if IBM_TBC #pragma argsused #endif static int RecognizeHelpRouters( void *theEnv, char *log_name) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (strcmp(log_name,"whelp") == 0) return(TRUE); return(FALSE); } #if IBM_TBC #pragma argsused #endif static int HelpPrint( void *theEnv, char *log_name, char *str) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(log_name) #endif EnvPrintRouter(theEnv,"stdout",str); return(1); } #if IBM_TBC #pragma argsused #endif static int HelpGetc( void *theEnv, char *log_name) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(log_name) #endif return(EnvGetcRouter(theEnv,"stdin")); } #if IBM_TBC #pragma argsused #endif static int HelpUngetc( void *theEnv, int ch, char *log_name) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(log_name) #endif return(EnvUngetcRouter(theEnv,ch,"stdin")); } #endif /******************************************************************************/ /*============================================================================*/ /* INTERNAL ROUTINES */ /*============================================================================*/ /******************************************************************************/ /******************************************************************************/ /*FUNCTION CMD_LINE_TOPICS : */ /* Input : None */ /* Output : This function builds a linked list of topics requested by the */ /* user at the H/L level using the argument "stack" routines, */ /* num_args() and rstring(). It returns the address of the top of */ /* the list or NULL if there were no command line topics. */ /******************************************************************************/ static struct topics *GetCommandLineTopics( void *theEnv) { int topic_num, /*Number of topics specified by the user */ theIndex; /*Used to loop through the topic list */ struct topics *head, /*Address of the top of the topic list */ *tnode, /*Address of new topic node */ *tptr; /*Used to attach new node to the list */ DATA_OBJECT val; /*Unknown-type H/L data structure */ head = NULL; topic_num = EnvRtnArgCount(theEnv); for (theIndex = 1; theIndex <= topic_num; theIndex++) { tnode = (struct topics *) gm2(theEnv,(int) sizeof(struct topics)); EnvRtnUnknown(theEnv,theIndex,&val); if ((GetType(val) == SYMBOL) || (GetType(val) == STRING)) strncpy(tnode->name,DOToString(val),NAMESIZE-1); else if (GetType(val) == FLOAT) strncpy(tnode->name,FloatToString(theEnv,DOToDouble(val)),NAMESIZE-1); else if (GetType(val) == INTEGER) strncpy(tnode->name,LongIntegerToString(theEnv,DOToLong(val)),NAMESIZE-1); else strncpy(tnode->name,"***ERROR***",NAMESIZE-1); tnode->next = NULL; tnode->end_list = NULL; if (head == NULL) head = tnode; else { tptr = head; while (tptr->next != NULL) tptr = tptr->next; tptr->next = tnode; } } return(head); } /******************************************************************************/ /*FUNCTION QUERY_TOPIC : */ /* Input : 1) The address of the old topic list (this routines writes over */ /* previously allocated memory, if available) */ /* 2) A buffer holding the name of the current menu in the tree */ /* Output : This function prompts the user for a new set of topic(s) and */ /* displays the name of the current menu. Each new topic is */ /* delineated by white-space, and this function builds a linked list */ /* of these topics. It returns the address of the top of this list. */ /******************************************************************************/ #if HELP_FUNCTIONS static struct topics *AskForNewHelpTopic( void *theEnv, struct topics *old_list, char **menu) { int theIndex, cnt; /*Indices of the user input buffer and topic name */ struct topics *tmain, /*Address of the top of the topic list */ *tnode, /*Address of the new topic node */ *tptr; /*Used to add the new node to the topic list */ char list[256], /*User input buffer */ name[NAMESIZE]; /*Name of the new topic in the list */ /*==================================================================*/ /*Read a line of input from the user (substituting blanks for tabs) */ /*==================================================================*/ EnvPrintRouter(theEnv,"whelp",*menu); EnvPrintRouter(theEnv,"whelp"," Topic? "); RouterData(theEnv)->CommandBufferInputCount = 0; for ( theIndex = 0; ((list[theIndex] = (char) EnvGetcRouter(theEnv,"whelp")) != LNFEED) && (theIndex < 254); theIndex++ , RouterData(theEnv)->CommandBufferInputCount++) { if (EvaluationData(theEnv)->HaltExecution) break; if (list[theIndex] == TAB) list[theIndex] = BLANK; else if ((list[theIndex] == '\b') && (theIndex != 0)) { theIndex -= 2; RouterData(theEnv)->CommandBufferInputCount -= 2; } } #if VAX_VMS EnvPrintRouter(theEnv,"whelp","\n"); #endif RouterData(theEnv)->CommandBufferInputCount = -1; if (EvaluationData(theEnv)->HaltExecution) { EnvPrintRouter(theEnv,"whelp","\n"); old_list->end_list = old_list; return(old_list); } list[theIndex] = BLANK; list[theIndex+1] = NULLCHAR; /*=======================================*/ /*Parse user buffer into separate topics */ /*=======================================*/ tmain = old_list; theIndex = 0; cnt = 0; while (list[theIndex] != NULLCHAR) { if ((list[theIndex] != BLANK) && (cnt < NAMESIZE)) name[cnt++] = list[theIndex++]; else if (cnt > 0) { while ((list[theIndex] != BLANK) && (list[theIndex] != NULLCHAR)) theIndex++; name[cnt] = NULLCHAR; cnt = 0; /*==============================================*/ /*Write over previous topic lists, if available */ /*==============================================*/ if (old_list != NULL) { strcpy(old_list->name,name); old_list = old_list->next; } else { tnode = (struct topics *) gm2(theEnv,(int) sizeof(struct topics)); strcpy(tnode->name,name); tnode->next = NULL; tnode->end_list = NULL; if (tmain == NULL) tmain = tnode; else { tptr = tmain; while (tptr->next != NULL) tptr = tptr->next; tptr->next = tnode; } } } else theIndex++; } /*========================================================================*/ /*If the new list is shorter than the previous one, we must mark the end. */ /*========================================================================*/ tmain->end_list = old_list; return(tmain); } #endif /******************************************************************************/ /*FUNCTION FIND_TOPIC : */ /* Input : 1) File to be searched for topic request */ /* 2) Address of topic request list */ /* 3) Buffer for current menu name */ /* 4) Lookup status return code */ /* Output : This function flows through the user topic request path by */ /* calling the lookup routines. When it reaches the last element, */ /* it returns a pointer into the stream of the lookup file */ /* indicating the beginning of the topic entry. If any topic in the */ /* path is not found, the function aborts and returns the address of */ /* of the current menu in the lookup tree for the file. The exact */ /* nature of the final lookup is indicated in the status buffer. */ /******************************************************************************/ static FILE *FindTopicInEntries( void *theEnv, char *file, struct topics *main_topic, char **menu, int *status) { FILE *fp = NULL; /*Input file stream */ struct topics *tptr, /*Used to loop through the topic list */ *end_list; /*Address of the end of the topic list */ if (main_topic != NULL) end_list = main_topic->end_list; else end_list = NULL; tptr = main_topic; if (tptr != end_list) do { if (fp != NULL) GenClose(theEnv,fp); /*======================*/ /*Branch up in the tree */ /*======================*/ if (strcmp(tptr->name,"^") == 0) fp = GetEntries(theEnv,file,menu,NULL,status); /*=======================================================*/ /*Return the current main topic menu of the lookup table */ /*=======================================================*/ else if ((strcmp(tptr->name,"?") == 0) && (tptr->next == end_list)) fp = GetCurrentMenu(theEnv,file,status); /*=====================*/ /*Lookup topic request */ /*=====================*/ else fp = GetEntries(theEnv,file,menu,tptr->name,status); if ((*status == NO_FILE) || (*status == NO_TOPIC)) break; tptr = tptr->next; } while (tptr != end_list); else /*==================================================================*/ /*An empty topic request list causes a single branch-up in the tree */ /*==================================================================*/ fp = GetEntries(theEnv,file,menu,NULL,status); return(fp); } /*******************************************/ /* HelpFunctionDefinitions: */ /*******************************************/ globle void HelpFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,TEXTPRO_DATA,sizeof(struct textProcessingData),DeallocateTextProcessingData); #if ! RUN_TIME #if HELP_FUNCTIONS EnvDefineFunction2(theEnv,"help",'v',PTIEF HelpFunction,"HelpFunction",NULL); EnvDefineFunction2(theEnv,"help-path",'v',PTIEF HelpPathFunction,"HelpPathFunction","*1k"); #endif #if TEXTPRO_FUNCTIONS EnvDefineFunction2(theEnv,"fetch",'u', PTIEF FetchCommand,"FetchCommand","11k"); EnvDefineFunction2(theEnv,"toss",'b', PTIEF TossCommand,"TossCommand","11k"); EnvDefineFunction2(theEnv,"print-region",'b', PTIEF PrintRegionCommand,"PrintRegionCommand","2**wk"); EnvDefineFunction2(theEnv,"get-region",'s', PTIEF GetRegionCommand,"GetRegionCommand","1**k"); #endif #endif } /*********************************************************/ /* DeallocateTextProcessingData: Deallocates environment */ /* data for text processing routines. */ /*********************************************************/ static void DeallocateTextProcessingData( void *theEnv) { struct lists *nextptr, *clptr; clptr = TextProcessingData(theEnv)->headings; while (clptr != NULL) { nextptr = clptr->next; TossFunction(theEnv,clptr->topics); rm(theEnv,(void *) clptr,(int) sizeof(struct lists)); clptr = nextptr; } #if HELP_FUNCTIONS if (TextProcessingData(theEnv)->help_file != NULL) { rm(theEnv,TextProcessingData(theEnv)->help_file, strlen(TextProcessingData(theEnv)->help_file) + 1); } #endif } #endif clips-6.24/clipssrc/scanner.h0000755000175000017500000000433407422634745014355 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* SCANNER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for scanning lexical tokens from an */ /* input source. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_scanner #define _H_scanner struct token; #ifndef _H_pprint #include "pprint.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _SCANNER_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct token { unsigned short type; void *value; char *printForm; }; #define SCANNER_DATA 57 struct scannerData { char *GlobalString; unsigned GlobalMax; int GlobalPos; long LineCount; int IgnoreCompletionErrors; }; #define ScannerData(theEnv) ((struct scannerData *) GetEnvironmentData(theEnv,SCANNER_DATA)) LOCALE void InitializeScannerData(void *); LOCALE void GetToken(void *,char *,struct token *); LOCALE void CopyToken(struct token *,struct token *); LOCALE void ResetLineCount(void *); LOCALE long GetLineCount(void *); LOCALE void IncrementLineCount(void *); LOCALE void DecrementLineCount(void *); #endif clips-6.24/clipssrc/._moduldef.c0000400000175000017500000000075410441150014014671 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco;;:<llTTFS FMWBBMPSRclips-6.24/clipssrc/._insmult.c0000400000175000017500000000075410441147571014603 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z9TTFS FMWBBMPSRclips-6.24/clipssrc/userdata.h0000755000175000017500000000464707422634713014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* USER DATA HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for attaching user data to constructs, */ /* facts, instances, user functions, etc. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_userdata #define _H_userdata #ifdef LOCALE #undef LOCALE #endif #ifdef _USERDATA_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct userData { unsigned char dataID; struct userData *next; }; typedef struct userData USER_DATA; typedef struct userData * USER_DATA_PTR; struct userDataRecord { unsigned char dataID; void *(*createUserData)(void *); void (*deleteUserData)(void *,void *); }; typedef struct userDataRecord USER_DATA_RECORD; typedef struct userDataRecord * USER_DATA_RECORD_PTR; #define MAXIMUM_USER_DATA_RECORDS 100 #define USER_DATA_DATA 56 struct userDataData { struct userDataRecord *UserDataRecordArray[MAXIMUM_USER_DATA_RECORDS]; unsigned char UserDataRecordCount; }; #define UserDataData(theEnv) ((struct userDataData *) GetEnvironmentData(theEnv,USER_DATA_DATA)) LOCALE void InitializeUserDataData(void *); LOCALE unsigned char InstallUserDataRecord(void *,struct userDataRecord *); LOCALE struct userData *FetchUserData(void *,unsigned char,struct userData **); LOCALE struct userData *TestUserData(unsigned char,struct userData *); LOCALE void ClearUserDataList(void *,struct userData *); LOCALE struct userData *DeleteUserData(void *,unsigned char,struct userData *); #endif clips-6.24/clipssrc/crstrtgy.c0000755000175000017500000007647310441065231014574 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* CONFLICT RESOLUTION STRATEGY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Used to determine where a new activation is */ /* placed on the agenda based on the current conflict */ /* resolution strategy (depth, breadth, mea, lex, */ /* simplicity, or complexity). Also provides the */ /* set-strategy and get-strategy commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* compilation flag. */ /* */ /*************************************************************/ #define _CRSTRTGY_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "constant.h" #include "pattern.h" #include "reteutil.h" #include "argacces.h" #include "agenda.h" #include "envrnmnt.h" #include "crstrtgy.h" #define GetMatchingItem(x,i) (x->basis->binds[i].gm.theMatch->matchingItem) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static ACTIVATION *PlaceDepthActivation(ACTIVATION *,ACTIVATION *); static ACTIVATION *PlaceBreadthActivation(ACTIVATION *,ACTIVATION *); static ACTIVATION *PlaceLEXActivation(void *,ACTIVATION *,ACTIVATION *); static ACTIVATION *PlaceMEAActivation(void *,ACTIVATION *,ACTIVATION *); static ACTIVATION *PlaceComplexityActivation(ACTIVATION *,ACTIVATION *); static ACTIVATION *PlaceSimplicityActivation(ACTIVATION *,ACTIVATION *); static ACTIVATION *PlaceRandomActivation(ACTIVATION *,ACTIVATION *); static struct partialMatch *SortPartialMatch(void *,struct partialMatch *); static int ComparePartialMatches(void *,ACTIVATION *,ACTIVATION *); static char *GetStrategyName(int); /******************************************************************/ /* PlaceActivation: Coordinates placement of an activation on the */ /* Agenda based on the current conflict resolution strategy. */ /******************************************************************/ globle void PlaceActivation( void *theEnv, ACTIVATION **whichAgenda, ACTIVATION *newActivation) { ACTIVATION *placeAfter = NULL; /*================================================*/ /* Set the flag which indicates that a change has */ /* been made to the agenda. */ /*================================================*/ EnvSetAgendaChanged(theEnv,TRUE); /*=============================================*/ /* Determine the location where the activation */ /* should be placed in the agenda based on the */ /* current conflict resolution strategy. */ /*==============================================*/ if (*whichAgenda != NULL) switch (AgendaData(theEnv)->Strategy) { case DEPTH_STRATEGY: placeAfter = PlaceDepthActivation(*whichAgenda,newActivation); break; case BREADTH_STRATEGY: placeAfter = PlaceBreadthActivation(*whichAgenda,newActivation); break; case LEX_STRATEGY: placeAfter = PlaceLEXActivation(theEnv,*whichAgenda,newActivation); break; case MEA_STRATEGY: placeAfter = PlaceMEAActivation(theEnv,*whichAgenda,newActivation); break; case COMPLEXITY_STRATEGY: placeAfter = PlaceComplexityActivation(*whichAgenda,newActivation); break; case SIMPLICITY_STRATEGY: placeAfter = PlaceSimplicityActivation(*whichAgenda,newActivation); break; case RANDOM_STRATEGY: placeAfter = PlaceRandomActivation(*whichAgenda,newActivation); break; } /*==============================================================*/ /* Place the activation at the appropriate place in the agenda. */ /*==============================================================*/ if (placeAfter == NULL) /* then place it at the beginning of then agenda. */ { newActivation->next = *whichAgenda; *whichAgenda = newActivation; if (newActivation->next != NULL) newActivation->next->prev = newActivation; } else /* insert it in the agenda. */ { newActivation->next = placeAfter->next; newActivation->prev = placeAfter; placeAfter->next = newActivation; if (newActivation->next != NULL) { newActivation->next->prev = newActivation; } } } /*******************************************************************/ /* PlaceDepthActivation: Determines the location in the agenda */ /* where a new activation should be placed for the depth */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceDepthActivation( ACTIVATION *actPtr, ACTIVATION *newActivation) { int salience; unsigned long timetag; ACTIVATION *lastAct; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ salience = newActivation->salience; timetag = newActivation->timetag; lastAct = NULL; /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the activation is placed before */ /* activations with an equal or lower timetag (yielding */ /* depth first traversal). */ /*=========================================================*/ while (actPtr != NULL) { if (actPtr->salience > salience) { lastAct = actPtr; actPtr = actPtr->next; } else if (actPtr->salience < salience) { return(lastAct); } else if (timetag < actPtr->timetag) { lastAct = actPtr; actPtr = actPtr->next; } else { return(lastAct); } } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*******************************************************************/ /* PlaceBreadthActivation: Determines the location in the agenda */ /* where a new activation should be placed for the breadth */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceBreadthActivation( ACTIVATION *actPtr, ACTIVATION *newActivation) { int salience; unsigned long timetag; ACTIVATION *lastAct; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ salience = newActivation->salience; timetag = newActivation->timetag; lastAct = NULL; /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the activation is placed after */ /* activations with a lessor timetag (yielding breadth */ /* first traversal). */ /*=========================================================*/ while (actPtr != NULL) { if (actPtr->salience > salience) { lastAct = actPtr; actPtr = actPtr->next; } else if (actPtr->salience < salience) { return(lastAct); } else if (timetag > actPtr->timetag) { lastAct = actPtr; actPtr = actPtr->next; } else { return(lastAct); } } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*******************************************************************/ /* PlaceLEXActivation: Determines the location in the agenda */ /* where a new activation should be placed for the lex */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceLEXActivation( void *theEnv, ACTIVATION *actPtr, ACTIVATION *newActivation) { int salience; unsigned long timetag; ACTIVATION *lastAct; int flag; /*===============================================*/ /* Sort the fact identifiers for the activation. */ /*===============================================*/ if (newActivation->sortedBasis == NULL) { newActivation->sortedBasis = SortPartialMatch(theEnv,newActivation->basis); } /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; salience = newActivation->salience; lastAct = NULL; /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the OPS5 lex strategy is used for */ /* determining placement. */ /*=========================================================*/ while (actPtr != NULL) { if (actPtr->salience > salience) { lastAct = actPtr; actPtr = actPtr->next; } else if (actPtr->salience < salience) { return(lastAct); } else { flag = ComparePartialMatches(theEnv,actPtr,newActivation); if (flag == LESS_THAN) { lastAct = actPtr; actPtr = actPtr->next; } else if (flag == GREATER_THAN) { return(lastAct); } else /* flag == EQUAL */ { if (timetag > actPtr->timetag) { lastAct = actPtr; actPtr = actPtr->next; } else { return(lastAct); } } } } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*******************************************************************/ /* PlaceMEAActivation: Determines the location in the agenda */ /* where a new activation should be placed for the mea */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceMEAActivation( void *theEnv, ACTIVATION *actPtr, ACTIVATION *newActivation) { int salience; unsigned long timetag; ACTIVATION *lastAct; int flag; long int cWhoset, oWhoset; if (newActivation->sortedBasis == NULL) { newActivation->sortedBasis = SortPartialMatch(theEnv,newActivation->basis); } /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; salience = newActivation->salience; lastAct = NULL; /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the OPS5 mea strategy is used for */ /* determining placement. */ /*=========================================================*/ while (actPtr != NULL) { if (actPtr->salience > salience) { lastAct = actPtr; actPtr = actPtr->next; } else if (actPtr->salience < salience) { return(lastAct); } else { cWhoset = -1; oWhoset = -1; if (GetMatchingItem(newActivation,0) != NULL) { cWhoset = GetMatchingItem(newActivation,0)->timeTag; } if (GetMatchingItem(actPtr,0) != NULL) { oWhoset = GetMatchingItem(actPtr,0)->timeTag; } if (oWhoset < cWhoset) { if (cWhoset > 0) flag = GREATER_THAN; else flag = LESS_THAN; } else if (oWhoset > cWhoset) { if (oWhoset > 0) flag = LESS_THAN; else flag = GREATER_THAN; } else { flag = ComparePartialMatches(theEnv,actPtr,newActivation); } if (flag == LESS_THAN) { lastAct = actPtr; actPtr = actPtr->next; } else if (flag == GREATER_THAN) { return(lastAct); } else /* flag == EQUAL */ { if (timetag > actPtr->timetag) { lastAct = actPtr; actPtr = actPtr->next; } else { return(lastAct); } } } } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*********************************************************************/ /* PlaceComplexityActivation: Determines the location in the agenda */ /* where a new activation should be placed for the complexity */ /* strategy. Returns a pointer to the activation after which the */ /* new activation should be placed (or NULL if the activation */ /* should be placed at the beginning of the agenda). */ /*********************************************************************/ static ACTIVATION *PlaceComplexityActivation( ACTIVATION *actPtr, ACTIVATION *newActivation) { int salience, complexity; unsigned long timetag; ACTIVATION *lastAct; /*========================================*/ /* Set up initial information for search. */ /*========================================*/ timetag = newActivation->timetag; salience = newActivation->salience; complexity = newActivation->theRule->complexity; lastAct = NULL; /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the activation is placed before */ /* activations of equal or lessor complexity. */ /*=========================================================*/ while (actPtr != NULL) { if (actPtr->salience > salience) { lastAct = actPtr; actPtr = actPtr->next; } else if (actPtr->salience < salience) { return(lastAct); } else if (complexity < (int) actPtr->theRule->complexity) { lastAct = actPtr; actPtr = actPtr->next; } else if (complexity > (int) actPtr->theRule->complexity) { return(lastAct); } else if (timetag > actPtr->timetag) { lastAct = actPtr; actPtr = actPtr->next; } else { return(lastAct); } } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*********************************************************************/ /* PlaceSimplicityActivation: Determines the location in the agenda */ /* where a new activation should be placed for the simplicity */ /* strategy. Returns a pointer to the activation after which the */ /* new activation should be placed (or NULL if the activation */ /* should be placed at the beginning of the agenda). */ /*********************************************************************/ static ACTIVATION *PlaceSimplicityActivation( ACTIVATION *actPtr, ACTIVATION *newActivation) { int salience, complexity; unsigned long timetag; ACTIVATION *lastAct; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; salience = newActivation->salience; complexity = newActivation->theRule->complexity; lastAct = NULL; /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the activation is placed after */ /* activations of equal or greater complexity. */ /*=========================================================*/ while (actPtr != NULL) { if (actPtr->salience > salience) { lastAct = actPtr; actPtr = actPtr->next; } else if (actPtr->salience < salience) { return(lastAct); } else if (complexity > (int) actPtr->theRule->complexity) { lastAct = actPtr; actPtr = actPtr->next; } else if (complexity < (int) actPtr->theRule->complexity) { return(lastAct); } else if (timetag > actPtr->timetag) { lastAct = actPtr; actPtr = actPtr->next; } else { return(lastAct); } } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /*******************************************************************/ /* PlaceRandomActivation: Determines the location in the agenda */ /* where a new activation should be placed for the random */ /* strategy. Returns a pointer to the activation after which */ /* the new activation should be placed (or NULL if the */ /* activation should be placed at the beginning of the agenda). */ /*******************************************************************/ static ACTIVATION *PlaceRandomActivation( ACTIVATION *actPtr, ACTIVATION *newActivation) { int salience, randomID; unsigned long timetag; ACTIVATION *lastAct; /*============================================*/ /* Set up initial information for the search. */ /*============================================*/ timetag = newActivation->timetag; salience = newActivation->salience; randomID = newActivation->randomID; lastAct = NULL; /*=========================================================*/ /* Find the insertion point in the agenda. The activation */ /* is placed before activations of lower salience and */ /* after activations of higher salience. Among activations */ /* of equal salience, the placement of the activation is */ /* determined through the generation of a random number. */ /*=========================================================*/ while (actPtr != NULL) { if (actPtr->salience > salience) { lastAct = actPtr; actPtr = actPtr->next; } else if (actPtr->salience < salience) { return(lastAct); } else if (randomID > actPtr->randomID) { lastAct = actPtr; actPtr = actPtr->next; } else if (randomID < actPtr->randomID) { return(lastAct); } else if (timetag > actPtr->timetag) { lastAct = actPtr; actPtr = actPtr->next; } else { return(lastAct); } } /*===========================================*/ /* Return the insertion point in the agenda. */ /*===========================================*/ return(lastAct); } /******************************************************************/ /* SortPartialMatch: Copies a partial match and then sorts the */ /* fact-indices in the copied partial match in ascending order. */ /******************************************************************/ static struct partialMatch *SortPartialMatch( void *theEnv, struct partialMatch *binds) { struct partialMatch *nbinds; struct alphaMatch *temp; int flag, j, k; /*=================*/ /* Copy the array. */ /*=================*/ nbinds = CopyPartialMatch(theEnv,binds,0,0); /*=================*/ /* Sort the array. */ /*=================*/ for (flag = TRUE, k = binds->bcount - 1; flag == TRUE; k--) { flag = FALSE; for (j = 0 ; j < k ; j++) { if ((nbinds->binds[j].gm.theMatch->matchingItem != NULL) && (nbinds->binds[j + 1].gm.theMatch->matchingItem != NULL)) { if (nbinds->binds[j].gm.theMatch->matchingItem->timeTag < nbinds->binds[j + 1].gm.theMatch->matchingItem->timeTag) { temp = nbinds->binds[j].gm.theMatch; nbinds->binds[j].gm.theMatch = nbinds->binds[j+1].gm.theMatch; nbinds->binds[j+1].gm.theMatch = temp; flag = TRUE; } } } } /*===================*/ /* Return the array. */ /*===================*/ return(nbinds); } /**************************************************************************/ /* ComparePartialMatches: Compares two activations using the lex conflict */ /* resolution strategy to determine which activation should be placed */ /* first on the agenda. This lexicographic comparison function is used */ /* for both the lex and mea strategies. */ /**************************************************************************/ static int ComparePartialMatches( void *theEnv, ACTIVATION *actPtr, ACTIVATION *newActivation) { int cCount, oCount, mCount, i; /*=================================================*/ /* If the activation already on the agenda doesn't */ /* have a set of sorted timetags, then create one. */ /*=================================================*/ if (actPtr->sortedBasis == NULL) { actPtr->sortedBasis = SortPartialMatch(theEnv,actPtr->basis); } /*==============================================================*/ /* Determine the number of timetags in each of the activations. */ /* The number of timetags to be compared is the lessor of these */ /* two numbers. */ /*==============================================================*/ cCount = newActivation->sortedBasis->bcount; oCount = actPtr->sortedBasis->bcount; if (oCount > cCount) mCount = cCount; else mCount = oCount; /*===========================================================*/ /* Compare the sorted timetags one by one until there are no */ /* more timetags to compare or the timetags being compared */ /* are not equal. If the timetags aren't equal, then the */ /* activation containing the larger timetag is placed before */ /* the activation containing the smaller timetag. */ /*===========================================================*/ for (i = 0 ; i < mCount ; i++) { if ((actPtr->sortedBasis->binds[i].gm.theMatch->matchingItem != NULL) && (newActivation->sortedBasis->binds[i].gm.theMatch->matchingItem != NULL)) { if (newActivation->sortedBasis->binds[i].gm.theMatch->matchingItem->timeTag < actPtr->sortedBasis->binds[i].gm.theMatch->matchingItem->timeTag) { return(LESS_THAN); } else if (newActivation->sortedBasis->binds[i].gm.theMatch->matchingItem->timeTag > actPtr->sortedBasis->binds[i].gm.theMatch->matchingItem->timeTag) { return(GREATER_THAN); } } else if (newActivation->sortedBasis->binds[i].gm.theMatch->matchingItem != NULL) { return(GREATER_THAN); } else if (actPtr->sortedBasis->binds[i].gm.theMatch->matchingItem != NULL) { return(LESS_THAN); } } /*==========================================================*/ /* If the sorted timetags are identical up to the number of */ /* timetags contained in the smaller partial match, then */ /* the activation containing more timetags should be */ /* placed before the activation containing fewer timetags. */ /*==========================================================*/ if (cCount < oCount) return(LESS_THAN); else if (cCount > oCount) return(GREATER_THAN); /*=========================================================*/ /* If the sorted partial matches for both activations are */ /* identical (containing the same number and values of */ /* timetags), then the activation associated with the rule */ /* having the highest complexity is placed before the */ /* other partial match. */ /*=========================================================*/ if (newActivation->theRule->complexity < actPtr->theRule->complexity) { return(LESS_THAN); } else if (newActivation->theRule->complexity > actPtr->theRule->complexity) { return(GREATER_THAN); } /*================================================*/ /* The two partial matches are equal for purposes */ /* of placement on the agenda for the lex and mea */ /* conflict resolution strategies. */ /*================================================*/ return(EQUAL); } /************************************/ /* EnvSetStrategy: C access routine */ /* for the set-strategy command. */ /************************************/ globle int EnvSetStrategy( void *theEnv, int value) { int oldStrategy; oldStrategy = AgendaData(theEnv)->Strategy; AgendaData(theEnv)->Strategy = value; if (oldStrategy != AgendaData(theEnv)->Strategy) EnvReorderAgenda(theEnv,NULL); return(oldStrategy); } /************************************/ /* EnvGetStrategy: C access routine */ /* for the get-strategy command. */ /************************************/ globle int EnvGetStrategy( void *theEnv) { return(AgendaData(theEnv)->Strategy); } /********************************************/ /* GetStrategyCommand: H/L access routine */ /* for the get-strategy command. */ /********************************************/ globle void *GetStrategyCommand( void *theEnv) { EnvArgCountCheck(theEnv,"get-strategy",EXACTLY,0); return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); } /********************************************/ /* SetStrategyCommand: H/L access routine */ /* for the set-strategy command. */ /********************************************/ globle void *SetStrategyCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; int oldStrategy; oldStrategy = AgendaData(theEnv)->Strategy; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if (EnvArgCountCheck(theEnv,"set-strategy",EXACTLY,1) == -1) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); } if (EnvArgTypeCheck(theEnv,"set-strategy",1,SYMBOL,&argPtr) == FALSE) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); } argument = DOToString(argPtr); /*=============================================*/ /* Set the strategy to the specified strategy. */ /*=============================================*/ if (strcmp(argument,"depth") == 0) { EnvSetStrategy(theEnv,DEPTH_STRATEGY); } else if (strcmp(argument,"breadth") == 0) { EnvSetStrategy(theEnv,BREADTH_STRATEGY); } else if (strcmp(argument,"lex") == 0) { EnvSetStrategy(theEnv,LEX_STRATEGY); } else if (strcmp(argument,"mea") == 0) { EnvSetStrategy(theEnv,MEA_STRATEGY); } else if (strcmp(argument,"complexity") == 0) { EnvSetStrategy(theEnv,COMPLEXITY_STRATEGY); } else if (strcmp(argument,"simplicity") == 0) { EnvSetStrategy(theEnv,SIMPLICITY_STRATEGY); } else if (strcmp(argument,"random") == 0) { EnvSetStrategy(theEnv,RANDOM_STRATEGY); } else { ExpectedTypeError1(theEnv,"set-strategy",1, "symbol with value depth, breadth, lex, mea, complexity, simplicity, or random"); return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); } /*=======================================*/ /* Return the old value of the strategy. */ /*=======================================*/ return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(oldStrategy))); } /**********************************************************/ /* GetStrategyName: Given the integer value corresponding */ /* to a specified strategy, return a character string */ /* of the strategy's name. */ /**********************************************************/ static char *GetStrategyName( int strategy) { char *sname; switch (strategy) { case DEPTH_STRATEGY: sname = "depth"; break; case BREADTH_STRATEGY: sname = "breadth"; break; case LEX_STRATEGY: sname = "lex"; break; case MEA_STRATEGY: sname = "mea"; break; case COMPLEXITY_STRATEGY: sname = "complexity"; break; case SIMPLICITY_STRATEGY: sname = "simplicity"; break; case RANDOM_STRATEGY: sname = "random"; break; default: sname = "unknown"; break; } return(sname); } #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/tmpltbsc.c0000755000175000017500000002674510441602337014544 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFTEMPLATE BASIC COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deftemplate */ /* construct such as clear, reset, save, undeftemplate, */ /* ppdeftemplate, list-deftemplates, and */ /* get-deftemplate-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings */ /* when ENVIRONMENT_API_ONLY flag is set. */ /* */ /*************************************************************/ #define _TMPLTBSC_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "argacces.h" #include "memalloc.h" #include "scanner.h" #include "router.h" #include "extnfunc.h" #include "constrct.h" #include "cstrccom.h" #include "factrhs.h" #include "cstrcpsr.h" #include "tmpltpsr.h" #include "tmpltdef.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "tmpltbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "tmpltcmp.h" #endif #include "tmpltutl.h" #include "envrnmnt.h" #include "tmpltbsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if ! DEFFACTS_CONSTRUCT static void ResetDeftemplates(void *); #endif static void ClearDeftemplates(void *); static void SaveDeftemplates(void *,void *,char *); /*********************************************************************/ /* DeftemplateBasicCommands: Initializes basic deftemplate commands. */ /*********************************************************************/ globle void DeftemplateBasicCommands( void *theEnv) { #if ! DEFFACTS_CONSTRUCT EnvAddResetFunction(theEnv,"deftemplate",ResetDeftemplates,0); #endif EnvAddClearFunction(theEnv,"deftemplate",ClearDeftemplates,0); AddSaveFunction(theEnv,"deftemplate",SaveDeftemplates,10); #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-deftemplate-list",'m',PTIEF GetDeftemplateListFunction,"GetDeftemplateListFunction","01w"); EnvDefineFunction2(theEnv,"undeftemplate",'v',PTIEF UndeftemplateCommand,"UndeftemplateCommand","11w"); EnvDefineFunction2(theEnv,"deftemplate-module",'w',PTIEF DeftemplateModuleFunction,"DeftemplateModuleFunction","11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-deftemplates",'v', PTIEF ListDeftemplatesCommand,"ListDeftemplatesCommand","01w"); EnvDefineFunction2(theEnv,"ppdeftemplate",'v',PTIEF PPDeftemplateCommand,"PPDeftemplateCommand","11w"); #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DeftemplateBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeftemplateCompilerSetup(theEnv); #endif #endif } /*************************************************************/ /* ResetDeftemplates: Deftemplate reset routine for use with */ /* the reset command. Asserts the initial-fact fact when */ /* the deffacts construct has been disabled. */ /*************************************************************/ #if ! DEFFACTS_CONSTRUCT static void ResetDeftemplates( void *theEnv) { struct fact *factPtr; factPtr = StringToFact(theEnv,"(initial-fact)"); if (factPtr == NULL) return; EnvAssert(theEnv,(void *) factPtr); } #endif /*****************************************************************/ /* ClearDeftemplates: Deftemplate clear routine for use with the */ /* clear command. Creates the initial-facts deftemplate. */ /*****************************************************************/ static void ClearDeftemplates( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /**********************************************/ /* SaveDeftemplates: Deftemplate save routine */ /* for use with the save command. */ /**********************************************/ static void SaveDeftemplates( void *theEnv, void *theModule, char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DeftemplateData(theEnv)->DeftemplateConstruct); } /**********************************************/ /* UndeftemplateCommand: H/L access routine */ /* for the undeftemplate command. */ /**********************************************/ globle void UndeftemplateCommand( void *theEnv) { UndefconstructCommand(theEnv,"undeftemplate",DeftemplateData(theEnv)->DeftemplateConstruct); } /**************************************/ /* EnvUndeftemplate: C access routine */ /* for the undeftemplate command. */ /**************************************/ globle intBool EnvUndeftemplate( void *theEnv, void *theDeftemplate) { return(Undefconstruct(theEnv,theDeftemplate,DeftemplateData(theEnv)->DeftemplateConstruct)); } /****************************************************/ /* GetDeftemplateListFunction: H/L access routine */ /* for the get-deftemplate-list function. */ /****************************************************/ globle void GetDeftemplateListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-deftemplate-list",returnValue,DeftemplateData(theEnv)->DeftemplateConstruct); } /***********************************************/ /* EnvGetDeftemplateList: C access routine for */ /* the get-deftemplate-list function. */ /***********************************************/ globle void EnvGetDeftemplateList( void *theEnv, DATA_OBJECT_PTR returnValue, void *theModule) { GetConstructList(theEnv,returnValue,DeftemplateData(theEnv)->DeftemplateConstruct,(struct defmodule *) theModule); } /***************************************************/ /* DeftemplateModuleFunction: H/L access routine */ /* for the deftemplate-module function. */ /***************************************************/ globle void *DeftemplateModuleFunction( void *theEnv) { return(GetConstructModuleCommand(theEnv,"deftemplate-module",DeftemplateData(theEnv)->DeftemplateConstruct)); } #if DEBUGGING_FUNCTIONS /**********************************************/ /* PPDeftemplateCommand: H/L access routine */ /* for the ppdeftemplate command. */ /**********************************************/ globle void PPDeftemplateCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdeftemplate",DeftemplateData(theEnv)->DeftemplateConstruct); } /***************************************/ /* PPDeftemplate: C access routine for */ /* the ppdeftemplate command. */ /***************************************/ globle int PPDeftemplate( void *theEnv, char *deftemplateName, char *logicalName) { return(PPConstruct(theEnv,deftemplateName,logicalName,DeftemplateData(theEnv)->DeftemplateConstruct)); } /*************************************************/ /* ListDeftemplatesCommand: H/L access routine */ /* for the list-deftemplates command. */ /*************************************************/ globle void ListDeftemplatesCommand( void *theEnv) { ListConstructCommand(theEnv,"list-deftemplates",DeftemplateData(theEnv)->DeftemplateConstruct); } /*****************************************/ /* EnvListDeftemplates: C access routine */ /* for the list-deftemplates command. */ /*****************************************/ globle void EnvListDeftemplates( void *theEnv, char *logicalName, void *theModule) { ListConstruct(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct,logicalName,(struct defmodule *) theModule); } /***********************************************************/ /* EnvGetDeftemplateWatch: C access routine for retrieving */ /* the current watch value of a deftemplate. */ /***********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDeftemplateWatch( void *theEnv, void *theTemplate) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((struct deftemplate *) theTemplate)->watch); } /*********************************************************/ /* EnvSetDeftemplateWatch: C access routine for setting */ /* the current watch value of a deftemplate. */ /*********************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDeftemplateWatch( void *theEnv, unsigned newState, void *theTemplate) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((struct deftemplate *) theTemplate)->watch = newState; } /**********************************************************/ /* DeftemplateWatchAccess: Access routine for setting the */ /* watch flag of a deftemplate via the watch command. */ /**********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned DeftemplateWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(ConstructSetWatchAccess(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct,newState,argExprs, EnvGetDeftemplateWatch,EnvSetDeftemplateWatch)); } /*************************************************************************/ /* DeftemplateWatchPrint: Access routine for printing which deftemplates */ /* have their watch flag set via the list-watch-items command. */ /*************************************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned DeftemplateWatchPrint( void *theEnv, char *logName, int code, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(ConstructPrintWatchAccess(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct,logName,argExprs, EnvGetDeftemplateWatch,EnvSetDeftemplateWatch)); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/facthsh.h0000755000175000017500000000475110441143353014330 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FACT HASHING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_facthsh #define _H_facthsh struct factHashEntry; #ifndef _H_factmngr #include "factmngr.h" #endif struct factHashEntry { struct fact *theFact; struct factHashEntry *next; }; #define SIZE_FACT_HASH 7717 #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTHSH_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetFactDuplication(theEnv) EnvGetFactDuplication(theEnv) #define SetFactDuplication(theEnv,a) EnvSetFactDuplication(theEnv,a) #else #define GetFactDuplication() EnvGetFactDuplication(GetCurrentEnvironment()) #define SetFactDuplication(a) EnvSetFactDuplication(GetCurrentEnvironment(),a) #endif LOCALE void AddHashedFact(void *,struct fact *,int); LOCALE intBool RemoveHashedFact(void *,struct fact *); LOCALE int HandleFactDuplication(void *,void *); LOCALE intBool EnvGetFactDuplication(void *); LOCALE intBool EnvSetFactDuplication(void *,int); LOCALE void InitializeFactHashTable(void *); LOCALE void ShowFactHashTable(void *); LOCALE int HashFact(struct fact *); #endif clips-6.24/clipssrc/clips.h0000755000175000017500000000602710441160271014016 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* API HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added filertr.h and tmpltfun.h to include */ /* list. */ /* */ /*************************************************************/ #ifndef _H_API #define _H_API #include "setup.h" #ifndef _H_argacces #include "argacces.h" #endif #include "constant.h" #include "memalloc.h" #include "cstrcpsr.h" #include "filecom.h" #include "strngfun.h" #include "envrnmnt.h" #include "commline.h" #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_router #include "router.h" #endif #ifndef _H_filertr #include "filertr.h" #endif #include "sysdep.h" #include "bmathfun.h" #ifndef _H_expressn #include "expressn.h" #endif #include "exprnpsr.h" #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #include "utility.h" #include "watch.h" #include "modulbsc.h" #if BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if BLOAD_AND_BSAVE #include "bsave.h" #endif #if DEFRULE_CONSTRUCT #ifndef _H_ruledef #include "ruledef.h" #endif #include "rulebsc.h" #include "engine.h" #include "drive.h" #include "incrrset.h" #include "rulecom.h" #include "crstrtgy.h" #endif #if DEFFACTS_CONSTRUCT #include "dffctdef.h" #include "dffctbsc.h" #endif #if DEFTEMPLATE_CONSTRUCT #include "tmpltdef.h" #include "tmpltbsc.h" #include "tmpltfun.h" #include "factcom.h" #include "factfun.h" #ifndef _H_factmngr #include "factmngr.h" #endif #include "facthsh.h" #endif #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #include "globlbsc.h" #include "globlcom.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #include "genrcfun.h" #endif #if OBJECT_SYSTEM #include "classcom.h" #include "classexm.h" #include "classinf.h" #include "classini.h" #include "defins.h" #include "inscom.h" #include "insfile.h" #include "insfun.h" #include "msgcom.h" #include "msgpass.h" #include "objrtmch.h" #endif #endif clips-6.24/clipssrc/._rulepsr.h0000400000175000017500000000012207422634732014603 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._sortfun.c0000400000175000017500000000075410253662160014605 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoS?S?s1TTF/BzFMPSRMWBBLclips-6.24/clipssrc/._objrtbin.h0000400000175000017500000000061410441072727014721 0ustar jfsjfsMac OS X  2 R:TEXT????`a22S,2MWBB clips-6.24/clipssrc/globlpsr.h0000755000175000017500000000332510441143671014533 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFGLOBAL PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_globlpsr #define _H_globlpsr #ifdef _DEFGLOBL_SOURCE_ struct defglobal; #endif #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ParseDefglobal(void *,char *); LOCALE intBool ReplaceGlobalVariable(void *,struct expr *); LOCALE void GlobalReferenceErrorMessage(void *,char *); #endif clips-6.24/clipssrc/globlbin.c0000755000175000017500000004452607673515206014514 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* DEFGLOBAL BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* defglobal construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _GLOBLBIN_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT && (BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "multifld.h" #include "globldef.h" #include "bload.h" #include "bsave.h" #include "moduldef.h" #include "globlbsc.h" #include "envrnmnt.h" #include "globlbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); #endif static void BloadStorageDefglobals(void *); static void BloadBinaryItem(void *); static void UpdateDefglobalModule(void *,void *,long); static void UpdateDefglobal(void *,void *,long); static void ClearBload(void *); static void DeallocateDefglobalBloadData(void *); /*********************************************/ /* DefglobalBinarySetup: Installs the binary */ /* save/load feature for the defglobals. */ /*********************************************/ globle void DefglobalBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,GLOBLBIN_DATA,sizeof(struct defglobalBinaryData),DeallocateDefglobalBloadData); #if (BLOAD_AND_BSAVE || BLOAD) AddAfterBloadFunction(theEnv,"defglobal",ResetDefglobals,50); #endif #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"defglobal",0,BsaveFind,NULL, BsaveStorage,BsaveBinaryItem, BloadStorageDefglobals,BloadBinaryItem, ClearBload); #endif #if (BLOAD || BLOAD_ONLY) AddBinaryItem(theEnv,"defglobal",0,NULL,NULL,NULL,NULL, BloadStorageDefglobals,BloadBinaryItem, ClearBload); #endif } /*********************************************************/ /* DeallocateDefglobalBloadData: Deallocates environment */ /* data for the defglobal bsave functionality. */ /*********************************************************/ static void DeallocateDefglobalBloadData( void *theEnv) { #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) unsigned long space; long i; for (i = 0; i < DefglobalBinaryData(theEnv)->NumberOfDefglobals; i++) { if (DefglobalBinaryData(theEnv)->DefglobalArray[i].current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) DefglobalBinaryData(theEnv)->DefglobalArray[i].current.value); } } space = DefglobalBinaryData(theEnv)->NumberOfDefglobals * sizeof(struct defglobal); if (space != 0) { genlongfree(theEnv,(void *) DefglobalBinaryData(theEnv)->DefglobalArray,space); } space = DefglobalBinaryData(theEnv)->NumberOfDefglobalModules * sizeof(struct defglobalModule); if (space != 0) { genlongfree(theEnv,(void *) DefglobalBinaryData(theEnv)->ModuleArray,space); } #endif } #if BLOAD_AND_BSAVE /****************************************************/ /* BsaveFind: Counts the number of data structures */ /* which must be saved in the binary image for */ /* the defglobals in the current environment. */ /****************************************************/ static void BsaveFind( void *theEnv) { struct defglobal *defglobalPtr; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DefglobalBinaryData(theEnv)->NumberOfDefglobalModules); SaveBloadCount(theEnv,DefglobalBinaryData(theEnv)->NumberOfDefglobals); /*============================================*/ /* Set the count of defglobals and defglobals */ /* module data structures to zero. */ /*============================================*/ DefglobalBinaryData(theEnv)->NumberOfDefglobals = 0; DefglobalBinaryData(theEnv)->NumberOfDefglobalModules = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*================================================*/ /* Set the current module to the module being */ /* examined and increment the number of defglobal */ /* modules encountered. */ /*================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); DefglobalBinaryData(theEnv)->NumberOfDefglobalModules++; /*====================================================*/ /* Loop through each defglobal in the current module. */ /*====================================================*/ for (defglobalPtr = (struct defglobal *) EnvGetNextDefglobal(theEnv,NULL); defglobalPtr != NULL; defglobalPtr = (struct defglobal *) EnvGetNextDefglobal(theEnv,defglobalPtr)) { /*======================================================*/ /* Initialize the construct header for the binary save. */ /*======================================================*/ MarkConstructHeaderNeededItems(&defglobalPtr->header,DefglobalBinaryData(theEnv)->NumberOfDefglobals++); } } } /*****************************************************/ /* BsaveStorage: Writes out storage requirements for */ /* all defglobal structures to the binary file */ /*****************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { unsigned long space; /*===========================================================*/ /* Only two data structures are saved as part of a defglobal */ /* binary image: the defglobal data structure and the */ /* defglobalModule data structure. */ /*===========================================================*/ space = sizeof(long) * 2; GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); GenWrite(&DefglobalBinaryData(theEnv)->NumberOfDefglobals,(unsigned long) sizeof(long int),fp); GenWrite(&DefglobalBinaryData(theEnv)->NumberOfDefglobalModules,(unsigned long) sizeof(long int),fp); } /*********************************************/ /* BsaveBinaryItem: Writes out all defglobal */ /* structures to the binary file */ /*********************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { unsigned long int space; struct defglobal *theDefglobal; struct bsaveDefglobal newDefglobal; struct defmodule *theModule; struct bsaveDefglobalModule tempDefglobalModule; struct defglobalModule *theModuleItem; /*==========================================================*/ /* Write out the amount of space taken up by the defglobal */ /* and defglobalModule data structures in the binary image. */ /*==========================================================*/ space = DefglobalBinaryData(theEnv)->NumberOfDefglobals * sizeof(struct bsaveDefglobal) + (DefglobalBinaryData(theEnv)->NumberOfDefglobalModules * sizeof(struct bsaveDefglobalModule)); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); /*=================================================*/ /* Write out each defglobal module data structure. */ /*=================================================*/ DefglobalBinaryData(theEnv)->NumberOfDefglobals = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); theModuleItem = (struct defglobalModule *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&tempDefglobalModule.header, &theModuleItem->header); GenWrite(&tempDefglobalModule,(unsigned long) sizeof(struct bsaveDefglobalModule),fp); } /*===========================*/ /* Write out each defglobal. */ /*===========================*/ DefglobalBinaryData(theEnv)->NumberOfDefglobals = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,NULL); theDefglobal != NULL; theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theDefglobal)) { AssignBsaveConstructHeaderVals(&newDefglobal.header, &theDefglobal->header); newDefglobal.initial = HashedExpressionIndex(theEnv,theDefglobal->initial); GenWrite(&newDefglobal,(unsigned long) sizeof(struct bsaveDefglobal),fp); } } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of defglobals and defglobal modules in the binary image */ /* (these were overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DefglobalBinaryData(theEnv)->NumberOfDefglobalModules); RestoreBloadCount(theEnv,&DefglobalBinaryData(theEnv)->NumberOfDefglobals); } #endif /* BLOAD_AND_BSAVE */ /***********************************************/ /* BloadStorageDefglobals: Allocates space for */ /* the defglobals used by this binary image. */ /***********************************************/ static void BloadStorageDefglobals( void *theEnv) { unsigned long int space; /*=======================================================*/ /* Determine the number of defglobal and defglobalModule */ /* data structures to be read. */ /*=======================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); GenReadBinary(theEnv,&DefglobalBinaryData(theEnv)->NumberOfDefglobals,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&DefglobalBinaryData(theEnv)->NumberOfDefglobalModules,(unsigned long) sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* defglobalModule data structures. */ /*===================================*/ if (DefglobalBinaryData(theEnv)->NumberOfDefglobalModules == 0) { DefglobalBinaryData(theEnv)->DefglobalArray = NULL; DefglobalBinaryData(theEnv)->ModuleArray = NULL; } space = DefglobalBinaryData(theEnv)->NumberOfDefglobalModules * sizeof(struct defglobalModule); DefglobalBinaryData(theEnv)->ModuleArray = (struct defglobalModule *) genlongalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* defglobal data structures. */ /*===================================*/ if (DefglobalBinaryData(theEnv)->NumberOfDefglobals == 0) { DefglobalBinaryData(theEnv)->DefglobalArray = NULL; return; } space = (unsigned long) (DefglobalBinaryData(theEnv)->NumberOfDefglobals * sizeof(struct defglobal)); DefglobalBinaryData(theEnv)->DefglobalArray = (struct defglobal *) genlongalloc(theEnv,space); } /******************************************************/ /* BloadBinaryItem: Loads and refreshes the defglobal */ /* constructs used by this binary image. */ /******************************************************/ static void BloadBinaryItem( void *theEnv) { unsigned long int space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); /*=============================================*/ /* Read in the defglobalModule data structures */ /* and refresh the pointers. */ /*=============================================*/ BloadandRefresh(theEnv,DefglobalBinaryData(theEnv)->NumberOfDefglobalModules, (unsigned) sizeof(struct bsaveDefglobalModule), UpdateDefglobalModule); /*=======================================*/ /* Read in the defglobal data structures */ /* and refresh the pointers. */ /*=======================================*/ BloadandRefresh(theEnv,DefglobalBinaryData(theEnv)->NumberOfDefglobals, (unsigned) sizeof(struct bsaveDefglobal), UpdateDefglobal); } /************************************************/ /* UpdateDefglobalModule: Bload refresh routine */ /* for defglobal module data structures. */ /************************************************/ static void UpdateDefglobalModule( void *theEnv, void *buf, long obji) { struct bsaveDefglobalModule *bdmPtr; bdmPtr = (struct bsaveDefglobalModule *) buf; UpdateDefmoduleItemHeader(theEnv,&bdmPtr->header,&DefglobalBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(struct defglobal), (void *) DefglobalBinaryData(theEnv)->DefglobalArray); } /******************************************/ /* UpdateDefglobal: Bload refresh routine */ /* for defglobal data structures. */ /******************************************/ static void UpdateDefglobal( void *theEnv, void *buf, long obji) { struct bsaveDefglobal *bdp; bdp = (struct bsaveDefglobal *) buf; UpdateConstructHeader(theEnv,&bdp->header,&DefglobalBinaryData(theEnv)->DefglobalArray[obji].header, (int) sizeof(struct defglobalModule),(void *) DefglobalBinaryData(theEnv)->ModuleArray, (int) sizeof(struct defglobal),(void *) DefglobalBinaryData(theEnv)->DefglobalArray); #if DEBUGGING_FUNCTIONS DefglobalBinaryData(theEnv)->DefglobalArray[obji].watch = WatchGlobals; #endif DefglobalBinaryData(theEnv)->DefglobalArray[obji].initial = HashedExpressionPointer(bdp->initial); DefglobalBinaryData(theEnv)->DefglobalArray[obji].current.type = RVOID; } /***************************************/ /* ClearBload: Defglobal clear routine */ /* when a binary load is in effect. */ /***************************************/ static void ClearBload( void *theEnv) { long i; unsigned long space; /*=======================================================*/ /* Decrement in use counters for atomic values contained */ /* in the construct headers. Also decrement data */ /* structures used to store the defglobal's value. */ /*=======================================================*/ for (i = 0; i < DefglobalBinaryData(theEnv)->NumberOfDefglobals; i++) { UnmarkConstructHeader(theEnv,&DefglobalBinaryData(theEnv)->DefglobalArray[i].header); ValueDeinstall(theEnv,&(DefglobalBinaryData(theEnv)->DefglobalArray[i].current)); if (DefglobalBinaryData(theEnv)->DefglobalArray[i].current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) DefglobalBinaryData(theEnv)->DefglobalArray[i].current.value); } } /*==============================================================*/ /* Deallocate the space used for the defglobal data structures. */ /*==============================================================*/ space = DefglobalBinaryData(theEnv)->NumberOfDefglobals * sizeof(struct defglobal); if (space != 0) genlongfree(theEnv,(void *) DefglobalBinaryData(theEnv)->DefglobalArray,space); DefglobalBinaryData(theEnv)->NumberOfDefglobals = 0; /*=====================================================================*/ /* Deallocate the space used for the defglobal module data structures. */ /*=====================================================================*/ space = DefglobalBinaryData(theEnv)->NumberOfDefglobalModules * sizeof(struct defglobalModule); if (space != 0) genlongfree(theEnv,(void *) DefglobalBinaryData(theEnv)->ModuleArray,space); DefglobalBinaryData(theEnv)->NumberOfDefglobalModules = 0; } /********************************************************/ /* BloadDefglobalModuleReference: Returns the defglobal */ /* module pointer for using with the bload function. */ /********************************************************/ globle void *BloadDefglobalModuleReference( void *theEnv, int theIndex) { return ((void *) &DefglobalBinaryData(theEnv)->ModuleArray[theIndex]); } #endif /* DEFGLOBAL_CONSTRUCT && (BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY) && (! RUN_TIME) */ clips-6.24/clipssrc/rulecmp.c0000755000175000017500000004251710441071206014351 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* DEFRULE CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /*************************************************************/ #define _RULECMP_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT && (! RUN_TIME) && CONSTRUCT_COMPILER #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "factbld.h" #include "reteutil.h" #include "rulecmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,char *,int,FILE *,int,int); static void JoinToCode(void *,FILE *,struct joinNode *,int,int); static void DefruleModuleToCode(void *,FILE *,struct defmodule *,int,int,int); static void DefruleToCode(void *,FILE *,struct defrule *,int,int,int); static void CloseDefruleFiles(void *,FILE *,FILE *,FILE *,int); static void BeforeDefrulesCode(void *); /***********************************************************/ /* DefruleCompilerSetup: Initializes the defrule construct */ /* for use with the constructs-to-c command. */ /***********************************************************/ globle void DefruleCompilerSetup( void *theEnv) { DefruleData(theEnv)->DefruleCodeItem = AddCodeGeneratorItem(theEnv,"defrules",0,BeforeDefrulesCode, NULL,ConstructToCode,3); } /**************************************************************/ /* BeforeDefrulesCode: Assigns each defrule and join with a */ /* unique ID which will be used for pointer references when */ /* the data structures are written to a file as C code */ /**************************************************************/ static void BeforeDefrulesCode( void *theEnv) { long int moduleCount, ruleCount, joinCount; TagRuleNetwork(theEnv,&moduleCount,&ruleCount,&joinCount); } /*********************************************************/ /* ConstructToCode: Produces defrule code for a run-time */ /* module created using the constructs-to-c function. */ /*********************************************************/ static int ConstructToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct defrule *theDefrule; struct joinNode *theJoin; int joinArrayCount = 0, joinArrayVersion = 1; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int defruleArrayCount = 0, defruleArrayVersion = 1; FILE *joinFile = NULL, *moduleFile = NULL, *defruleFile = NULL; /*==============================================*/ /* Include the appropriate defrule header file. */ /*==============================================*/ fprintf(headerFP,"#include \"ruledef.h\"\n"); /*=========================================================*/ /* Loop through all the modules, all the defrules, and all */ /* the join nodes writing their C code representation to */ /* the file as they are traversed. */ /*=========================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=========================*/ /* Set the current module. */ /*=========================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*==========================*/ /* Save the defrule module. */ /*==========================*/ moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "struct defruleModule",ModulePrefix(DefruleData(theEnv)->DefruleCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,maxIndices); return(0); } DefruleModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices,moduleCount); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); /*=========================================*/ /* Loop through all of the defrules (and */ /* their disjuncts) in the current module. */ /*=========================================*/ theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (theDefrule != NULL) { /*===================================*/ /* Save the defrule data structures. */ /*===================================*/ defruleFile = OpenFileIfNeeded(theEnv,defruleFile,fileName,fileID,imageID,&fileCount, defruleArrayVersion,headerFP, "struct defrule",ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem), FALSE,NULL); if (defruleFile == NULL) { CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,maxIndices); return(0); } DefruleToCode(theEnv,defruleFile,theDefrule,imageID,maxIndices, moduleCount); defruleArrayCount++; defruleFile = CloseFileIfNeeded(theEnv,defruleFile,&defruleArrayCount,&defruleArrayVersion, maxIndices,NULL,NULL); /*================================*/ /* Save the join data structures. */ /*================================*/ for (theJoin = theDefrule->lastJoin; theJoin != NULL; theJoin = GetPreviousJoin(theJoin)) { if (theJoin->marked) { joinFile = OpenFileIfNeeded(theEnv,joinFile,fileName,fileID,imageID,&fileCount, joinArrayVersion,headerFP, "struct joinNode",JoinPrefix(),FALSE,NULL); if (joinFile == NULL) { CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,maxIndices); return(0); } JoinToCode(theEnv,joinFile,theJoin,imageID,maxIndices); joinArrayCount++; joinFile = CloseFileIfNeeded(theEnv,joinFile,&joinArrayCount,&joinArrayVersion, maxIndices,NULL,NULL); } } /*==========================================*/ /* Move on to the next disjunct or defrule. */ /*==========================================*/ if (theDefrule->disjunct != NULL) theDefrule = theDefrule->disjunct; else theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule); } moduleCount++; moduleArrayCount++; } CloseDefruleFiles(theEnv,moduleFile,defruleFile,joinFile,maxIndices); return(1); } /********************************************************/ /* CloseDefruleFiles: Closes all of the C files created */ /* for defrule. Called when an error occurs or when */ /* the defrules have all been written to the files. */ /********************************************************/ static void CloseDefruleFiles( void *theEnv, FILE *moduleFile, FILE *defruleFile, FILE *joinFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (joinFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,joinFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (defruleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,defruleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /*********************************************************/ /* DefruleModuleToCode: Writes the C code representation */ /* of a single defrule module to the specified file. */ /*********************************************************/ #if IBM_TBC #pragma argsused #endif static void DefruleModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int moduleCount) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(moduleCount) #endif fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefruleData(theEnv)->DefruleModuleIndex,ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem)); fprintf(theFile,",NULL}"); } /**********************************************************/ /* DefruleToCode: Writes the C code representation of a */ /* single defrule data structure to the specified file. */ /**********************************************************/ static void DefruleToCode( void *theEnv, FILE *theFile, struct defrule *theDefrule, int imageID, int maxIndices, int moduleCount) { /*==================*/ /* Construct Header */ /*==================*/ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefrule->header,imageID,maxIndices, moduleCount,ModulePrefix(DefruleData(theEnv)->DefruleCodeItem), ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem)); /*==========================*/ /* Flags and Integer Values */ /*==========================*/ fprintf(theFile,",%d,%d,%d,%d,%d,%d,%d,%d,", theDefrule->salience,theDefrule->localVarCnt, theDefrule->complexity,theDefrule->afterBreakpoint, theDefrule->watchActivation,theDefrule->watchFiring, theDefrule->autoFocus,theDefrule->executing); /*==================*/ /* Dynamic Salience */ /*==================*/ ExpressionToCode(theEnv,theFile,theDefrule->dynamicSalience); fprintf(theFile,","); /*=============*/ /* RHS Actions */ /*=============*/ ExpressionToCode(theEnv,theFile,theDefrule->actions); fprintf(theFile,","); /*=========================*/ /* Logical Dependency Join */ /*=========================*/ if (theDefrule->logicalJoin != NULL) { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theDefrule->logicalJoin->bsaveID / maxIndices) + 1, theDefrule->logicalJoin->bsaveID % maxIndices); } else { fprintf(theFile,"NULL,"); } /*===========*/ /* Last Join */ /*===========*/ if (theDefrule->lastJoin != NULL) { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theDefrule->lastJoin->bsaveID / maxIndices) + 1, theDefrule->lastJoin->bsaveID % maxIndices); } else { fprintf(theFile,"NULL,"); } /*===============*/ /* Next Disjunct */ /*===============*/ if (theDefrule->disjunct != NULL) { fprintf(theFile,"&%s%d_%ld[%ld]}",ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem), imageID,(theDefrule->disjunct->header.bsaveID / maxIndices) + 1, theDefrule->disjunct->header.bsaveID % maxIndices); } else { fprintf(theFile,"NULL}"); } } /***************************************************/ /* JoinToCode: Writes the C code representation of */ /* a single join node to the specified file. */ /***************************************************/ static void JoinToCode( void *theEnv, FILE *theFile, struct joinNode *theJoin, int imageID, int maxIndices) { struct patternParser *theParser; /*===========================*/ /* Mark the join as visited. */ /*===========================*/ theJoin->marked = 0; /*===========================*/ /* Flags and Integer Values. */ /*===========================*/ fprintf(theFile,"{%d,%d,%d,%d,0,0,%d,%d,0,", theJoin->firstJoin,theJoin->logicalJoin, theJoin->joinFromTheRight,theJoin->patternIsNegated, theJoin->rhsType,theJoin->depth); /*==============*/ /* Beta Memory. */ /*==============*/ fprintf(theFile,"NULL,"); /*====================*/ /* Network Expression */ /*====================*/ PrintHashedExpressionReference(theEnv,theFile,theJoin->networkTest,imageID,maxIndices); fprintf(theFile,","); /*============================*/ /* Right Side Entry Structure */ /*============================*/ if (theJoin->rightSideEntryStructure == NULL) { fprintf(theFile,"NULL,"); } else if (theJoin->joinFromTheRight == FALSE) { theParser = GetPatternParser(theEnv,(int) theJoin->rhsType); if (theParser->codeReferenceFunction == NULL) fprintf(theFile,"NULL,"); else { fprintf(theFile,"VS "); (*theParser->codeReferenceFunction)(theEnv,theJoin->rightSideEntryStructure, theFile,imageID,maxIndices); fprintf(theFile,","); } } else { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(((struct joinNode *) theJoin->rightSideEntryStructure)->bsaveID / maxIndices) + 1, ((struct joinNode *) theJoin->rightSideEntryStructure)->bsaveID % maxIndices); } /*=================*/ /* Next Join Level */ /*=================*/ if (theJoin->nextLevel == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theJoin->nextLevel->bsaveID / maxIndices) + 1, theJoin->nextLevel->bsaveID % maxIndices); } /*=================*/ /* Last Join Level */ /*=================*/ if (theJoin->lastLevel == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theJoin->lastLevel->bsaveID / maxIndices) + 1, theJoin->lastLevel->bsaveID % maxIndices); } /*==================*/ /* Right Drive Node */ /*==================*/ if (theJoin->rightDriveNode == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theJoin->rightDriveNode->bsaveID / maxIndices) + 1, theJoin->rightDriveNode->bsaveID % maxIndices); } /*==================*/ /* Right Match Node */ /*==================*/ if (theJoin->rightMatchNode == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",JoinPrefix(), imageID,(theJoin->rightMatchNode->bsaveID / maxIndices) + 1, theJoin->rightMatchNode->bsaveID % maxIndices); } /*==================*/ /* Rule to Activate */ /*==================*/ if (theJoin->ruleToActivate == NULL) { fprintf(theFile,"NULL}"); } else { fprintf(theFile,"&%s%d_%ld[%ld]}",ConstructPrefix(DefruleData(theEnv)->DefruleCodeItem),imageID, (theJoin->ruleToActivate->header.bsaveID / maxIndices) + 1, theJoin->ruleToActivate->header.bsaveID % maxIndices); } } /*************************************************************/ /* DefruleCModuleReference: Writes the C code representation */ /* of a reference to a defrule module data structure. */ /*************************************************************/ globle void DefruleCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]",ModulePrefix(DefruleData(theEnv)->DefruleCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } #endif /* DEFRULE_CONSTRUCT && (! RUN_TIME) && CONSTRUCT_COMPILER */ clips-6.24/clipssrc/memalloc.c0000755000175000017500000010723310441602242014470 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* MEMORY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Memory allocation routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Removed HaltExecution check from the */ /* EnvReleaseMem function. DR0863 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /*************************************************************/ #define _MEMORY_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "utility.h" #include #if IBM_TBC #include #endif #if IBM_MSC || IBM_ICB #include #endif #if IBM_ZTC || IBM_SC #include #endif #define STRICT_ALIGN_SIZE sizeof(double) #define SpecialMalloc(sz) malloc((STD_SIZE) sz) #define SpecialFree(ptr) free(ptr) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOCK_MEMORY static int InitializeBlockMemory(void *,unsigned int); static int AllocateBlock(void *,struct blockInfo *,unsigned int); static void AllocateChunk(void *,struct blockInfo *,struct chunkInfo *,unsigned int); #endif /********************************************/ /* InitializeMemory: Sets up memory tables. */ /********************************************/ globle void InitializeMemory( void *theEnv) { int i; AllocateEnvironmentData(theEnv,MEMORY_DATA,sizeof(struct memoryData),NULL); MemoryData(theEnv)->OutOfMemoryFunction = DefaultOutOfMemoryFunction; MemoryData(theEnv)->MemoryTable = (struct memoryPtr **) malloc((STD_SIZE) (sizeof(struct memoryPtr *) * MEM_TABLE_SIZE)); if (MemoryData(theEnv)->MemoryTable == NULL) { PrintErrorID(theEnv,"MEMORY",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Out of memory.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); } for (i = 0; i < MEM_TABLE_SIZE; i++) MemoryData(theEnv)->MemoryTable[i] = NULL; } /***************************************************/ /* genalloc: A generic memory allocation function. */ /***************************************************/ globle void *genalloc( void *theEnv, unsigned int size) { char *memPtr; #if BLOCK_MEMORY memPtr = (char *) RequestChunk(theEnv,size); if (memPtr == NULL) { EnvReleaseMem(theEnv,(long) ((size * 5 > 4096) ? size * 5 : 4096),FALSE); memPtr = (char *) RequestChunk(theEnv,size); if (memPtr == NULL) { EnvReleaseMem(theEnv,-1L,TRUE); memPtr = (char *) RequestChunk(theEnv,size); while (memPtr == NULL) { if ((*MemoryData(theEnv)->OutOfMemoryFunction)(theEnv,(unsigned long) size)) return(NULL); memPtr = (char *) RequestChunk(theEnv,size); } } } #else memPtr = (char *) malloc((STD_SIZE) size); if (memPtr == NULL) { EnvReleaseMem(theEnv,(long) ((size * 5 > 4096) ? size * 5 : 4096),FALSE); memPtr = (char *) malloc((STD_SIZE) size); if (memPtr == NULL) { EnvReleaseMem(theEnv,-1L,TRUE); memPtr = (char *) malloc((STD_SIZE) size); while (memPtr == NULL) { if ((*MemoryData(theEnv)->OutOfMemoryFunction)(theEnv,(unsigned long) size)) return(NULL); memPtr = (char *) malloc((STD_SIZE) size); } } } #endif MemoryData(theEnv)->MemoryAmount += (long) size; MemoryData(theEnv)->MemoryCalls++; return((void *) memPtr); } /***********************************************/ /* DefaultOutOfMemoryFunction: Function called */ /* when the KB runs out of memory. */ /***********************************************/ #if IBM_TBC #pragma argsused #endif globle int DefaultOutOfMemoryFunction( void *theEnv, unsigned long size) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(size) #endif PrintErrorID(theEnv,"MEMORY",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Out of memory.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); return(TRUE); } /***********************************************************/ /* EnvSetOutOfMemoryFunction: Allows the function which is */ /* called when the KB runs out of memory to be changed. */ /***********************************************************/ globle int (*EnvSetOutOfMemoryFunction(void *theEnv,int (*functionPtr)(void *,unsigned long)))(void *,unsigned long) { int (*tmpPtr)(void *,unsigned long); tmpPtr = MemoryData(theEnv)->OutOfMemoryFunction; MemoryData(theEnv)->OutOfMemoryFunction = functionPtr; return(tmpPtr); } /****************************************************/ /* genfree: A generic memory deallocation function. */ /****************************************************/ globle int genfree( void *theEnv, void *waste, unsigned size) { #if BLOCK_MEMORY if (ReturnChunk(theEnv,waste,size) == FALSE) { PrintErrorID(theEnv,"MEMORY",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Release error in genfree.\n"); return(-1); } #else free(waste); #endif MemoryData(theEnv)->MemoryAmount -= (long) size; MemoryData(theEnv)->MemoryCalls--; return(0); } /******************************************************/ /* genrealloc: Simple (i.e. dumb) version of realloc. */ /******************************************************/ globle void *genrealloc( void *theEnv, void *oldaddr, unsigned oldsz, unsigned newsz) { char *newaddr; unsigned i; unsigned limit; newaddr = ((newsz != 0) ? (char *) gm2(theEnv,newsz) : NULL); if (oldaddr != NULL) { limit = (oldsz < newsz) ? oldsz : newsz; for (i = 0 ; i < limit ; i++) { newaddr[i] = ((char *) oldaddr)[i]; } for ( ; i < newsz; i++) { newaddr[i] = '\0'; } rm(theEnv,(void *) oldaddr,oldsz); } return((void *) newaddr); } /************************************************/ /* genlongalloc: Allocates blocks of memory for */ /* sizes expressed using long integers. */ /************************************************/ #if IBM_TBC #pragma warn -rch #pragma warn -ccc #endif globle void *genlongalloc( void *theEnv, unsigned long size) { #if (! MAC) && (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) && (! IBM_ZTC) && (! IBM_SC) && (! IBM_MCW) unsigned int test; #else void *memPtr; #endif #if BLOCK_MEMORY struct longMemoryPtr *theLongMemory; #endif if (sizeof(int) == sizeof(long)) { return(genalloc(theEnv,(unsigned) size)); } #if (! MAC) && (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) && (! IBM_ZTC) && (! IBM_SC) && (! IBM_MCW) test = (unsigned int) size; if (test != size) { PrintErrorID(theEnv,"MEMORY",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Unable to allocate memory block > 32K.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); } return((void *) genalloc(theEnv,(unsigned) test)); #else #if BLOCK_MEMORY size += sizeof(struct longMemoryPtr); #endif memPtr = (void *) SpecialMalloc(size); if (memPtr == NULL) { EnvReleaseMem(theEnv,(long) ((size * 5 > 4096) ? size * 5 : 4096),FALSE); memPtr = (void *) SpecialMalloc(size); if (memPtr == NULL) { EnvReleaseMem(theEnv,-1L,TRUE); memPtr = (void *) SpecialMalloc(size); while (memPtr == NULL) { if ((*MemoryData(theEnv)->OutOfMemoryFunction)(theEnv,size)) return(NULL); memPtr = (void *) SpecialMalloc(size); } } } MemoryData(theEnv)->MemoryAmount += (long) size; MemoryData(theEnv)->MemoryCalls++; #if BLOCK_MEMORY theLongMemory = (struct longMemoryPtr *) memPtr; theLongMemory->next = MemoryData(theEnv)->TopLongMemoryPtr; theLongMemory->prev = NULL; theLongMemory->size = (long) size; memPtr = (void *) (theLongMemory + 1); #endif return(memPtr); #endif } #if IBM_TBC #pragma warn +rch #pragma warn +ccc #endif /*********************************************/ /* genlongfree: Returns blocks of memory for */ /* sizes expressed using long integers. */ /*********************************************/ #if IBM_TBC #pragma warn -rch #pragma warn -ccc #endif globle int genlongfree( void *theEnv, void *ptr, unsigned long size) { #if (! MAC) && (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) && (! IBM_ZTC) && (! IBM_SC) && (! IBM_MCW) unsigned int test; #endif #if BLOCK_MEMORY struct longMemoryPtr *theLongMemory; #endif if (sizeof(unsigned int) == sizeof(unsigned long)) { return(genfree(theEnv,(void *) ptr,(unsigned) size)); } #if (! MAC) && (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) && (! IBM_ZTC) && (! IBM_SC) && (! IBM_MCW) test = (unsigned int) size; if (test != size) return(-1); return(genfree(theEnv,(void *) ptr,(unsigned) test)); #endif #if BLOCK_MEMORY size += sizeof(struct longMemoryPtr); theLongMemory = ((struct longMemoryPtr *) ptr) - 1; if (theLongMemory->prev == NULL) { MemoryData(theEnv)->TopLongMemoryPtr = MemoryData(theEnv)->TopLongMemoryPtr->next; MemoryData(theEnv)->TopLongMemoryPtr->prev = NULL; } else { theLongMemory->prev->next = theLongMemory->next; if (theLongMemory->next != NULL) { theLongMemory->next->prev = theLongMemory->next; } } #endif #if MAC || IBM_ICB || IBM_MCW MemoryData(theEnv)->MemoryAmount -= (long) size; MemoryData(theEnv)->MemoryCalls--; SpecialFree(ptr); return(0); #endif #if IBM_TBC || IBM_ZTC || IBM_SC MemoryData(theEnv)->MemoryAmount -= size; MemoryData(theEnv)->MemoryCalls--; SpecialFree(ptr); return(0); #endif #if IBM_MSC MemoryData(theEnv)->MemoryAmount -= size; MemoryData(theEnv)->MemoryCalls--; SpecialFree(ptr); return(0); #endif } #if IBM_TBC #pragma warn +rch #pragma warn +ccc #endif /********************************/ /* EnvMemUsed: C access routine */ /* for the mem-used command. */ /********************************/ globle long int EnvMemUsed( void *theEnv) { return(MemoryData(theEnv)->MemoryAmount); } /************************************/ /* EnvMemRequests: C access routine */ /* for the mem-requests command. */ /************************************/ globle long int EnvMemRequests( void *theEnv) { return(MemoryData(theEnv)->MemoryCalls); } /***************************************/ /* UpdateMemoryUsed: Allows the amount */ /* of memory used to be updated. */ /***************************************/ globle long int UpdateMemoryUsed( void *theEnv, long int value) { MemoryData(theEnv)->MemoryAmount += value; return(MemoryData(theEnv)->MemoryAmount); } /*******************************************/ /* UpdateMemoryRequests: Allows the number */ /* of memory requests to be updated. */ /*******************************************/ globle long int UpdateMemoryRequests( void *theEnv, long int value) { MemoryData(theEnv)->MemoryCalls += value; return(MemoryData(theEnv)->MemoryCalls); } /***********************************/ /* EnvReleaseMem: C access routine */ /* for the release-mem command. */ /***********************************/ globle long int EnvReleaseMem( void *theEnv, long int maximum, int printMessage) { struct memoryPtr *tmpPtr, *memPtr; int i; long int returns = 0; long int amount = 0; if (printMessage == TRUE) { EnvPrintRouter(theEnv,WDIALOG,"\n*** DEALLOCATING MEMORY ***\n"); } for (i = (MEM_TABLE_SIZE - 1) ; i >= (int) sizeof(char *) ; i--) { YieldTime(theEnv); memPtr = MemoryData(theEnv)->MemoryTable[i]; while (memPtr != NULL) { tmpPtr = memPtr->next; genfree(theEnv,(void *) memPtr,(unsigned) i); memPtr = tmpPtr; amount += i; returns++; if ((returns % 100) == 0) { YieldTime(theEnv); } } MemoryData(theEnv)->MemoryTable[i] = NULL; if ((amount > maximum) && (maximum > 0)) { if (printMessage == TRUE) { EnvPrintRouter(theEnv,WDIALOG,"*** MEMORY DEALLOCATED ***\n"); } return(amount); } } if (printMessage == TRUE) { EnvPrintRouter(theEnv,WDIALOG,"*** MEMORY DEALLOCATED ***\n"); } return(amount); } /*****************************************************/ /* gm1: Allocates memory and sets all bytes to zero. */ /*****************************************************/ globle void *gm1( void *theEnv, int size) { struct memoryPtr *memPtr; char *tmpPtr; int i; if (size < (long) sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) { tmpPtr = (char *) genalloc(theEnv,(unsigned) size); for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return((void *) tmpPtr); } memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[size]; if (memPtr == NULL) { tmpPtr = (char *) genalloc(theEnv,(unsigned) size); for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return((void *) tmpPtr); } MemoryData(theEnv)->MemoryTable[size] = memPtr->next; tmpPtr = (char *) memPtr; for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return ((void *) tmpPtr); } /*****************************************************/ /* gm2: Allocates memory and does not initialize it. */ /*****************************************************/ globle void *gm2( void *theEnv, unsigned int size) { struct memoryPtr *memPtr; if (size < sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) return(genalloc(theEnv,(unsigned) size)); memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[size]; if (memPtr == NULL) { return(genalloc(theEnv,(unsigned) size)); } MemoryData(theEnv)->MemoryTable[size] = memPtr->next; return ((void *) memPtr); } /*****************************************************/ /* gm3: Allocates memory and does not initialize it. */ /*****************************************************/ globle void *gm3( void *theEnv, long size) { struct memoryPtr *memPtr; if (size < (long) sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) return(genlongalloc(theEnv,(unsigned long) size)); memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[(int) size]; if (memPtr == NULL) { return(genalloc(theEnv,(unsigned int) size)); } MemoryData(theEnv)->MemoryTable[(int) size] = memPtr->next; return ((void *) memPtr); } /****************************************/ /* rm: Returns a block of memory to the */ /* maintained pool of free memory. */ /****************************************/ globle int rm( void *theEnv, void *str, unsigned size) { struct memoryPtr *memPtr; if (size == 0) { SystemError(theEnv,"MEMORY",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (size < sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) return(genfree(theEnv,(void *) str,(unsigned) size)); memPtr = (struct memoryPtr *) str; memPtr->next = MemoryData(theEnv)->MemoryTable[size]; MemoryData(theEnv)->MemoryTable[size] = memPtr; return(1); } /********************************************/ /* rm3: Returns a block of memory to the */ /* maintained pool of free memory that's */ /* size is indicated with a long integer. */ /********************************************/ globle int rm3( void *theEnv, void *str, long size) { struct memoryPtr *memPtr; if (size == 0) { SystemError(theEnv,"MEMORY",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (size < (long) sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) return(genlongfree(theEnv,(void *) str,(unsigned long) size)); memPtr = (struct memoryPtr *) str; memPtr->next = MemoryData(theEnv)->MemoryTable[(int) size]; MemoryData(theEnv)->MemoryTable[(int) size] = memPtr; return(1); } /***************************************************/ /* PoolSize: Returns number of bytes in free pool. */ /***************************************************/ globle unsigned long PoolSize( void *theEnv) { register int i; struct memoryPtr *memPtr; unsigned long cnt = 0; for (i = sizeof(char *) ; i < MEM_TABLE_SIZE ; i++) { memPtr = MemoryData(theEnv)->MemoryTable[i]; while (memPtr != NULL) { cnt += (unsigned long) i; memPtr = memPtr->next; } } return(cnt); } /***************************************************************/ /* ActualPoolSize : Returns number of bytes DOS requires to */ /* store the free pool. This routine is functionally */ /* equivalent to pool_size on anything other than the IBM-PC */ /***************************************************************/ globle unsigned long ActualPoolSize( void *theEnv) { #if IBM_TBC register int i; struct memoryPtr *memPtr; unsigned long cnt = 0; for (i = sizeof(char *) ; i < MEM_TABLE_SIZE ; i++) { memPtr = MemoryData(theEnv)->MemoryTable[i]; while (memPtr != NULL) { /*==============================================================*/ /* For a block of size n, the Turbo-C Library routines require */ /* a header of size 8 bytes and further require that all memory */ /* allotments be paragraph (16-bytes) aligned. */ /*==============================================================*/ cnt += (((unsigned long) i) + 19L) & 0xfffffff0L; memPtr = memPtr->next; } } return(cnt); #else return(PoolSize(theEnv)); #endif } /********************************************/ /* EnvSetConserveMemory: Allows the setting */ /* of the memory conservation flag. */ /********************************************/ globle intBool EnvSetConserveMemory( void *theEnv, intBool value) { int ov; ov = MemoryData(theEnv)->ConserveMemory; MemoryData(theEnv)->ConserveMemory = value; return(ov); } /*******************************************/ /* EnvGetConserveMemory: Returns the value */ /* of the memory conservation flag. */ /*******************************************/ globle intBool EnvGetConserveMemory( void *theEnv) { return(MemoryData(theEnv)->ConserveMemory); } /**************************/ /* genmemcpy: */ /**************************/ globle void genmemcpy( char *dst, char *src, unsigned long size) { unsigned long i; for (i = 0L ; i < size ; i++) dst[i] = src[i]; } /**************************/ /* BLOCK MEMORY FUNCTIONS */ /**************************/ #if BLOCK_MEMORY /***************************************************/ /* InitializeBlockMemory: Initializes block memory */ /* management and allocates the first block. */ /***************************************************/ static int InitializeBlockMemory( void *theEnv, unsigned int requestSize) { struct chunkInfo *chunkPtr; unsigned int initialBlockSize, usableBlockSize; /*===========================================*/ /* The block memory routines depend upon the */ /* size of a character being 1 byte. */ /*===========================================*/ if (sizeof(char) != 1) { fprintf(stdout, "Size of character data is not 1\n"); fprintf(stdout, "Memory allocation functions may not work\n"); return(0); } MemoryData(theEnv)->ChunkInfoSize = sizeof(struct chunkInfo); MemoryData(theEnv)->ChunkInfoSize = (int) ((((MemoryData(theEnv)->ChunkInfoSize - 1) / STRICT_ALIGN_SIZE) + 1) * STRICT_ALIGN_SIZE); MemoryData(theEnv)->BlockInfoSize = sizeof(struct blockInfo); MemoryData(theEnv)->BlockInfoSize = (int) ((((MemoryData(theEnv)->BlockInfoSize - 1) / STRICT_ALIGN_SIZE) + 1) * STRICT_ALIGN_SIZE); initialBlockSize = (INITBLOCKSIZE > requestSize ? INITBLOCKSIZE : requestSize); initialBlockSize += MemoryData(theEnv)->ChunkInfoSize * 2 + MemoryData(theEnv)->BlockInfoSize; initialBlockSize = (((initialBlockSize - 1) / STRICT_ALIGN_SIZE) + 1) * STRICT_ALIGN_SIZE; usableBlockSize = initialBlockSize - (2 * MemoryData(theEnv)->ChunkInfoSize) - MemoryData(theEnv)->BlockInfoSize; /* make sure we get a buffer big enough to be usable */ if ((requestSize < INITBLOCKSIZE) && (usableBlockSize <= requestSize + MemoryData(theEnv)->ChunkInfoSize)) { initialBlockSize = requestSize + MemoryData(theEnv)->ChunkInfoSize * 2 + MemoryData(theEnv)->BlockInfoSize; initialBlockSize = (((initialBlockSize - 1) / STRICT_ALIGN_SIZE) + 1) * STRICT_ALIGN_SIZE; usableBlockSize = initialBlockSize - (2 * MemoryData(theEnv)->ChunkInfoSize) - MemoryData(theEnv)->BlockInfoSize; } MemoryData(theEnv)->TopMemoryBlock = (struct blockInfo *) malloc((STD_SIZE) initialBlockSize); if (MemoryData(theEnv)->TopMemoryBlock == NULL) { fprintf(stdout, "Unable to allocate initial memory pool\n"); return(0); } MemoryData(theEnv)->TopMemoryBlock->nextBlock = NULL; MemoryData(theEnv)->TopMemoryBlock->prevBlock = NULL; MemoryData(theEnv)->TopMemoryBlock->nextFree = (struct chunkInfo *) (((char *) MemoryData(theEnv)->TopMemoryBlock) + MemoryData(theEnv)->BlockInfoSize); MemoryData(theEnv)->TopMemoryBlock->size = (long) usableBlockSize; chunkPtr = (struct chunkInfo *) (((char *) MemoryData(theEnv)->TopMemoryBlock) + MemoryData(theEnv)->BlockInfoSize + MemoryData(theEnv)->ChunkInfoSize + usableBlockSize); chunkPtr->nextFree = NULL; chunkPtr->lastFree = NULL; chunkPtr->prevChunk = MemoryData(theEnv)->TopMemoryBlock->nextFree; chunkPtr->size = 0; MemoryData(theEnv)->TopMemoryBlock->nextFree->nextFree = NULL; MemoryData(theEnv)->TopMemoryBlock->nextFree->lastFree = NULL; MemoryData(theEnv)->TopMemoryBlock->nextFree->prevChunk = NULL; MemoryData(theEnv)->TopMemoryBlock->nextFree->size = (long) usableBlockSize; MemoryData(theEnv)->BlockMemoryInitialized = TRUE; return(1); } /***************************************************************************/ /* AllocateBlock: Adds a new block of memory to the list of memory blocks. */ /***************************************************************************/ static int AllocateBlock( void *theEnv, struct blockInfo *blockPtr, unsigned int requestSize) { unsigned int blockSize, usableBlockSize; struct blockInfo *newBlock; struct chunkInfo *newTopChunk; /*============================================================*/ /* Determine the size of the block that needs to be allocated */ /* to satisfy the request. Normally, a default block size is */ /* used, but if the requested size is larger than the default */ /* size, then the requested size is used for the block size. */ /*============================================================*/ blockSize = (BLOCKSIZE > requestSize ? BLOCKSIZE : requestSize); blockSize += MemoryData(theEnv)->BlockInfoSize + MemoryData(theEnv)->ChunkInfoSize * 2; blockSize = (((blockSize - 1) / STRICT_ALIGN_SIZE) + 1) * STRICT_ALIGN_SIZE; usableBlockSize = blockSize - MemoryData(theEnv)->BlockInfoSize - (2 * MemoryData(theEnv)->ChunkInfoSize); /*=========================*/ /* Allocate the new block. */ /*=========================*/ newBlock = (struct blockInfo *) malloc((STD_SIZE) blockSize); if (newBlock == NULL) return(0); /*======================================*/ /* Initialize the block data structure. */ /*======================================*/ newBlock->nextBlock = NULL; newBlock->prevBlock = blockPtr; newBlock->nextFree = (struct chunkInfo *) (((char *) newBlock) + MemoryData(theEnv)->BlockInfoSize); newBlock->size = (long) usableBlockSize; blockPtr->nextBlock = newBlock; newTopChunk = (struct chunkInfo *) (((char *) newBlock) + MemoryData(theEnv)->BlockInfoSize + MemoryData(theEnv)->ChunkInfoSize + usableBlockSize); newTopChunk->nextFree = NULL; newTopChunk->lastFree = NULL; newTopChunk->size = 0; newTopChunk->prevChunk = newBlock->nextFree; newBlock->nextFree->nextFree = NULL; newBlock->nextFree->lastFree = NULL; newBlock->nextFree->prevChunk = NULL; newBlock->nextFree->size = (long) usableBlockSize; return(1); } /*******************************************************/ /* RequestChunk: Allocates memory by returning a chunk */ /* of memory from a larger block of memory. */ /*******************************************************/ globle void *RequestChunk( void *theEnv, unsigned int requestSize) { struct chunkInfo *chunkPtr; struct blockInfo *blockPtr; /*==================================================*/ /* Allocate initial memory pool block if it has not */ /* already been allocated. */ /*==================================================*/ if (MemoryData(theEnv)->BlockMemoryInitialized == FALSE) { if (InitializeBlockMemory(theEnv,requestSize) == 0) return(NULL); } /*====================================================*/ /* Make sure that the amount of memory requested will */ /* fall on a boundary of strictest alignment */ /*====================================================*/ requestSize = (((requestSize - 1) / STRICT_ALIGN_SIZE) + 1) * STRICT_ALIGN_SIZE; /*=====================================================*/ /* Search through the list of free memory for a block */ /* of the appropriate size. If a block is found, then */ /* allocate and return a pointer to it. */ /*=====================================================*/ blockPtr = MemoryData(theEnv)->TopMemoryBlock; while (blockPtr != NULL) { chunkPtr = blockPtr->nextFree; while (chunkPtr != NULL) { if ((chunkPtr->size == requestSize) || (chunkPtr->size > (requestSize + MemoryData(theEnv)->ChunkInfoSize))) { AllocateChunk(theEnv,blockPtr,chunkPtr,requestSize); return((void *) (((char *) chunkPtr) + MemoryData(theEnv)->ChunkInfoSize)); } chunkPtr = chunkPtr->nextFree; } if (blockPtr->nextBlock == NULL) { if (AllocateBlock(theEnv,blockPtr,requestSize) == 0) /* get another block */ { return(NULL); } } blockPtr = blockPtr->nextBlock; } SystemError(theEnv,"MEMORY",2); EnvExitRouter(theEnv,EXIT_FAILURE); return(NULL); /* Unreachable, but prevents warning. */ } /********************************************/ /* AllocateChunk: Allocates a chunk from an */ /* existing chunk in a block of memory. */ /********************************************/ static void AllocateChunk( void *theEnv, struct blockInfo *parentBlock, struct chunkInfo *chunkPtr, unsigned int requestSize) { struct chunkInfo *splitChunk, *nextChunk; /*=============================================================*/ /* If the size of the memory chunk is an exact match for the */ /* requested amount of memory, then the chunk can be allocated */ /* without splitting it. */ /*=============================================================*/ if (requestSize == chunkPtr->size) { chunkPtr->size = - (long int) requestSize; if (chunkPtr->lastFree == NULL) { if (chunkPtr->nextFree != NULL) { parentBlock->nextFree = chunkPtr->nextFree; } else { parentBlock->nextFree = NULL; } } else { chunkPtr->lastFree->nextFree = chunkPtr->nextFree; } if (chunkPtr->nextFree != NULL) { chunkPtr->nextFree->lastFree = chunkPtr->lastFree; } chunkPtr->lastFree = NULL; chunkPtr->nextFree = NULL; return; } /*===========================================================*/ /* If the size of the memory chunk is larger than the memory */ /* request, then split the chunk into two pieces. */ /*===========================================================*/ nextChunk = (struct chunkInfo *) (((char *) chunkPtr) + MemoryData(theEnv)->ChunkInfoSize + chunkPtr->size); splitChunk = (struct chunkInfo *) (((char *) chunkPtr) + (MemoryData(theEnv)->ChunkInfoSize + requestSize)); splitChunk->size = (long) (chunkPtr->size - (requestSize + MemoryData(theEnv)->ChunkInfoSize)); splitChunk->prevChunk = chunkPtr; splitChunk->nextFree = chunkPtr->nextFree; splitChunk->lastFree = chunkPtr->lastFree; nextChunk->prevChunk = splitChunk; if (splitChunk->lastFree == NULL) { parentBlock->nextFree = splitChunk; } else { splitChunk->lastFree->nextFree = splitChunk; } if (splitChunk->nextFree != NULL) { splitChunk->nextFree->lastFree = splitChunk; } chunkPtr->size = - (long int) requestSize; chunkPtr->lastFree = NULL; chunkPtr->nextFree = NULL; return; } /***********************************************************/ /* ReturnChunk: Frees memory allocated using RequestChunk. */ /***********************************************************/ globle int ReturnChunk( void *theEnv, void *memPtr, unsigned int size) { struct chunkInfo *chunkPtr, *lastChunk, *nextChunk, *topChunk; struct blockInfo *blockPtr; /*=====================================================*/ /* Determine if the expected size of the chunk matches */ /* the size stored in the chunk's information record. */ /*=====================================================*/ size = (((size - 1) / STRICT_ALIGN_SIZE) + 1) * STRICT_ALIGN_SIZE; chunkPtr = (struct chunkInfo *) (((char *) memPtr) - MemoryData(theEnv)->ChunkInfoSize); if (chunkPtr == NULL) { return(FALSE); } if (chunkPtr->size >= 0) { return(FALSE); } if (chunkPtr->size != - (long int) size) { return(FALSE); } chunkPtr->size = - chunkPtr->size; /*=============================================*/ /* Determine in which block the chunk resides. */ /*=============================================*/ topChunk = chunkPtr; while (topChunk->prevChunk != NULL) { topChunk = topChunk->prevChunk; } blockPtr = (struct blockInfo *) (((char *) topChunk) - MemoryData(theEnv)->BlockInfoSize); /*===========================================*/ /* Determine the chunks physically preceding */ /* and following the returned chunk. */ /*===========================================*/ lastChunk = chunkPtr->prevChunk; nextChunk = (struct chunkInfo *) (((char *) memPtr) + size); /*=========================================================*/ /* Add the chunk to the list of free chunks for the block. */ /*=========================================================*/ if (blockPtr->nextFree != NULL) { blockPtr->nextFree->lastFree = chunkPtr; } chunkPtr->nextFree = blockPtr->nextFree; chunkPtr->lastFree = NULL; blockPtr->nextFree = chunkPtr; /*=====================================================*/ /* Combine this chunk with previous chunk if possible. */ /*=====================================================*/ if (lastChunk != NULL) { if (lastChunk->size > 0) { lastChunk->size += (MemoryData(theEnv)->ChunkInfoSize + chunkPtr->size); if (nextChunk != NULL) { nextChunk->prevChunk = lastChunk; } else { return(FALSE); } if (lastChunk->lastFree != NULL) { lastChunk->lastFree->nextFree = lastChunk->nextFree; } if (lastChunk->nextFree != NULL) { lastChunk->nextFree->lastFree = lastChunk->lastFree; } lastChunk->nextFree = chunkPtr->nextFree; if (chunkPtr->nextFree != NULL) { chunkPtr->nextFree->lastFree = lastChunk; } lastChunk->lastFree = NULL; blockPtr->nextFree = lastChunk; chunkPtr->lastFree = NULL; chunkPtr->nextFree = NULL; chunkPtr = lastChunk; } } /*=====================================================*/ /* Combine this chunk with the next chunk if possible. */ /*=====================================================*/ if (nextChunk == NULL) return(FALSE); if (chunkPtr == NULL) return(FALSE); if (nextChunk->size > 0) { chunkPtr->size += (MemoryData(theEnv)->ChunkInfoSize + nextChunk->size); topChunk = (struct chunkInfo *) (((char *) nextChunk) + nextChunk->size + MemoryData(theEnv)->ChunkInfoSize); if (topChunk != NULL) { topChunk->prevChunk = chunkPtr; } else { return(FALSE); } if (nextChunk->lastFree != NULL) { nextChunk->lastFree->nextFree = nextChunk->nextFree; } if (nextChunk->nextFree != NULL) { nextChunk->nextFree->lastFree = nextChunk->lastFree; } } /*===========================================*/ /* Free the buffer if we can, but don't free */ /* the first buffer if it's the only one. */ /*===========================================*/ if ((chunkPtr->prevChunk == NULL) && (chunkPtr->size == blockPtr->size)) { if (blockPtr->prevBlock != NULL) { blockPtr->prevBlock->nextBlock = blockPtr->nextBlock; if (blockPtr->nextBlock != NULL) { blockPtr->nextBlock->prevBlock = blockPtr->prevBlock; } free((char *) blockPtr); } else { if (blockPtr->nextBlock != NULL) { blockPtr->nextBlock->prevBlock = NULL; MemoryData(theEnv)->TopMemoryBlock = blockPtr->nextBlock; free((char *) blockPtr); } } } return(TRUE); } /***********************************************/ /* ReturnAllBlocks: Frees all allocated blocks */ /* back to the operating system. */ /***********************************************/ globle void ReturnAllBlocks( void *theEnv) { struct blockInfo *theBlock, *nextBlock; struct longMemoryPtr *theLongMemory, *nextLongMemory; /*======================================*/ /* Free up int based memory allocation. */ /*======================================*/ theBlock = MemoryData(theEnv)->TopMemoryBlock; while (theBlock != NULL) { nextBlock = theBlock->nextBlock; free((char *) theBlock); theBlock = nextBlock; } MemoryData(theEnv)->TopMemoryBlock = NULL; /*=======================================*/ /* Free up long based memory allocation. */ /*=======================================*/ theLongMemory = MemoryData(theEnv)->TopLongMemoryPtr; while (theLongMemory != NULL) { nextLongMemory = theLongMemory->next; genlongfree(theEnv,theLongMemory,(unsigned long) theLongMemory->size); theLongMemory = nextLongMemory; } MemoryData(theEnv)->TopLongMemoryPtr = NULL; } #endif clips-6.24/clipssrc/._edterm.c0000400000175000017500000000061410441163316014356 0ustar jfsjfsMac OS X  2 R:TEXT???? 22/B2MWBB clips-6.24/clipssrc/._inscom.h0000400000175000017500000000075410441147443014403 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z9S,,TTFS FMWBBMPSRclips-6.24/clipssrc/._genrcfun.c0000400000175000017500000000075410441143546014715 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco B B1yyTTFS FMWBBMPSRclips-6.24/clipssrc/._inspsr.c0000400000175000017500000000075410441147610014420 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco9p#q9p#q9>Q>d7TTFLbFMWBBMPSRclips-6.24/clipssrc/modulbin.h0000755000175000017500000000457207422635020014524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFMODULE BSAVE/BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_modulbin #define _H_modulbin #ifndef _H_moduldef #include "moduldef.h" #endif struct bsaveDefmodule { unsigned long name; long importList; long exportList; long next; long bsaveID; }; struct bsaveDefmoduleItemHeader { long theModule; long firstItem; long lastItem; }; struct bsavePortItem { long moduleName; long constructType; long constructName; long next; }; #define ModulePointer(i) ((struct defmodule *) (&DefmoduleData(theEnv)->DefmoduleArray[i])) #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefmoduleBinarySetup(void *); LOCALE void UpdateDefmoduleItemHeader (void *,struct bsaveDefmoduleItemHeader *, struct defmoduleItemHeader *,int,void *); #if BLOAD_AND_BSAVE LOCALE void AssignBsaveDefmdlItemHdrVals (struct bsaveDefmoduleItemHeader *, struct defmoduleItemHeader *); #endif #endif clips-6.24/clipssrc/factmch.c0000755000175000017500000007722410441143364014317 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* FACT MATCH MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the algorithm for pattern matching in */ /* the fact pattern network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _FACTMCH_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "extnfunc.h" #include "factgen.h" #include "factrete.h" #include "incrrset.h" #include "memalloc.h" #include "reteutil.h" #include "router.h" #include "tmpltdef.h" #include "factmch.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool EvaluatePatternExpression(void *,struct factPatternNode *,struct expr *,int); static void TraceErrorToJoin(void *,struct factPatternNode *,int); static void ProcessFactAlphaMatch(void *,struct fact *,struct multifieldMarker *,struct factPatternNode *); static struct factPatternNode *GetNextFactPatternNode(void *,int,struct factPatternNode *); static int SkipFactPatternNode(void *,struct factPatternNode *); static void ProcessMultifieldNode(void *, struct factPatternNode *, struct multifieldMarker *, struct multifieldMarker *,int); static void PatternNetErrorMessage(void *,struct factPatternNode *); /*************************************************************************/ /* FactPatternMatch: Implements the core loop for fact pattern matching. */ /*************************************************************************/ globle void FactPatternMatch( void *theEnv, struct fact *theFact, struct factPatternNode *patternPtr, int offset, struct multifieldMarker *markers, struct multifieldMarker *endMark) { int theSlotField; int offsetSlot; /*=========================================================*/ /* If there's nothing left in the pattern network to match */ /* against, then the current traversal of the pattern */ /* network needs to back up. */ /*=========================================================*/ if (patternPtr == NULL) return; /*=======================================================*/ /* The offsetSlot variable indicates the current offset */ /* within the multifield slot being pattern matched. */ /* (Recall that a multifield wildcard or variable */ /* recursively iterates through all possible bindings.) */ /* Once a new slot starts being pattern matched, the */ /* offset is reset to zero. */ /*=======================================================*/ offsetSlot = patternPtr->whichSlot; /*================================================*/ /* Set up some global parameters for use by the */ /* Rete access functions and general convenience. */ /*================================================*/ FactData(theEnv)->CurrentPatternFact = theFact; FactData(theEnv)->CurrentPatternMarks = markers; /*============================================*/ /* Loop through each node in pattern network. */ /*============================================*/ while (patternPtr != NULL) { /*=============================================================*/ /* Determine the position of the field we're going to pattern */ /* match. If this routine has been entered recursively because */ /* of multifield wildcards or variables, then add in the */ /* additional offset caused by the values which match these */ /* multifields. This offset may be negative (if for example a */ /* a multifield matched a zero length value). */ /*=============================================================*/ theSlotField = patternPtr->whichField; if (offsetSlot == patternPtr->whichSlot) { theSlotField += offset; } /*===================================*/ /* Determine if we want to skip this */ /* node during an incremental reset. */ /*===================================*/ if (SkipFactPatternNode(theEnv,patternPtr)) { patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } /*=========================================================*/ /* If this is a single field pattern node, then determine */ /* if the constraints for the node have been satisfied for */ /* the current field in the slot being examined. */ /*=========================================================*/ else if (patternPtr->header.singlefieldNode) { /*==================================================*/ /* If we're at the last slot in the pattern, make */ /* sure the number of fields in the fact correspond */ /* to the number of fields required by the pattern */ /* based on the binding of multifield variables. */ /*==================================================*/ int skipit = FALSE; if (patternPtr->header.endSlot && ((FactData(theEnv)->CurrentPatternMarks == NULL) ? FALSE : (FactData(theEnv)->CurrentPatternMarks->where.whichSlotNumber == patternPtr->whichSlot)) && (FactData(theEnv)->CurrentPatternFact->theProposition.theFields [patternPtr->whichSlot].type == MULTIFIELD)) { if ((patternPtr->leaveFields + theSlotField) != (int) ((struct multifield *) FactData(theEnv)->CurrentPatternFact->theProposition.theFields [patternPtr->whichSlot].value)->multifieldLength) { skipit = TRUE; } } if (skipit) { patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } else /*=============================================*/ /* If the constraints are satisified, then ... */ /*=============================================*/ if (EvaluatePatternExpression(theEnv,patternPtr, patternPtr->networkTest, theSlotField)) { /*=======================================================*/ /* 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 (patternPtr->header.stopNode) { ProcessFactAlphaMatch(theEnv,theFact,markers,patternPtr); } /*===================================*/ /* Move on to the next pattern node. */ /*===================================*/ patternPtr = GetNextFactPatternNode(theEnv,FALSE,patternPtr); } /*==============================================*/ /* Otherwise, move on to the next pattern node. */ /*==============================================*/ else { patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } } /*======================================================*/ /* If this is a multifield pattern node, then determine */ /* if the constraints for the node have been satisfied */ /* for the current field in the slot being examined. */ /*======================================================*/ else if (patternPtr->header.multifieldNode) { /*========================================================*/ /* Determine if the multifield pattern node's constraints */ /* are satisfied. If we've traversed to a different slot */ /* than the one we started this routine with, then the */ /* offset into the slot is reset to zero. */ /*========================================================*/ if (offsetSlot == patternPtr->whichSlot) { ProcessMultifieldNode(theEnv,patternPtr,markers,endMark,offset); } else { ProcessMultifieldNode(theEnv,patternPtr,markers,endMark,0); } /*===================================================*/ /* Move on to the next pattern node. Since the lower */ /* branches of the pattern network have already been */ /* recursively processed by ProcessMultifieldNode, */ /* we get the next pattern node by treating this */ /* multifield pattern node as if it were a single */ /* field pattern node that failed its constraint. */ /*===================================================*/ patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); } } } /**************************************************************/ /* ProcessMultifieldNode: Handles recursive pattern matching */ /* when a multifield wildcard or variable is encountered as */ /* a slot constraint. The pattern matching routine is called */ /* iteratively for each possible binding of the multifield */ /* wildcard or variable. */ /**************************************************************/ 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; /*========================================*/ /* 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->networkTest == NULL) ? TRUE : (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest, (int) thePattern->whichField + offset))) { /*=======================================================*/ /* 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->networkTest == NULL) ? TRUE : (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest, (int) thePattern->whichField + offset))) { 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; } /******************************************************/ /* GetNextFactPatternNode: Returns the next node in a */ /* pattern network tree to be traversed. The next */ /* node is computed using a depth first traversal. */ /******************************************************/ static struct factPatternNode *GetNextFactPatternNode( void *theEnv, int finishedMatching, struct factPatternNode *thePattern) { EvaluationData(theEnv)->EvaluationError = FALSE; /*===================================================*/ /* If pattern matching was successful at the current */ /* node in the tree and it's possible to go deeper */ /* into the tree, then move down to the next level. */ /*===================================================*/ if (finishedMatching == FALSE) { if (thePattern->nextLevel != NULL) return(thePattern->nextLevel); } /*================================================*/ /* Keep backing up toward the root of the pattern */ /* network until a side branch can be taken. */ /*================================================*/ while (thePattern->rightNode == NULL) { /*========================================*/ /* Back up to check the next side branch. */ /*========================================*/ thePattern = thePattern->lastLevel; /*======================================*/ /* If we branched up from the root, the */ /* entire tree has been traversed. */ /*======================================*/ if (thePattern == NULL) return(NULL); /*===================================================*/ /* If we branched up to a multifield node, then stop */ /* since these nodes are handled recursively. The */ /* previous call to the pattern matching algorithm */ /* on the stack will handle backing up to the nodes */ /* above the multifield node in the pattern network. */ /*===================================================*/ if (thePattern->header.multifieldNode) return(NULL); } /*==================================*/ /* Move on to the next side branch. */ /*==================================*/ return(thePattern->rightNode); } /*******************************************************/ /* ProcessFactAlphaMatch: When a fact pattern has been */ /* satisfied, this routine creates an alpha match to */ /* store in the pattern network and then sends the */ /* new alpha match through the join network. */ /*******************************************************/ static void ProcessFactAlphaMatch( void *theEnv, struct fact *theFact, struct multifieldMarker *theMarks, struct factPatternNode *thePattern) { struct partialMatch *theMatch; struct patternMatch *listOfMatches; struct joinNode *listOfJoins; /*===========================================*/ /* Create the partial match for the pattern. */ /*===========================================*/ theMatch = CreateAlphaMatch(theEnv,theFact,theMarks,(struct patternNodeHeader *) &thePattern->header); /*=======================================================*/ /* Add the pattern to the list of matches for this fact. */ /*=======================================================*/ listOfMatches = (struct patternMatch *) theFact->list; theFact->list = (void *) get_struct(theEnv,patternMatch); ((struct patternMatch *) theFact->list)->next = listOfMatches; ((struct patternMatch *) theFact->list)->matchingPattern = (struct patternNodeHeader *) thePattern; ((struct patternMatch *) theFact->list)->theMatch = theMatch; /*================================================================*/ /* Send the partial match to the joins connected to this pattern. */ /*================================================================*/ for (listOfJoins = thePattern->header.entryJoin; listOfJoins != NULL; listOfJoins = listOfJoins->rightMatchNode) { NetworkAssert(theEnv,theMatch,listOfJoins,RHS); } } /*****************************************************************/ /* EvaluatePatternExpression: Performs a faster evaluation for */ /* fact pattern network expressions than if EvaluateExpression */ /* were used directly. */ /*****************************************************************/ static int EvaluatePatternExpression( void *theEnv, struct factPatternNode *patternPtr, struct expr *theTest, int thePosition) { DATA_OBJECT theResult; struct expr *oldArgument; int rv; /*=====================================*/ /* A pattern node without a constraint */ /* is always satisfied. */ /*=====================================*/ if (theTest == NULL) return(TRUE); /*======================================*/ /* Evaluate pattern network primitives. */ /*======================================*/ switch(theTest->type) { /*==============================================*/ /* This primitive compares the value stored in */ /* a single field slot to a constant for either */ /* equality or inequality. */ /*==============================================*/ case FACT_PN_CONSTANT1: oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = theTest; rv = FactPNConstant1(theEnv,theTest->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; return(rv); /*=============================================*/ /* This primitive compares the value stored in */ /* a multifield slot to a constant for either */ /* equality or inequality. */ /*=============================================*/ case FACT_PN_CONSTANT2: oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = theTest; rv = FactPNConstant2(theEnv,theTest->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; return(rv); /*================================================*/ /* This primitive determines if a multifield slot */ /* contains at least a certain number of fields. */ /*================================================*/ case FACT_SLOT_LENGTH: oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = theTest; rv = FactSlotLength(theEnv,theTest->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; return(rv); } /*==============================================*/ /* Evaluate "or" expressions by evaluating each */ /* argument and return TRUE if any of them */ /* evaluated to TRUE, otherwise return FALSE. */ /*==============================================*/ if (theTest->value == ExpressionData(theEnv)->PTR_OR) { for (theTest = theTest->argList; theTest != NULL; theTest = theTest->nextArg) { if (EvaluatePatternExpression(theEnv,patternPtr,theTest,thePosition) == TRUE) { if (EvaluationData(theEnv)->EvaluationError) return(FALSE); return(TRUE); } if (EvaluationData(theEnv)->EvaluationError) return(FALSE); } return(FALSE); } /*===============================================*/ /* Evaluate "and" expressions by evaluating each */ /* argument and return FALSE if any of them */ /* evaluated to FALSE, otherwise return TRUE. */ /*===============================================*/ else if (theTest->value == ExpressionData(theEnv)->PTR_AND) { for (theTest = theTest->argList; theTest != NULL; theTest = theTest->nextArg) { if (EvaluatePatternExpression(theEnv,patternPtr,theTest,thePosition) == FALSE) { return(FALSE); } if (EvaluationData(theEnv)->EvaluationError) return(FALSE); } return(TRUE); } /*==========================================================*/ /* Evaluate all other expressions using EvaluateExpression. */ /*==========================================================*/ if (EvaluateExpression(theEnv,theTest,&theResult)) { PatternNetErrorMessage(theEnv,patternPtr); return(FALSE); } if ((theResult.value == EnvFalseSymbol(theEnv)) && (theResult.type == SYMBOL)) { return(FALSE); } return(TRUE); } /************************************************************************/ /* PatternNetErrorMessage: Prints the informational header to the error */ /* message that occurs when a error occurs as the result of */ /* evaluating an expression in the fact pattern network. Prints the */ /* fact currently being pattern matched and the field number or slot */ /* name in the pattern from which the error originated. The error is */ /* then trace to the point where the pattern enters the join network */ /* so that the names of the rule which utilize the pattern can also */ /* be printed. */ /************************************************************************/ static void PatternNetErrorMessage( void *theEnv, struct factPatternNode *patternPtr) { char buffer[60]; struct templateSlot *theSlots; int i; /*=======================================*/ /* Print the fact being pattern matched. */ /*=======================================*/ PrintErrorID(theEnv,"FACTMCH",1,TRUE); EnvPrintRouter(theEnv,WERROR,"This error occurred in the fact pattern network\n"); EnvPrintRouter(theEnv,WERROR," Currently active fact: "); PrintFact(theEnv,WERROR,FactData(theEnv)->CurrentPatternFact,FALSE,FALSE); EnvPrintRouter(theEnv,WERROR,"\n"); /*==============================================*/ /* Print the field position or slot name of the */ /* pattern from which the error originated. */ /*==============================================*/ if (FactData(theEnv)->CurrentPatternFact->whichDeftemplate->implied) { sprintf(buffer," Problem resides in field #%d\n",patternPtr->whichField); } else { theSlots = FactData(theEnv)->CurrentPatternFact->whichDeftemplate->slotList; for (i = 0; i < (int) patternPtr->whichSlot; i++) theSlots = theSlots->next; sprintf(buffer," Problem resides in slot %s\n",ValueToString(theSlots->slotName)); } EnvPrintRouter(theEnv,WERROR,buffer); /*==========================================================*/ /* Trace the pattern to its entry point to the join network */ /* (which then traces to the defrule data structure so that */ /* the name(s) of the rule(s) utilizing the patterns can be */ /* printed). */ /*==========================================================*/ TraceErrorToJoin(theEnv,patternPtr,FALSE); EnvPrintRouter(theEnv,WERROR,"\n"); } /***************************************************************************/ /* TraceErrorToJoin: Traces the cause of an evaluation error which occured */ /* in the fact pattern network to the entry join in the join network for */ /* the pattern from which the error originated. Once the entry join is */ /* reached, the error is then traced to the defrule data structures so */ /* that the name of the rule(s) containing the pattern can be printed. */ /***************************************************************************/ static void TraceErrorToJoin( void *theEnv, struct factPatternNode *patternPtr, int traceRight) { struct joinNode *joinPtr; char buffer[60]; while (patternPtr != NULL) { if (patternPtr->header.stopNode) { for (joinPtr = patternPtr->header.entryJoin; joinPtr != NULL; joinPtr = joinPtr->rightMatchNode) { sprintf(buffer," Of pattern #%d in rule(s):\n",GetPatternNumberFromJoin(joinPtr)); EnvPrintRouter(theEnv,WERROR,buffer); TraceErrorToRule(theEnv,joinPtr," "); } } else { TraceErrorToJoin(theEnv,patternPtr->nextLevel,TRUE); } if (traceRight) patternPtr = patternPtr->rightNode; else patternPtr = NULL; } } /***********************************************************************/ /* SkipFactPatternNode: During an incremental reset, only fact pattern */ /* nodes associated with new patterns are traversed. Given a pattern */ /* node, this routine will return TRUE if the pattern node should be */ /* traversed during incremental reset pattern matching or FALSE if */ /* the node should be skipped. */ /***********************************************************************/ static int SkipFactPatternNode( void *theEnv, struct factPatternNode *thePattern) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,thePattern) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) if (EngineData(theEnv)->IncrementalResetInProgress && (thePattern->header.initialize == FALSE)) { return(TRUE); } #endif return(FALSE); } /***************************************************************/ /* MarkFactPatternForIncrementalReset: Sets the initialization */ /* field of a fact pattern for use with incremental reset. */ /* This is called before an incremental reset for newly added */ /* patterns to indicate that the pattern nodes should be */ /* traversed and then after an incremental reset to indicate */ /* that the nodes were traversed ("initialized") by the */ /* incremental reset. */ /***************************************************************/ #if IBM_TBC #pragma argsused #endif globle void MarkFactPatternForIncrementalReset( void *theEnv, struct patternNodeHeader *thePattern, int value) { struct factPatternNode *patternPtr = (struct factPatternNode *) thePattern; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif /*=====================================*/ /* We should be passed a valid pointer */ /* to a fact pattern network node. */ /*=====================================*/ Bogus(patternPtr == NULL); /*============================================*/ /* If the pattern was previously initialized, */ /* then don't bother with it. */ /*============================================*/ if (patternPtr->header.initialize == FALSE) return; /*======================================================*/ /* Set the initialization field of this pattern network */ /* node and all pattern network nodes which preceed it. */ /*======================================================*/ while (patternPtr != NULL) { patternPtr->header.initialize = value; patternPtr = patternPtr->lastLevel; } } /**************************************************************/ /* FactsIncrementalReset: Incremental reset function for the */ /* fact pattern network. Asserts all facts in the fact-list */ /* so that they repeat the pattern matching process. During */ /* an incremental reset, newly added patterns should be the */ /* only active patterns in the fact pattern network. */ /**************************************************************/ globle void FactsIncrementalReset( void *theEnv) { struct fact *factPtr; for (factPtr = (struct fact *) EnvGetNextFact(theEnv,NULL); factPtr != NULL; factPtr = (struct fact *) EnvGetNextFact(theEnv,factPtr)) { FactPatternMatch(theEnv,factPtr, factPtr->whichDeftemplate->patternNetwork, 0,NULL,NULL); } } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._bload.c0000400000175000017500000000075410441127716014170 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacoww,,TTF/BFMPSRMWBBLclips-6.24/clipssrc/._pattern.h0000400000175000017500000000452210441150475014564 0ustar jfsjfsMac OS X  2 R TEXTR*ch`an pattern.hhrol PanelTCmr.txt.docTEXTR*ch p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco00;mnS VnGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/cstrnbin.h0000755000175000017500000000402207422634707014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* CONSTRAINT BLOAD/BSAVE/CONSTRUCTS-TO-C HEADER */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for */ /* constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrnbin #define _H_cstrnbin #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define ConstraintIndex(theConstraint) (((! EnvGetDynamicConstraintChecking(theEnv)) || (theConstraint == NULL)) ? -1L : ((long) theConstraint->bsaveIndex)) #define ConstraintPointer(i) (((i) == -1L) ? NULL : (CONSTRAINT_RECORD *) &ConstraintData(theEnv)->ConstraintArray[i]) #if BLOAD_AND_BSAVE LOCALE void WriteNeededConstraints(void *,FILE *); #endif LOCALE void ReadNeededConstraints(void *); LOCALE void ClearBloadedConstraints(void *); #endif clips-6.24/clipssrc/._cstrnpsr.h0000400000175000017500000000075410441131522014760 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco,v1x,v1xTTFS ]FMWBBMPSRclips-6.24/clipssrc/cstrccom.c0000755000175000017500000016014110443377275014532 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRUCT COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains generic routines for deleting, pretty */ /* printing, finding, obtaining module information, */ /* obtaining lists of constructs, listing constructs, and */ /* manipulation routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Modified GetConstructList to remove buffer */ /* overflow problem with large construct/module */ /* names. DR0858 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Corrected an error when compiling as a C++ */ /* file. DR0868 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added ConstructsDeletable function. */ /* */ /*************************************************************/ #define _CSTRCCOM_SOURCE_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "moduldef.h" #include "argacces.h" #include "multifld.h" #include "modulutl.h" #include "router.h" #include "utility.h" #include "commline.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) #include "cstrcpsr.h" #endif #include "cstrccom.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if DEBUGGING_FUNCTIONS static void ConstructPrintWatch(void *,char *,struct construct *,void *, unsigned (*)(void *,void *)); static unsigned ConstructWatchSupport(void *,struct construct *,char *, char *,EXPRESSION *,intBool, unsigned,unsigned (*)(void *,void *), void (*)(void *,unsigned,void *)); #endif #if (! RUN_TIME) /************************************/ /* AddConstructToModule: Adds a */ /* construct to the current module. */ /************************************/ globle void AddConstructToModule( struct constructHeader *theConstruct) { if (theConstruct->whichModule->lastItem == NULL) { theConstruct->whichModule->firstItem = theConstruct; } else { theConstruct->whichModule->lastItem->next = theConstruct; } theConstruct->whichModule->lastItem = theConstruct; theConstruct->next = NULL; } #endif /* (! RUN_TIME) */ /****************************************************/ /* DeleteNamedConstruct: Generic driver routine for */ /* deleting a specific construct from a module. */ /****************************************************/ globle intBool DeleteNamedConstruct( void *theEnv, char *constructName, struct construct *constructClass) { #if (! BLOAD_ONLY) void *constructPtr; /*=============================*/ /* Constructs can't be deleted */ /* while a bload is in effect. */ /*=============================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif /*===============================*/ /* Look for the named construct. */ /*===============================*/ constructPtr = (*constructClass->findFunction)(theEnv,constructName); /*========================================*/ /* If the construct was found, delete it. */ /*========================================*/ if (constructPtr != NULL) { return((*constructClass->deleteFunction)(theEnv,constructPtr)); } /*========================================*/ /* If the construct wasn't found, but the */ /* special symbol * was used, then delete */ /* all constructs of the specified type. */ /*========================================*/ if (strcmp("*",constructName) == 0) { (*constructClass->deleteFunction)(theEnv,NULL); return(TRUE); } /*===============================*/ /* Otherwise, return FALSE to */ /* indicate no deletion occured. */ /*===============================*/ return(FALSE); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv,constructName,constructClass) #endif return(FALSE); #endif } /*******************************************/ /* FindNamedConstruct: Generic routine for */ /* searching for a specified construct. */ /*******************************************/ globle void *FindNamedConstruct( void *theEnv, char *constructName, struct construct *constructClass) { void *theConstruct; SYMBOL_HN *findValue; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=========================================================*/ /* Extract the construct name. If a module was specified, */ /* then ExtractModuleAndConstructName will set the current */ /* module to the module specified in the name. */ /*=========================================================*/ constructName = ExtractModuleAndConstructName(theEnv,constructName); /*=================================================*/ /* If a valid construct name couldn't be extracted */ /* or the construct name isn't in the symbol table */ /* (which means the construct doesn't exist), then */ /* return NULL to indicate the specified construct */ /* couldn't be found. */ /*=================================================*/ if ((constructName == NULL) ? TRUE : ((findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,constructName)) == NULL)) { RestoreCurrentModule(theEnv); return(NULL); } /*===============================================*/ /* Loop through every construct of the specified */ /* class in the current module checking to see */ /* if the construct's name matches the construct */ /* being sought. If found, restore the current */ /* module and return a pointer to the construct. */ /*===============================================*/ for (theConstruct = (*constructClass->getNextItemFunction)(theEnv,NULL); theConstruct != NULL; theConstruct = (*constructClass->getNextItemFunction)(theEnv,theConstruct)) { if (findValue == (*constructClass->getConstructNameFunction)((struct constructHeader *) theConstruct)) { RestoreCurrentModule(theEnv); return (theConstruct); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*====================================*/ /* Return NULL to indicated the named */ /* construct was not found. */ /*====================================*/ return(NULL); } /*****************************************/ /* UndefconstructCommand: Driver routine */ /* for the undef commands. */ /*****************************************/ globle void UndefconstructCommand( void *theEnv, char *command, struct construct *constructClass) { char *constructName; char buffer[80]; /*==============================================*/ /* Get the name of the construct to be deleted. */ /*==============================================*/ sprintf(buffer,"%s name",constructClass->constructName); constructName = GetConstructName(theEnv,command,buffer); if (constructName == NULL) return; #if (! RUN_TIME) && (! BLOAD_ONLY) /*=============================================*/ /* Check to see if the named construct exists. */ /*=============================================*/ if (((*constructClass->findFunction)(theEnv,constructName) == NULL) && (strcmp("*",constructName) != 0)) { CantFindItemErrorMessage(theEnv,constructClass->constructName,constructName); return; } /*===============================================*/ /* If the construct does exist, try deleting it. */ /*===============================================*/ else if (DeleteNamedConstruct(theEnv,constructName,constructClass) == FALSE) { CantDeleteItemErrorMessage(theEnv,constructClass->constructName,constructName); return; } return; #else /*=====================================*/ /* Constructs can't be deleted in a */ /* run-time or bload only environment. */ /*=====================================*/ CantDeleteItemErrorMessage(theEnv,constructClass->constructName,constructName); return; #endif } /******************************************/ /* PPConstructCommand: Driver routine for */ /* the ppdef commands. */ /******************************************/ globle void PPConstructCommand( void *theEnv, char *command, struct construct *constructClass) { char *constructName; char buffer[80]; /*===============================*/ /* Get the name of the construct */ /* to be "pretty printed." */ /*===============================*/ sprintf(buffer,"%s name",constructClass->constructName); constructName = GetConstructName(theEnv,command,buffer); if (constructName == NULL) return; /*================================*/ /* Call the driver routine for */ /* pretty printing the construct. */ /*================================*/ if (PPConstruct(theEnv,constructName,WDISPLAY,constructClass) == FALSE) { CantFindItemErrorMessage(theEnv,constructClass->constructName,constructName); } } /***********************************/ /* PPConstruct: Driver routine for */ /* pretty printing a construct. */ /***********************************/ globle int PPConstruct( void *theEnv, char *constructName, char *logicalName, struct construct *constructClass) { void *constructPtr; /*==================================*/ /* Use the construct's name to find */ /* a pointer to actual construct. */ /*==================================*/ constructPtr = (*constructClass->findFunction)(theEnv,constructName); if (constructPtr == NULL) return(FALSE); /*==============================================*/ /* If the pretty print form is NULL (because of */ /* conserve-mem), return TRUE (which indicates */ /* the construct was found). */ /*==============================================*/ if ((*constructClass->getPPFormFunction)(theEnv,(struct constructHeader *) constructPtr) == NULL) { return(TRUE); } /*============================================*/ /* Print the pretty print string in smaller */ /* chunks. (VMS had a bug that didn't allow */ /* printing a string greater than 512 bytes.) */ /*============================================*/ PrintInChunks(theEnv,logicalName,(*constructClass->getPPFormFunction)(theEnv,(struct constructHeader *) constructPtr)); /*=======================================*/ /* Return TRUE to indicate the construct */ /* was found and pretty printed. */ /*=======================================*/ return(TRUE); } /*********************************************/ /* GetConstructModuleCommand: Driver routine */ /* for def-module routines */ /*********************************************/ globle SYMBOL_HN *GetConstructModuleCommand( void *theEnv, char *command, struct construct *constructClass) { char *constructName; char buffer[80]; struct defmodule *constructModule; /*=========================================*/ /* Get the name of the construct for which */ /* we want to determine its module. */ /*=========================================*/ sprintf(buffer,"%s name",constructClass->constructName); constructName = GetConstructName(theEnv,command,buffer); if (constructName == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); /*==========================================*/ /* Get a pointer to the construct's module. */ /*==========================================*/ constructModule = GetConstructModule(theEnv,constructName,constructClass); if (constructModule == NULL) { CantFindItemErrorMessage(theEnv,constructClass->constructName,constructName); return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); } /*============================================*/ /* Return the name of the construct's module. */ /*============================================*/ return(constructModule->name); } /******************************************/ /* GetConstructModule: Driver routine for */ /* getting the module for a construct */ /******************************************/ globle struct defmodule *GetConstructModule( void *theEnv, char *constructName, struct construct *constructClass) { struct constructHeader *constructPtr; int count; unsigned position; SYMBOL_HN *theName; /*====================================================*/ /* If the construct name contains a module specifier, */ /* then get a pointer to the defmodule associated */ /* with the specified name. */ /*====================================================*/ if ((position = FindModuleSeparator(constructName)) != FALSE) { theName = ExtractModuleName(theEnv,position,constructName); if (theName != NULL) { return((struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theName))); } } /*============================================*/ /* No module was specified, so search for the */ /* named construct in the current module and */ /* modules from which it imports. */ /*============================================*/ constructPtr = (struct constructHeader *) FindImportedConstruct(theEnv,constructClass->constructName,NULL,constructName, &count,TRUE,NULL); if (constructPtr == NULL) return(NULL); return(constructPtr->whichModule->theModule); } /*************************************/ /* Undefconstruct: Generic C routine */ /* for deleting a construct. */ /*************************************/ globle intBool Undefconstruct( void *theEnv, void *theConstruct, struct construct *constructClass) { #if BLOAD_ONLY || RUN_TIME #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theConstruct) #pragma unused(constructClass) #pragma unused(theEnv) #endif return(FALSE); #else void *currentConstruct,*nextConstruct; intBool success; /*================================================*/ /* Delete all constructs of the specified type if */ /* the construct pointer is the NULL pointer. */ /*================================================*/ if (theConstruct == NULL) { success = TRUE; /*===================================================*/ /* Loop through all of the constructs in the module. */ /*===================================================*/ currentConstruct = (*constructClass->getNextItemFunction)(theEnv,NULL); while (currentConstruct != NULL) { /*==============================*/ /* Remember the next construct. */ /*==============================*/ nextConstruct = (*constructClass->getNextItemFunction)(theEnv,currentConstruct); /*=============================*/ /* Try deleting the construct. */ /*=============================*/ if ((*constructClass->isConstructDeletableFunction)(theEnv,currentConstruct)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) currentConstruct); (*constructClass->freeFunction)(theEnv,currentConstruct); } else { CantDeleteItemErrorMessage(theEnv,constructClass->constructName, ValueToString((*constructClass->getConstructNameFunction)((struct constructHeader *) currentConstruct))); success = FALSE; } /*================================*/ /* Move on to the next construct. */ /*================================*/ currentConstruct = nextConstruct; } /*=======================================*/ /* Perform periodic cleanup if embedded. */ /*=======================================*/ if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } /*============================================*/ /* Return TRUE if all constructs successfully */ /* deleted, otherwise FALSE. */ /*============================================*/ return(success); } /*==================================================*/ /* Return FALSE if the construct cannot be deleted. */ /*==================================================*/ if ((*constructClass->isConstructDeletableFunction)(theEnv,theConstruct) == FALSE) { return(FALSE); } /*===========================*/ /* Remove the construct from */ /* the list in its module. */ /*===========================*/ RemoveConstructFromModule(theEnv,(struct constructHeader *) theConstruct); /*=======================*/ /* Delete the construct. */ /*=======================*/ (*constructClass->freeFunction)(theEnv,theConstruct); /*=======================================*/ /* Perform periodic cleanup if embedded. */ /*=======================================*/ if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } /*=============================*/ /* Return TRUE to indicate the */ /* construct was deleted. */ /*=============================*/ return(TRUE); #endif } /***********************************/ /* SaveConstruct: Generic routine */ /* for saving a construct class. */ /***********************************/ globle void SaveConstruct( void *theEnv, void *theModule, char *logicalName, struct construct *constructClass) { char *ppform; struct constructHeader *theConstruct; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*===========================*/ /* Set the current module to */ /* the one we're examining. */ /*===========================*/ EnvSetCurrentModule(theEnv,theModule); /*==============================================*/ /* Loop through each construct of the specified */ /* construct class in the module. */ /*==============================================*/ for (theConstruct = (struct constructHeader *) (*constructClass->getNextItemFunction)(theEnv,NULL); theConstruct != NULL; theConstruct = (struct constructHeader *) (*constructClass->getNextItemFunction)(theEnv,theConstruct)) { /*==========================================*/ /* Print the construct's pretty print form. */ /*==========================================*/ ppform = (*constructClass->getPPFormFunction)(theEnv,theConstruct); if (ppform != NULL) { PrintInChunks(theEnv,logicalName,ppform); EnvPrintRouter(theEnv,logicalName,"\n"); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); } /*********************************************************/ /* GetConstructModuleName: Generic routine for returning */ /* the name of the module to which a construct belongs */ /*********************************************************/ globle char *GetConstructModuleName( struct constructHeader *theConstruct) { return(EnvGetDefmoduleName(NULL,(void *) theConstruct->whichModule->theModule)); } /*********************************************************/ /* GetConstructNameString: Generic routine for returning */ /* the name string of a construct. */ /*********************************************************/ globle char *GetConstructNameString( struct constructHeader *theConstruct) { return(ValueToString(theConstruct->name)); } /**************************************************/ /* EnvGetConstructNameString: Generic routine for */ /* returning the name string of a construct. */ /**************************************************/ #if IBM_TBC #pragma argsused #endif globle char *EnvGetConstructNameString( void *theEnv, struct constructHeader *theConstruct) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(ValueToString(theConstruct->name)); } /**********************************************************/ /* GetConstructNamePointer: Generic routine for returning */ /* the name pointer of a construct. */ /**********************************************************/ globle SYMBOL_HN *GetConstructNamePointer( struct constructHeader *theConstruct) { return(theConstruct->name); } /************************************************/ /* GetConstructListFunction: Generic Routine */ /* for retrieving the constructs in a module. */ /************************************************/ globle void GetConstructListFunction( void *theEnv, char *functionName, DATA_OBJECT_PTR returnValue, struct construct *constructClass) { struct defmodule *theModule; DATA_OBJECT result; int numArgs; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,functionName,NO_MORE_THAN,1)) == -1) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*====================================*/ /* If an argument was given, check to */ /* see that it's a valid module name. */ /*====================================*/ if (numArgs == 1) { /*======================================*/ /* Only symbols are valid module names. */ /*======================================*/ EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,functionName,1,"defmodule name"); return; } /*===========================================*/ /* Verify that the named module exists or is */ /* the symbol * (for obtaining the construct */ /* list for all modules). */ /*===========================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,functionName,1,"defmodule name"); return; } theModule = NULL; } } /*=====================================*/ /* Otherwise use the current module to */ /* generate the construct list. */ /*=====================================*/ else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*=============================*/ /* Call the driver routine to */ /* get the list of constructs. */ /*=============================*/ GetConstructList(theEnv,returnValue,constructClass,theModule); } /********************************************/ /* GetConstructList: Generic C Routine for */ /* retrieving the constructs in a module. */ /********************************************/ globle void GetConstructList( void *theEnv, DATA_OBJECT_PTR returnValue, struct construct *constructClass, struct defmodule *theModule) { void *theConstruct; unsigned long count = 0; struct multifield *theList; SYMBOL_HN *theName; struct defmodule *loopModule; int allModules = FALSE; #if IBM_TBC unsigned largestConstructNameSize, bufferSize = 80; /* prevents warning */ #else unsigned largestConstructNameSize = 0, bufferSize = 80; /* prevents warning */ #endif char *buffer; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=======================================*/ /* If the module specified is NULL, then */ /* get all constructs in all modules. */ /*=======================================*/ if (theModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); allModules = TRUE; } /*======================================================*/ /* Count the number of constructs to be retrieved and */ /* determine the buffer size needed to store the */ /* module-name::construct-names that will be generated. */ /*======================================================*/ loopModule = theModule; while (loopModule != NULL) { unsigned tempSize; /*======================================================*/ /* Set the current module to the module being examined. */ /*======================================================*/ EnvSetCurrentModule(theEnv,(void *) loopModule); /*===========================================*/ /* Loop over every construct in the module. */ /*===========================================*/ theConstruct = NULL; largestConstructNameSize = 0; while ((theConstruct = (*constructClass->getNextItemFunction)(theEnv,theConstruct)) != NULL) { /*================================*/ /* Increment the construct count. */ /*================================*/ count++; /*=================================================*/ /* Is this the largest construct name encountered? */ /*=================================================*/ tempSize = strlen(ValueToString((*constructClass->getConstructNameFunction)((struct constructHeader *) theConstruct))); if (tempSize > largestConstructNameSize) { largestConstructNameSize = tempSize; } } /*========================================*/ /* Determine the size of the module name. */ /*========================================*/ tempSize = strlen(EnvGetDefmoduleName(theEnv,loopModule)); /*======================================================*/ /* The buffer must be large enough for the module name, */ /* the largest name of all the constructs, and the ::. */ /*======================================================*/ if ((tempSize + largestConstructNameSize + 5) > bufferSize) { bufferSize = tempSize + largestConstructNameSize + 5; } /*=============================*/ /* Move on to the next module. */ /*=============================*/ if (allModules) loopModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,loopModule); else loopModule = NULL; } /*===========================*/ /* Allocate the name buffer. */ /*===========================*/ buffer = (char *) genalloc(theEnv,bufferSize); /*================================*/ /* Create the multifield value to */ /* store the construct names. */ /*================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*===========================*/ /* Store the construct names */ /* in the multifield value. */ /*===========================*/ loopModule = theModule; count = 1; while (loopModule != NULL) { /*============================*/ /* Set the current module to */ /* the module being examined. */ /*============================*/ EnvSetCurrentModule(theEnv,(void *) loopModule); /*===============================*/ /* Add each construct name found */ /* in the module to the list. */ /*===============================*/ theConstruct = NULL; while ((theConstruct = (*constructClass->getNextItemFunction)(theEnv,theConstruct)) != NULL) { theName = (*constructClass->getConstructNameFunction)((struct constructHeader *) theConstruct); SetMFType(theList,count,SYMBOL); if (allModules) { strcpy(buffer,EnvGetDefmoduleName(theEnv,loopModule)); strcat(buffer,"::"); strcat(buffer,ValueToString(theName)); SetMFValue(theList,count,EnvAddSymbol(theEnv,buffer)); } else { SetMFValue(theList,count,EnvAddSymbol(theEnv,ValueToString(theName))); } count++; } /*==================================*/ /* Move on to the next module (if */ /* the list is to contain the names */ /* of constructs from all modules). */ /*==================================*/ if (allModules) loopModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,loopModule); else loopModule = NULL; } /*=========================*/ /* Return the name buffer. */ /*=========================*/ genfree(theEnv,buffer,bufferSize); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); } /*********************************************/ /* ListConstructCommand: Generic Routine for */ /* listing the constructs in a module. */ /*********************************************/ globle void ListConstructCommand( void *theEnv, char *functionName, struct construct *constructClass) { struct defmodule *theModule; DATA_OBJECT result; int numArgs; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,functionName,NO_MORE_THAN,1)) == -1) return; /*====================================*/ /* If an argument was given, check to */ /* see that it's a valid module name. */ /*====================================*/ if (numArgs == 1) { /*======================================*/ /* Only symbols are valid module names. */ /*======================================*/ EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,1,"defmodule name"); return; } /*===========================================*/ /* Verify that the named module exists or is */ /* the symbol * (for obtaining the construct */ /* list for all modules). */ /*===========================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { ExpectedTypeError1(theEnv,functionName,1,"defmodule name"); return; } theModule = NULL; } } /*=====================================*/ /* Otherwise use the current module to */ /* generate the construct list. */ /*=====================================*/ else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*=========================*/ /* Call the driver routine */ /* to list the constructs. */ /*=========================*/ ListConstruct(theEnv,constructClass,WDISPLAY,theModule); } /*****************************************/ /* ListConstruct: Generic C Routine for */ /* listing the constructs in a module. */ /*****************************************/ globle void ListConstruct( void *theEnv, struct construct *constructClass, char *logicalName, struct defmodule *theModule) { void *constructPtr; SYMBOL_HN *constructName; long count = 0; int allModules = FALSE; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=======================================*/ /* If the module specified is NULL, then */ /* list all constructs in all modules. */ /*=======================================*/ if (theModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); allModules = TRUE; } /*==================================*/ /* Loop through all of the modules. */ /*==================================*/ while (theModule != NULL) { /*========================================*/ /* If we're printing the construct in all */ /* modules, then preface each module */ /* listing with the name of the module. */ /*========================================*/ if (allModules) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule)); EnvPrintRouter(theEnv,logicalName,":\n"); } /*===============================*/ /* Set the current module to the */ /* module we're examining. */ /*===============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*===========================================*/ /* List all of the constructs in the module. */ /*===========================================*/ for (constructPtr = (*constructClass->getNextItemFunction)(theEnv,NULL); constructPtr != NULL; constructPtr = (*constructClass->getNextItemFunction)(theEnv,constructPtr)) { if (EvaluationData(theEnv)->HaltExecution == TRUE) return; constructName = (*constructClass->getConstructNameFunction)((struct constructHeader *) constructPtr); if (constructName != NULL) { if (allModules) EnvPrintRouter(theEnv,WDISPLAY," "); EnvPrintRouter(theEnv,logicalName,ValueToString(constructName)); EnvPrintRouter(theEnv,logicalName,"\n"); } count++; } /*====================================*/ /* Move on to the next module (if the */ /* listing is to contain the names of */ /* constructs from all modules). */ /*====================================*/ if (allModules) theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); else theModule = NULL; } /*=================================================*/ /* Print the tally and restore the current module. */ /*=================================================*/ PrintTally(theEnv,WDISPLAY,count,constructClass->constructName, constructClass->pluralName); RestoreCurrentModule(theEnv); } /**********************************************************/ /* SetNextConstruct: Sets the next field of one construct */ /* to point to another construct of the same type. */ /**********************************************************/ globle void SetNextConstruct( struct constructHeader *theConstruct, struct constructHeader *targetConstruct) { theConstruct->next = targetConstruct; } /********************************************************************/ /* GetConstructModuleItem: Returns the construct module for a given */ /* construct (note that this is a pointer to a data structure */ /* like the deffactsModule, not a pointer to an environment */ /* module which contains a number of types of constructs. */ /********************************************************************/ globle struct defmoduleItemHeader *GetConstructModuleItem( struct constructHeader *theConstruct) { return(theConstruct->whichModule); } /*************************************************/ /* GetConstructPPForm: Returns the pretty print */ /* representation for the specified construct. */ /*************************************************/ #if IBM_TBC #pragma argsused #endif globle char *GetConstructPPForm( void *theEnv, struct constructHeader *theConstruct) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(theConstruct->ppForm); } /****************************************************/ /* GetNextConstructItem: Returns the next construct */ /* items from a list of constructs. */ /****************************************************/ globle struct constructHeader *GetNextConstructItem( void *theEnv, struct constructHeader *theConstruct, int moduleIndex) { struct defmoduleItemHeader *theModuleItem; if (theConstruct == NULL) { theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,moduleIndex); if (theModuleItem == NULL) return(NULL); return(theModuleItem->firstItem); } return(theConstruct->next); } /*******************************************************/ /* GetConstructModuleItemByIndex: Returns a pointer to */ /* the defmodule item for the specified construct. If */ /* theModule is NULL, then the construct module item */ /* for the current module is returned, otherwise the */ /* construct module item for the specified construct */ /* is returned. */ /*******************************************************/ globle struct defmoduleItemHeader *GetConstructModuleItemByIndex( void *theEnv, struct defmodule *theModule, int moduleIndex) { if (theModule != NULL) { return((struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,moduleIndex)); } return((struct defmoduleItemHeader *) GetModuleItem(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)),moduleIndex)); } /******************************************/ /* FreeConstructHeaderModule: Deallocates */ /* the data structures associated with */ /* the construct module item header. */ /******************************************/ globle void FreeConstructHeaderModule( void *theEnv, struct defmoduleItemHeader *theModuleItem, struct construct *constructClass) { struct constructHeader *thisOne, *nextOne; thisOne = theModuleItem->firstItem; while (thisOne != NULL) { nextOne = thisOne->next; (*constructClass->freeFunction)(theEnv,thisOne); thisOne = nextOne; } } /**********************************************/ /* DoForAllConstructs: Executes an action for */ /* all constructs of a specified type. */ /**********************************************/ globle long DoForAllConstructs( void *theEnv, void (*actionFunction)(void *,struct constructHeader *,void *), int moduleItemIndex, int interruptable, void *userBuffer) { struct constructHeader *theConstruct; struct defmoduleItemHeader *theModuleItem; void *theModule; long moduleCount = 0L; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*==================================*/ /* Loop through all of the modules. */ /*==================================*/ for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule), moduleCount++) { /*=============================*/ /* Set the current module to */ /* the module we're examining. */ /*=============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*================================================*/ /* Perform the action for each of the constructs. */ /*================================================*/ theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,(struct defmodule *) theModule,moduleItemIndex); for (theConstruct = theModuleItem->firstItem; theConstruct != NULL; theConstruct = theConstruct->next) { if (interruptable) { if (GetHaltExecution(theEnv) == TRUE) { RestoreCurrentModule(theEnv); return(-1L); } } (*actionFunction)(theEnv,theConstruct,userBuffer); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*=========================================*/ /* Return the number of modules traversed. */ /*=========================================*/ return(moduleCount); } /******************************************************/ /* DoForAllConstructsInModule: Executes an action for */ /* all constructs of a specified type in a module. */ /******************************************************/ globle void DoForAllConstructsInModule( void *theEnv, void *theModule, void (*actionFunction)(void *,struct constructHeader *,void *), int moduleItemIndex, int interruptable, void *userBuffer) { struct constructHeader *theConstruct; struct defmoduleItemHeader *theModuleItem; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=============================*/ /* Set the current module to */ /* the module we're examining. */ /*=============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*================================================*/ /* Perform the action for each of the constructs. */ /*================================================*/ theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,(struct defmodule *) theModule,moduleItemIndex); for (theConstruct = theModuleItem->firstItem; theConstruct != NULL; theConstruct = theConstruct->next) { if (interruptable) { if (GetHaltExecution(theEnv) == TRUE) { RestoreCurrentModule(theEnv); return; } } (*actionFunction)(theEnv,theConstruct,userBuffer); } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); } /*****************************************************/ /* InitializeConstructHeader: Initializes construct */ /* header info, including to which module item the */ /* new construct belongs */ /*****************************************************/ globle void InitializeConstructHeader( void *theEnv, char *constructType, struct constructHeader *theConstruct, SYMBOL_HN *theConstructName) { struct moduleItem *theModuleItem; struct defmoduleItemHeader *theItemHeader; theModuleItem = FindModuleItem(theEnv,constructType); theItemHeader = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,theModuleItem->moduleIndex); theConstruct->whichModule = theItemHeader; theConstruct->name = theConstructName; theConstruct->ppForm = NULL; theConstruct->bsaveID = 0L; theConstruct->next = NULL; theConstruct->usrData = NULL; } /*************************************************/ /* SetConstructPPForm: Sets a construct's pretty */ /* print form and deletes the old one. */ /*************************************************/ globle void SetConstructPPForm( void *theEnv, struct constructHeader *theConstruct, char *ppForm) { if (theConstruct->ppForm != NULL) { rm(theEnv,(void *) theConstruct->ppForm, ((strlen(theConstruct->ppForm) + 1) * sizeof(char))); } theConstruct->ppForm = ppForm; } #if DEBUGGING_FUNCTIONS /******************************************************/ /* ConstructPrintWatchAccess: Provides an interface */ /* to the list-watch-items function for a construct */ /******************************************************/ globle unsigned ConstructPrintWatchAccess( void *theEnv, struct construct *constructClass, char *logName, EXPRESSION *argExprs, unsigned (*getWatchFunc)(void *,void *), void (*setWatchFunc)(void *,unsigned,void *)) { return(ConstructWatchSupport(theEnv,constructClass,"list-watch-items",logName,argExprs, FALSE,FALSE,getWatchFunc,setWatchFunc)); } /**************************************************/ /* ConstructSetWatchAccess: Provides an interface */ /* to the watch function for a construct */ /**************************************************/ globle unsigned ConstructSetWatchAccess( void *theEnv, struct construct *constructClass, unsigned newState, EXPRESSION *argExprs, unsigned (*getWatchFunc)(void *,void *), void (*setWatchFunc)(void *,unsigned,void *)) { return(ConstructWatchSupport(theEnv,constructClass,"watch",WERROR,argExprs, TRUE,newState,getWatchFunc,setWatchFunc)); } /******************************************************/ /* ConstructWatchSupport: Generic construct interface */ /* into watch and list-watch-items. */ /******************************************************/ static unsigned ConstructWatchSupport( void *theEnv, struct construct *constructClass, char *funcName, char *logName, EXPRESSION *argExprs, intBool setFlag, unsigned newState, unsigned (*getWatchFunc)(void *,void *), void (*setWatchFunc)(void *,unsigned,void *)) { struct defmodule *theModule; void *theConstruct; DATA_OBJECT constructName; int argIndex = 2; /*========================================*/ /* If no constructs are specified, then */ /* show/set the trace for all constructs. */ /*========================================*/ if (argExprs == NULL) { /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule)) { /*============================*/ /* Set the current module to */ /* the module being examined. */ /*============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*====================================================*/ /* If we're displaying the names of constructs with */ /* watch flags enabled, then preface each module */ /* listing of constructs with the name of the module. */ /*====================================================*/ if (setFlag == FALSE) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logName,":\n"); } /*============================================*/ /* Loop through each construct in the module. */ /*============================================*/ for (theConstruct = (*constructClass->getNextItemFunction)(theEnv,NULL); theConstruct != NULL; theConstruct = (*constructClass->getNextItemFunction)(theEnv,theConstruct)) { /*=============================================*/ /* Either set the watch flag for the construct */ /* or display its current state. */ /*=============================================*/ if (setFlag) { (*setWatchFunc)(theEnv,newState,theConstruct); } else { EnvPrintRouter(theEnv,logName," "); ConstructPrintWatch(theEnv,logName,constructClass,theConstruct,getWatchFunc); } } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*====================================*/ /* Return TRUE to indicate successful */ /* completion of the command. */ /*====================================*/ return(TRUE); } /*==================================================*/ /* Show/set the trace for each specified construct. */ /*==================================================*/ while (argExprs != NULL) { /*==========================================*/ /* Evaluate the argument that should be a */ /* construct name. Return FALSE is an error */ /* occurs when evaluating the argument. */ /*==========================================*/ if (EvaluateExpression(theEnv,argExprs,&constructName)) { return(FALSE); } /*================================================*/ /* Check to see that it's a valid construct name. */ /*================================================*/ if ((constructName.type != SYMBOL) ? TRUE : ((theConstruct = LookupConstruct(theEnv,constructClass, DOToString(constructName),TRUE)) == NULL)) { ExpectedTypeError1(theEnv,funcName,argIndex,constructClass->constructName); return(FALSE); } /*=============================================*/ /* Either set the watch flag for the construct */ /* or display its current state. */ /*=============================================*/ if (setFlag) { (*setWatchFunc)(theEnv,newState,theConstruct); } else { ConstructPrintWatch(theEnv,logName,constructClass,theConstruct,getWatchFunc); } /*===============================*/ /* Move on to the next argument. */ /*===============================*/ argIndex++; argExprs = GetNextArgument(argExprs); } /*====================================*/ /* Return TRUE to indicate successful */ /* completion of the command. */ /*====================================*/ return(TRUE); } /*************************************************/ /* ConstructPrintWatch: Displays the trace value */ /* of a construct for list-watch-items */ /*************************************************/ static void ConstructPrintWatch( void *theEnv, char *logName, struct construct *constructClass, void *theConstruct, unsigned (*getWatchFunc)(void *,void *)) { EnvPrintRouter(theEnv,logName,ValueToString((*constructClass->getConstructNameFunction)((struct constructHeader *) theConstruct))); EnvPrintRouter(theEnv,logName,(char *) ((*getWatchFunc)(theEnv,theConstruct) ? " = on\n" : " = off\n")); } #endif /* DEBUGGING_FUNCTIONS */ /*****************************************************/ /* LookupConstruct: Finds a construct in the current */ /* or imported modules. If specified, will also */ /* look for construct in a non-imported module. */ /*****************************************************/ globle void *LookupConstruct( void *theEnv, struct construct *constructClass, char *constructName, intBool moduleNameAllowed) { void *theConstruct; char *constructType; int moduleCount; /*============================================*/ /* Look for the specified construct in the */ /* current module or in any imported modules. */ /*============================================*/ constructType = constructClass->constructName; theConstruct = FindImportedConstruct(theEnv,constructType,NULL,constructName, &moduleCount,TRUE,NULL); /*===========================================*/ /* Return NULL if the reference is ambiguous */ /* (it was found in more than one module). */ /*===========================================*/ if (theConstruct != NULL) { if (moduleCount > 1) { AmbiguousReferenceErrorMessage(theEnv,constructType,constructName); return(NULL); } return(theConstruct); } /*=============================================*/ /* If specified, check to see if the construct */ /* is in a non-imported module. */ /*=============================================*/ if (moduleNameAllowed && FindModuleSeparator(constructName)) { theConstruct = (*constructClass->findFunction)(theEnv,constructName); } /*====================================*/ /* Return a pointer to the construct. */ /*====================================*/ return(theConstruct); } /***********************************************************/ /* ConstructsDeletable: Returns a boolean value indicating */ /* whether constructs in general can be deleted. */ /***********************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool ConstructsDeletable( void *theEnv) { #if BLOAD_ONLY || RUN_TIME || ((! BLOAD) && (! BLOAD_AND_BSAVE)) #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif #if BLOAD_ONLY || RUN_TIME return(FALSE); #elif BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); return TRUE; #else return(TRUE); #endif } clips-6.24/clipssrc/filecom.c0000755000175000017500000011177510441164433014330 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FILE COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for file commands including */ /* batch, dribble-on, dribble-off, save, load, bsave, and */ /* bload. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* Bebe Ly */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _FILECOM_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "argacces.h" #include "constrct.h" #include "commline.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "prcdrfun.h" #include "router.h" #include "strngrtr.h" #include "sysdep.h" #include "utility.h" #include "filecom.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bsave.h" #include "bload.h" #endif /***************/ /* STRUCTURES */ /***************/ struct batchEntry { int batchType; void *inputSource; char *theString; struct batchEntry *next; }; /***************/ /* DEFINITIONS */ /***************/ #define FILE_BATCH 0 #define STRING_BATCH 1 #define BUFFER_SIZE 120 #define FILECOM_DATA 14 struct fileCommandData { #if DEBUGGING_FUNCTIONS FILE *DribbleFP; char *DribbleBuffer; int DribbleCurrentPosition; unsigned DribbleMaximumPosition; int (*DribbleStatusFunction)(void *,int); #endif int BatchType; void *BatchSource; char *BatchBuffer; int BatchCurrentPosition; unsigned BatchMaximumPosition; struct batchEntry *TopOfBatchList; struct batchEntry *BottomOfBatchList; }; #define FileCommandData(theEnv) ((struct fileCommandData *) GetEnvironmentData(theEnv,FILECOM_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if DEBUGGING_FUNCTIONS static int FindDribble(void *,char *); static int GetcDribble(void *,char *); static int UngetcDribble(void *,int,char *); static int ExitDribble(void *,int); static int PrintDribble(void *,char *,char *); static void PutcDribbleBuffer(void *,int); #endif static int FindBatch(void *,char *); static int GetcBatch(void *,char *); static int UngetcBatch(void *,int,char *); static int ExitBatch(void *,int); static void AddBatch(void *,int,void *,int,char *); static void DeallocateFileCommandData(void *); /***************************************/ /* FileCommandDefinitions: Initializes */ /* file commands. */ /***************************************/ globle void FileCommandDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,FILECOM_DATA,sizeof(struct fileCommandData),DeallocateFileCommandData); #if ! RUN_TIME #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"batch",'b',PTIEF BatchCommand,"BatchCommand","11k"); EnvDefineFunction2(theEnv,"batch*",'b',PTIEF BatchStarCommand,"BatchStarCommand","11k"); EnvDefineFunction2(theEnv,"dribble-on",'b',PTIEF DribbleOnCommand,"DribbleOnCommand","11k"); EnvDefineFunction2(theEnv,"dribble-off",'b',PTIEF DribbleOffCommand,"DribbleOffCommand","00"); EnvDefineFunction2(theEnv,"save",'b',PTIEF SaveCommand,"SaveCommand","11k"); #endif EnvDefineFunction2(theEnv,"load",'b',PTIEF LoadCommand,"LoadCommand","11k"); EnvDefineFunction2(theEnv,"load*",'b',PTIEF LoadStarCommand,"LoadStarCommand","11k"); #if BLOAD_AND_BSAVE InitializeBsaveData(theEnv); EnvDefineFunction2(theEnv,"bsave",'b', PTIEF BsaveCommand,"BsaveCommand","11k"); #endif #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE InitializeBloadData(theEnv); EnvDefineFunction2(theEnv,"bload",'b',PTIEF BloadCommand,"BloadCommand","11k"); #endif #endif } /******************************************************/ /* DeallocateFileCommandData: Deallocates environment */ /* data for file commands. */ /******************************************************/ static void DeallocateFileCommandData( void *theEnv) { struct batchEntry *theEntry, *nextEntry; theEntry = FileCommandData(theEnv)->TopOfBatchList; while (theEntry != NULL) { nextEntry = theEntry->next; if (theEntry->batchType == FILE_BATCH) { GenClose(theEnv,(FILE *) FileCommandData(theEnv)->TopOfBatchList->inputSource); } else { rm(theEnv,theEntry->theString,strlen(theEntry->theString) + 1); } rtn_struct(theEnv,batchEntry,theEntry); theEntry = nextEntry; } if (FileCommandData(theEnv)->BatchBuffer != NULL) { rm(theEnv,FileCommandData(theEnv)->BatchBuffer,FileCommandData(theEnv)->BatchMaximumPosition); } #if DEBUGGING_FUNCTIONS if (FileCommandData(theEnv)->DribbleBuffer != NULL) { rm(theEnv,FileCommandData(theEnv)->DribbleBuffer,FileCommandData(theEnv)->DribbleMaximumPosition); } if (FileCommandData(theEnv)->DribbleFP != NULL) { GenClose(theEnv,FileCommandData(theEnv)->DribbleFP); } #endif } #if DEBUGGING_FUNCTIONS /*****************************************************/ /* FindDribble: Find routine for the dribble router. */ /*****************************************************/ #if IBM_TBC #pragma argsused #endif static int FindDribble( void *theEnv, char *logicalName) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if ( (strcmp(logicalName,"stdout") == 0) || (strcmp(logicalName,"stdin") == 0) || (strcmp(logicalName,WPROMPT) == 0) || (strcmp(logicalName,WTRACE) == 0) || (strcmp(logicalName,WERROR) == 0) || (strcmp(logicalName,WWARNING) == 0) || (strcmp(logicalName,WDISPLAY) == 0) || (strcmp(logicalName,WDIALOG) == 0) ) { return(TRUE); } return(FALSE); } /*******************************************************/ /* PrintDribble: Print routine for the dribble router. */ /*******************************************************/ static int PrintDribble( void *theEnv, char *logicalName, char *str) { int i; /*======================================*/ /* Send the output to the dribble file. */ /*======================================*/ for (i = 0 ; str[i] != EOS ; i++) { PutcDribbleBuffer(theEnv,str[i]); } /*===========================================================*/ /* Send the output to any routers interested in printing it. */ /*===========================================================*/ EnvDeactivateRouter(theEnv,"dribble"); EnvPrintRouter(theEnv,logicalName,str); EnvActivateRouter(theEnv,"dribble"); return(1); } /*****************************************************/ /* GetcDribble: Getc routine for the dribble router. */ /*****************************************************/ static int GetcDribble( void *theEnv, char *logicalName) { int rv; /*===========================================*/ /* Deactivate the dribble router and get the */ /* character from another active router. */ /*===========================================*/ EnvDeactivateRouter(theEnv,"dribble"); rv = EnvGetcRouter(theEnv,logicalName); EnvActivateRouter(theEnv,"dribble"); /*==========================================*/ /* Put the character retrieved from another */ /* router into the dribble buffer. */ /*==========================================*/ PutcDribbleBuffer(theEnv,rv); /*=======================*/ /* Return the character. */ /*=======================*/ return(rv); } /***********************************************************/ /* PutcDribbleBuffer: Putc routine for the dribble router. */ /***********************************************************/ static void PutcDribbleBuffer( void *theEnv, int rv) { /*===================================================*/ /* Receiving an end-of-file character will cause the */ /* contents of the dribble buffer to be flushed. */ /*===================================================*/ if (rv == EOF) { if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) { fprintf(FileCommandData(theEnv)->DribbleFP,"%s",FileCommandData(theEnv)->DribbleBuffer); FileCommandData(theEnv)->DribbleCurrentPosition = 0; FileCommandData(theEnv)->DribbleBuffer[0] = EOS; } } /*===========================================================*/ /* If we aren't receiving command input, then the character */ /* just received doesn't need to be placed in the dribble */ /* buffer--It can be written directly to the file. This will */ /* occur for example when the command prompt is being */ /* printed (the CommandBufferInputCount variable will be -1 */ /* because command input has not been receivied yet). Before */ /* writing the character to the file, the dribble buffer is */ /* flushed. */ /*===========================================================*/ else if (RouterData(theEnv)->CommandBufferInputCount < 0) { if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) { fprintf(FileCommandData(theEnv)->DribbleFP,"%s",FileCommandData(theEnv)->DribbleBuffer); FileCommandData(theEnv)->DribbleCurrentPosition = 0; FileCommandData(theEnv)->DribbleBuffer[0] = EOS; } fputc(rv,FileCommandData(theEnv)->DribbleFP); } /*=====================================================*/ /* Otherwise, add the character to the dribble buffer. */ /*=====================================================*/ else { FileCommandData(theEnv)->DribbleBuffer = ExpandStringWithChar(theEnv,rv,FileCommandData(theEnv)->DribbleBuffer, &FileCommandData(theEnv)->DribbleCurrentPosition, &FileCommandData(theEnv)->DribbleMaximumPosition, FileCommandData(theEnv)->DribbleMaximumPosition+BUFFER_SIZE); } } /*********************************************************/ /* UngetcDribble: Ungetc routine for the dribble router. */ /*********************************************************/ static int UngetcDribble( void *theEnv, int ch, char *logicalName) { int rv; /*===============================================*/ /* Remove the character from the dribble buffer. */ /*===============================================*/ if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) FileCommandData(theEnv)->DribbleCurrentPosition--; FileCommandData(theEnv)->DribbleBuffer[FileCommandData(theEnv)->DribbleCurrentPosition] = EOS; /*=============================================*/ /* Deactivate the dribble router and pass the */ /* ungetc request to the other active routers. */ /*=============================================*/ EnvDeactivateRouter(theEnv,"dribble"); rv = EnvUngetcRouter(theEnv,ch,logicalName); EnvActivateRouter(theEnv,"dribble"); /*==========================================*/ /* Return the result of the ungetc request. */ /*==========================================*/ return(rv); } /*****************************************************/ /* ExitDribble: Exit routine for the dribble router. */ /*****************************************************/ #if IBM_TBC #pragma argsused #endif static int ExitDribble( void *theEnv, int num) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(num) #endif if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) { fprintf(FileCommandData(theEnv)->DribbleFP,"%s",FileCommandData(theEnv)->DribbleBuffer); } if (FileCommandData(theEnv)->DribbleFP != NULL) GenClose(theEnv,FileCommandData(theEnv)->DribbleFP); return(1); } /******************************************/ /* DribbleOnCommand: H/L access routine */ /* for the dribble-on command. */ /******************************************/ globle int DribbleOnCommand( void *theEnv) { char *fileName; if (EnvArgCountCheck(theEnv,"dribble-on",EXACTLY,1) == -1) return(FALSE); if ((fileName = GetFileName(theEnv,"dribble-on",1)) == NULL) return(FALSE); return (EnvDribbleOn(theEnv,fileName)); } /**********************************/ /* EnvDribbleOn: C access routine */ /* for the dribble-on command. */ /**********************************/ globle intBool EnvDribbleOn( void *theEnv, char *fileName) { /*==============================*/ /* If a dribble file is already */ /* open, then close it. */ /*==============================*/ if (FileCommandData(theEnv)->DribbleFP != NULL) { EnvDribbleOff(theEnv); } /*========================*/ /* Open the dribble file. */ /*========================*/ FileCommandData(theEnv)->DribbleFP = GenOpen(theEnv,fileName,"w"); if (FileCommandData(theEnv)->DribbleFP == NULL) { OpenErrorMessage(theEnv,"dribble-on",fileName); return(0); } /*============================*/ /* Create the dribble router. */ /*============================*/ EnvAddRouter(theEnv,"dribble", 40, FindDribble, PrintDribble, GetcDribble, UngetcDribble, ExitDribble); FileCommandData(theEnv)->DribbleCurrentPosition = 0; /*================================================*/ /* Call the dribble status function. This is used */ /* by some of the machine specific interfaces to */ /* do things such as changing the wording of menu */ /* items from "Turn Dribble On..." to */ /* "Turn Dribble Off..." */ /*================================================*/ if (FileCommandData(theEnv)->DribbleStatusFunction != NULL) { (*FileCommandData(theEnv)->DribbleStatusFunction)(theEnv,TRUE); } /*=====================================*/ /* Return TRUE to indicate the dribble */ /* file was successfully opened. */ /*=====================================*/ return(TRUE); } /*************************************************/ /* EnvDribbleActive: Returns TRUE if the dribble */ /* router is active, otherwise FALSE> */ /*************************************************/ globle intBool EnvDribbleActive( void *theEnv) { if (FileCommandData(theEnv)->DribbleFP != NULL) return(TRUE); return(FALSE); } /*******************************************/ /* DribbleOffCommand: H/L access routine */ /* for the dribble-off command. */ /*******************************************/ globle int DribbleOffCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"dribble-off",EXACTLY,0) == -1) return(FALSE); return(EnvDribbleOff(theEnv)); } /***********************************/ /* EnvDribbleOff: C access routine */ /* for the dribble-off command. */ /***********************************/ globle intBool EnvDribbleOff( void *theEnv) { int rv = 0; /*================================================*/ /* Call the dribble status function. This is used */ /* by some of the machine specific interfaces to */ /* do things such as changing the wording of menu */ /* items from "Turn Dribble On..." to */ /* "Turn Dribble Off..." */ /*================================================*/ if (FileCommandData(theEnv)->DribbleStatusFunction != NULL) { (*FileCommandData(theEnv)->DribbleStatusFunction)(theEnv,FALSE); } /*=======================================*/ /* Close the dribble file and deactivate */ /* the dribble router. */ /*=======================================*/ if (FileCommandData(theEnv)->DribbleFP != NULL) { if (FileCommandData(theEnv)->DribbleCurrentPosition > 0) { fprintf(FileCommandData(theEnv)->DribbleFP,"%s",FileCommandData(theEnv)->DribbleBuffer); } EnvDeleteRouter(theEnv,"dribble"); if (GenClose(theEnv,FileCommandData(theEnv)->DribbleFP) == 0) rv = 1; } else { rv = 1; } FileCommandData(theEnv)->DribbleFP = NULL; /*============================================*/ /* Free the space used by the dribble buffer. */ /*============================================*/ if (FileCommandData(theEnv)->DribbleBuffer != NULL) { rm(theEnv,FileCommandData(theEnv)->DribbleBuffer,FileCommandData(theEnv)->DribbleMaximumPosition); FileCommandData(theEnv)->DribbleBuffer = NULL; } FileCommandData(theEnv)->DribbleCurrentPosition = 0; FileCommandData(theEnv)->DribbleMaximumPosition = 0; /*============================================*/ /* Return TRUE if the dribble file was closed */ /* without error, otherwise return FALSE. */ /*============================================*/ return(rv); } /*****************************************************/ /* SetDribbleStatusFunction: Sets the function which */ /* is called whenever the dribble router is turned */ /* on or off. */ /*****************************************************/ globle void SetDribbleStatusFunction( void *theEnv, int (*fnptr)(void *,int)) { FileCommandData(theEnv)->DribbleStatusFunction = fnptr; } #endif /*************************************************/ /* FindBatch: Find routine for the batch router. */ /*************************************************/ #if IBM_TBC #pragma argsused #endif static int FindBatch( void *theEnv, char *logicalName) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (strcmp(logicalName,"stdin") == 0) { return(TRUE); } return(FALSE); } /*************************************************/ /* GetcBatch: Getc routine for the batch router. */ /*************************************************/ static int GetcBatch( void *theEnv, char *logicalName) { return(LLGetcBatch(theEnv,logicalName,FALSE)); } /***************************************************/ /* LLGetcBatch: Lower level routine for retrieving */ /* a character when a batch file is active. */ /***************************************************/ globle int LLGetcBatch( void *theEnv, char *logicalName, int returnOnEOF) { int rv = EOF, flag = 1; /*=================================================*/ /* Get a character until a valid character appears */ /* or no more batch files are left. */ /*=================================================*/ while ((rv == EOF) && (flag == 1)) { if (FileCommandData(theEnv)->BatchType == FILE_BATCH) { rv = getc((FILE *) FileCommandData(theEnv)->BatchSource); } else { rv = EnvGetcRouter(theEnv,(char *) FileCommandData(theEnv)->BatchSource); } if (rv == EOF) { if (FileCommandData(theEnv)->BatchCurrentPosition > 0) EnvPrintRouter(theEnv,"stdout",(char *) FileCommandData(theEnv)->BatchBuffer); flag = RemoveBatch(theEnv); } } /*=========================================================*/ /* If the character retrieved is an end-of-file character, */ /* then there are no batch files with character input */ /* remaining. Remove the batch router. */ /*=========================================================*/ if (rv == EOF) { if (FileCommandData(theEnv)->BatchCurrentPosition > 0) EnvPrintRouter(theEnv,"stdout",(char *) FileCommandData(theEnv)->BatchBuffer); EnvDeleteRouter(theEnv,"batch"); RemoveBatch(theEnv); if (returnOnEOF == TRUE) { return (EOF); } else { return(EnvGetcRouter(theEnv,logicalName)); } } /*========================================*/ /* Add the character to the batch buffer. */ /*========================================*/ FileCommandData(theEnv)->BatchBuffer = ExpandStringWithChar(theEnv,(char) rv,FileCommandData(theEnv)->BatchBuffer,&FileCommandData(theEnv)->BatchCurrentPosition, &FileCommandData(theEnv)->BatchMaximumPosition,FileCommandData(theEnv)->BatchMaximumPosition+BUFFER_SIZE); /*======================================*/ /* If a carriage return is encountered, */ /* then flush the batch buffer. */ /*======================================*/ if ((char) rv == '\n') { EnvPrintRouter(theEnv,"stdout",(char *) FileCommandData(theEnv)->BatchBuffer); FileCommandData(theEnv)->BatchCurrentPosition = 0; if ((FileCommandData(theEnv)->BatchBuffer != NULL) && (FileCommandData(theEnv)->BatchMaximumPosition > BUFFER_SIZE)) { rm(theEnv,FileCommandData(theEnv)->BatchBuffer,FileCommandData(theEnv)->BatchMaximumPosition); FileCommandData(theEnv)->BatchMaximumPosition = 0; FileCommandData(theEnv)->BatchBuffer = NULL; } } /*=====================================================*/ /* Return the character retrieved from the batch file. */ /*=====================================================*/ return(rv); } /*****************************************************/ /* UngetcBatch: Ungetc routine for the batch router. */ /*****************************************************/ #if IBM_TBC #pragma argsused #endif static int UngetcBatch( void *theEnv, int ch, char *logicalName) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(logicalName) #endif if (FileCommandData(theEnv)->BatchCurrentPosition > 0) FileCommandData(theEnv)->BatchCurrentPosition--; if (FileCommandData(theEnv)->BatchBuffer != NULL) FileCommandData(theEnv)->BatchBuffer[FileCommandData(theEnv)->BatchCurrentPosition] = EOS; if (FileCommandData(theEnv)->BatchType == FILE_BATCH) { return(ungetc(ch,(FILE *) FileCommandData(theEnv)->BatchSource)); } return(EnvUngetcRouter(theEnv,ch,(char *) FileCommandData(theEnv)->BatchSource)); } /*************************************************/ /* ExitBatch: Exit routine for the batch router. */ /*************************************************/ #if IBM_TBC #pragma argsused #endif static int ExitBatch( void *theEnv, int num) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(num) #endif CloseAllBatchSources(theEnv); return(1); } /**************************************/ /* BatchCommand: H/L access routine */ /* for the batch command. */ /**************************************/ globle int BatchCommand( void *theEnv) { char *fileName; if (EnvArgCountCheck(theEnv,"batch",EXACTLY,1) == -1) return(FALSE); if ((fileName = GetFileName(theEnv,"batch",1)) == NULL) return(FALSE); return(OpenBatch(theEnv,fileName,FALSE)); } /**************************************************/ /* Batch: C access routine for the batch command. */ /**************************************************/ globle int Batch( void *theEnv, char *fileName) { return(OpenBatch(theEnv,fileName,FALSE)); } /***********************************************/ /* OpenBatch: Adds a file to the list of files */ /* opened with the batch command. */ /***********************************************/ globle int OpenBatch( void *theEnv, char *fileName, int placeAtEnd) { FILE *theFile; /*======================*/ /* Open the batch file. */ /*======================*/ theFile = GenOpen(theEnv,fileName,"r"); if (theFile == NULL) { OpenErrorMessage(theEnv,"batch",fileName); return(FALSE); } /*============================*/ /* Create the batch router if */ /* it doesn't already exist. */ /*============================*/ if (FileCommandData(theEnv)->TopOfBatchList == NULL) { EnvAddRouter(theEnv,"batch", 20, FindBatch, NULL, GetcBatch, UngetcBatch, ExitBatch); } /*====================================*/ /* Add the newly opened batch file to */ /* the list of batch files opened. */ /*====================================*/ AddBatch(theEnv,placeAtEnd,(void *) theFile,FILE_BATCH,NULL); /*===================================*/ /* Return TRUE to indicate the batch */ /* file was successfully opened. */ /*===================================*/ return(TRUE); } /*****************************************************************/ /* OpenStringBatch: Opens a string source for batch processing. */ /* The memory allocated for the argument stringName must be */ /* deallocated by the user. The memory allocated for theString */ /* will be deallocated by the batch routines when batch */ /* processing for the string is completed. */ /*****************************************************************/ globle int OpenStringBatch( void *theEnv, char *stringName, char *theString, int placeAtEnd) { if (OpenStringSource(theEnv,stringName,theString,0) == 0) { return(0); } if (FileCommandData(theEnv)->TopOfBatchList == NULL) { EnvAddRouter(theEnv,"batch", 20, FindBatch, NULL, GetcBatch, UngetcBatch, ExitBatch); } AddBatch(theEnv,placeAtEnd,(void *) stringName,STRING_BATCH,theString); return(1); } /*******************************************************/ /* AddBatch: Creates the batch file data structure and */ /* adds it to the list of opened batch files. */ /*******************************************************/ static void AddBatch( void *theEnv, int placeAtEnd, void *theSource, int type, char *theString) { struct batchEntry *bptr; /*=========================*/ /* Create the batch entry. */ /*=========================*/ bptr = get_struct(theEnv,batchEntry); bptr->batchType = type; bptr->inputSource = theSource; bptr->theString = theString; bptr->next = NULL; /*============================*/ /* Add the entry to the list. */ /*============================*/ if (FileCommandData(theEnv)->TopOfBatchList == NULL) { FileCommandData(theEnv)->TopOfBatchList = bptr; FileCommandData(theEnv)->BottomOfBatchList = bptr; FileCommandData(theEnv)->BatchType = type; FileCommandData(theEnv)->BatchSource = theSource; FileCommandData(theEnv)->BatchCurrentPosition = 0; } else if (placeAtEnd == FALSE) { bptr->next = FileCommandData(theEnv)->TopOfBatchList; FileCommandData(theEnv)->TopOfBatchList = bptr; FileCommandData(theEnv)->BatchType = type; FileCommandData(theEnv)->BatchSource = theSource; FileCommandData(theEnv)->BatchCurrentPosition = 0; } else { FileCommandData(theEnv)->BottomOfBatchList->next = bptr; FileCommandData(theEnv)->BottomOfBatchList = bptr; } } /******************************************************************/ /* RemoveBatch: Removes the top entry on the list of batch files. */ /******************************************************************/ globle int RemoveBatch( void *theEnv) { struct batchEntry *bptr; int rv; if (FileCommandData(theEnv)->TopOfBatchList == NULL) return(FALSE); /*==================================================*/ /* Close the source from which batch input is read. */ /*==================================================*/ if (FileCommandData(theEnv)->TopOfBatchList->batchType == FILE_BATCH) { GenClose(theEnv,(FILE *) FileCommandData(theEnv)->TopOfBatchList->inputSource); } else { CloseStringSource(theEnv,(char *) FileCommandData(theEnv)->TopOfBatchList->inputSource); rm(theEnv,FileCommandData(theEnv)->TopOfBatchList->theString,strlen(FileCommandData(theEnv)->TopOfBatchList->theString) + 1); } /*=================================*/ /* Remove the entry from the list. */ /*=================================*/ bptr = FileCommandData(theEnv)->TopOfBatchList; FileCommandData(theEnv)->TopOfBatchList = FileCommandData(theEnv)->TopOfBatchList->next; rtn_struct(theEnv,batchEntry,bptr); /*========================================================*/ /* If there are no batch files remaining to be processed, */ /* then free the space used by the batch buffer. */ /*========================================================*/ if (FileCommandData(theEnv)->TopOfBatchList == NULL) { FileCommandData(theEnv)->BottomOfBatchList = NULL; FileCommandData(theEnv)->BatchSource = NULL; if (FileCommandData(theEnv)->BatchBuffer != NULL) { rm(theEnv,FileCommandData(theEnv)->BatchBuffer,FileCommandData(theEnv)->BatchMaximumPosition); FileCommandData(theEnv)->BatchBuffer = NULL; } FileCommandData(theEnv)->BatchCurrentPosition = 0; FileCommandData(theEnv)->BatchMaximumPosition = 0; rv = 0; } /*===========================================*/ /* Otherwise move on to the next batch file. */ /*===========================================*/ else { FileCommandData(theEnv)->BatchType = FileCommandData(theEnv)->TopOfBatchList->batchType; FileCommandData(theEnv)->BatchSource = FileCommandData(theEnv)->TopOfBatchList->inputSource; FileCommandData(theEnv)->BatchCurrentPosition = 0; rv = 1; } /*====================================================*/ /* Return TRUE if a batch file if there are remaining */ /* batch files to be processed, otherwise FALSE. */ /*====================================================*/ return(rv); } /****************************************/ /* BatchActive: Returns TRUE if a batch */ /* file is open, otherwise FALSE. */ /****************************************/ globle intBool BatchActive( void *theEnv) { if (FileCommandData(theEnv)->TopOfBatchList != NULL) return(TRUE); return(FALSE); } /******************************************************/ /* CloseAllBatchSources: Closes all open batch files. */ /******************************************************/ globle void CloseAllBatchSources( void *theEnv) { /*================================================*/ /* Free the batch buffer if it contains anything. */ /*================================================*/ if (FileCommandData(theEnv)->BatchBuffer != NULL) { if (FileCommandData(theEnv)->BatchCurrentPosition > 0) EnvPrintRouter(theEnv,"stdout",(char *) FileCommandData(theEnv)->BatchBuffer); rm(theEnv,FileCommandData(theEnv)->BatchBuffer,FileCommandData(theEnv)->BatchMaximumPosition); FileCommandData(theEnv)->BatchBuffer = NULL; FileCommandData(theEnv)->BatchCurrentPosition = 0; FileCommandData(theEnv)->BatchMaximumPosition = 0; } /*==========================*/ /* Delete the batch router. */ /*==========================*/ EnvDeleteRouter(theEnv,"batch"); /*=====================================*/ /* Close each of the open batch files. */ /*=====================================*/ while (RemoveBatch(theEnv)) { /* Do Nothing */ } } /******************************************/ /* BatchStarCommand: H/L access routine */ /* for the batch* command. */ /******************************************/ globle int BatchStarCommand( void *theEnv) { char *fileName; if (EnvArgCountCheck(theEnv,"batch*",EXACTLY,1) == -1) return(FALSE); if ((fileName = GetFileName(theEnv,"batch*",1)) == NULL) return(FALSE); return(EnvBatchStar(theEnv,fileName)); } #if ! RUN_TIME /**********************************************************/ /* EnvBatchStar: C access routine for the batch* command. */ /**********************************************************/ globle int EnvBatchStar( void *theEnv, char *fileName) { int inchar; FILE *theFile; char *theString = NULL; int position = 0; unsigned maxChars = 0; /*======================*/ /* Open the batch file. */ /*======================*/ theFile = GenOpen(theEnv,fileName,"r"); if (theFile == NULL) { OpenErrorMessage(theEnv,"batch",fileName); return(FALSE); } /*========================*/ /* Reset the error state. */ /*========================*/ SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); /*=============================================*/ /* Evaluate commands from the file one by one. */ /*=============================================*/ while ((inchar = getc(theFile)) != EOF) { theString = ExpandStringWithChar(theEnv,inchar,theString,&position, &maxChars,maxChars+80); if (CompleteCommand(theString) != 0) { FlushPPBuffer(theEnv); SetPPBufferStatus(theEnv,OFF); RouteCommand(theEnv,theString,FALSE); FlushPPBuffer(theEnv); SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushBindList(theEnv); genfree(theEnv,theString,(unsigned) maxChars); theString = NULL; maxChars = 0; position = 0; } } if (theString != NULL) { genfree(theEnv,theString,(unsigned) maxChars); } /*=======================*/ /* Close the batch file. */ /*=======================*/ GenClose(theEnv,theFile); return(TRUE); } #else /**************************************************/ /* EnvBatchStar: This is the non-functional stub */ /* provided for use with a run-time version. */ /**************************************************/ globle int EnvBatchStar( void *theEnv, char *fileName) { #if (MAC_MCW || IBM_MCW) && RUN_TIME #pragma unused(fileName) #endif PrintErrorID(theEnv,"FILECOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function batch* does not work in run time modules.\n"); return(FALSE); } #endif /***********************************************************/ /* LoadCommand: H/L access routine for the load command. */ /***********************************************************/ globle int LoadCommand( void *theEnv) { #if (! BLOAD_ONLY) && (! RUN_TIME) char *theFileName; int rv; if (EnvArgCountCheck(theEnv,"load",EXACTLY,1) == -1) return(FALSE); if ((theFileName = GetFileName(theEnv,"load",1)) == NULL) return(FALSE); SetPrintWhileLoading(theEnv,TRUE); if ((rv = EnvLoad(theEnv,theFileName)) == FALSE) { SetPrintWhileLoading(theEnv,FALSE); OpenErrorMessage(theEnv,"load",theFileName); return(FALSE); } SetPrintWhileLoading(theEnv,FALSE); if (rv == -1) return(FALSE); return(TRUE); #else EnvPrintRouter(theEnv,WDIALOG,"Load is not available in this environment\n"); return(FALSE); #endif } /****************************************************************/ /* LoadStarCommand: H/L access routine for the load* command. */ /****************************************************************/ globle int LoadStarCommand( void *theEnv) { #if (! BLOAD_ONLY) && (! RUN_TIME) char *theFileName; int rv; if (EnvArgCountCheck(theEnv,"load*",EXACTLY,1) == -1) return(FALSE); if ((theFileName = GetFileName(theEnv,"load*",1)) == NULL) return(FALSE); if ((rv = EnvLoad(theEnv,theFileName)) == FALSE) { OpenErrorMessage(theEnv,"load*",theFileName); return(FALSE); } if (rv == -1) return(FALSE); return(TRUE); #else EnvPrintRouter(theEnv,WDIALOG,"Load* is not available in this environment\n"); return(FALSE); #endif } #if DEBUGGING_FUNCTIONS /***********************************************************/ /* SaveCommand: H/L access routine for the save command. */ /***********************************************************/ globle int SaveCommand( void *theEnv) { #if (! BLOAD_ONLY) && (! RUN_TIME) char *theFileName; if (EnvArgCountCheck(theEnv,"save",EXACTLY,1) == -1) return(FALSE); if ((theFileName = GetFileName(theEnv,"save",1)) == NULL) return(FALSE); if (EnvSave(theEnv,theFileName) == FALSE) { OpenErrorMessage(theEnv,"save",theFileName); return(FALSE); } return(TRUE); #else EnvPrintRouter(theEnv,WDIALOG,"Save is not available in this environment\n"); return(FALSE); #endif } #endif clips-6.24/clipssrc/._constant.h0000400000175000017500000000075410443656577014763 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacojjǯ|TTFHUFMWBBMPSRclips-6.24/clipssrc/agenda.h0000755000175000017500000001630710441602024014122 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* AGENDA HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* Provides functionality for examining, manipulating, */ /* adding, and removing activations from the agenda. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES and */ /* DYNAMIC_SALIENCE compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EnvGetActivationBasisPPForm function. */ /* */ /*************************************************************/ #ifndef _H_agenda #define _H_agenda #ifndef _H_ruledef #include "ruledef.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_match #include "match.h" #endif #define WHEN_DEFINED 0 #define WHEN_ACTIVATED 1 #define EVERY_CYCLE 2 #define MAX_DEFRULE_SALIENCE 10000 #define MIN_DEFRULE_SALIENCE -10000 /*******************/ /* DATA STRUCTURES */ /*******************/ struct activation { struct defrule *theRule; struct partialMatch *basis; int salience; unsigned long int timetag; struct partialMatch *sortedBasis; int randomID; struct activation *prev; struct activation *next; }; typedef struct activation ACTIVATION; #define AGENDA_DATA 17 struct agendaData { #if DEBUGGING_FUNCTIONS unsigned WatchActivations; #endif unsigned long NumberOfActivations; unsigned long CurrentTimetag; int AgendaChanged; intBool SalienceEvaluation; int Strategy; }; #define EnvGetActivationSalience(theEnv,actPtr) (((struct activation *) actPtr)->salience) #define GetActivationRule(actPtr) (((struct activation *) actPtr)->theRule) #define GetActivationBasis(actPtr) (((struct activation *) actPtr)->basis) #define GetActivationSortedBasis(actPtr) (((struct activation *) actPtr)->sortedBasis) #define AgendaData(theEnv) ((struct agendaData *) GetEnvironmentData(theEnv,AGENDA_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _AGENDA_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /****************************************/ /* GLOBAL EXTERNAL FUNCTION DEFINITIONS */ /****************************************/ #if ENVIRONMENT_API_ONLY #define Agenda(theEnv,a,b) EnvAgenda(theEnv,a,b) #define DeleteActivation(theEnv,a) EnvDeleteActivation(theEnv,a) #define GetActivationName(theEnv,a) EnvGetActivationName(theEnv,a) #define GetActivationPPForm(theEnv,a,b,c) EnvGetActivationPPForm(theEnv,a,b,c) #define GetActivationSalience(theEnv,actPtr) (((struct activation *) actPtr)->salience) #define GetAgendaChanged(theEnv) EnvGetAgendaChanged(theEnv) #define GetNextActivation(theEnv,a) EnvGetNextActivation(theEnv,a) #define GetSalienceEvaluation(theEnv) EnvGetSalienceEvaluation(theEnv) #define Refresh(theEnv,a) EnvRefresh(theEnv,a) #define RefreshAgenda(theEnv,a) EnvRefreshAgenda(theEnv,a) #define ReorderAgenda(theEnv,a) EnvReorderAgenda(theEnv,a) #define SetActivationSalience(theEnv,a,b) EnvSetActivationSalience(theEnv,a,b) #define SetAgendaChanged(theEnv,a) EnvSetAgendaChanged(theEnv,a) #define SetSalienceEvaluation(theEnv,a) EnvSetSalienceEvaluation(theEnv,a) #else #define Agenda(a,b) EnvAgenda(GetCurrentEnvironment(),a,b) #define DeleteActivation(a) EnvDeleteActivation(GetCurrentEnvironment(),a) #define GetActivationName(a) EnvGetActivationName(GetCurrentEnvironment(),a) #define GetActivationPPForm(a,b,c) EnvGetActivationPPForm(GetCurrentEnvironment(),a,b,c) #define GetActivationSalience(actPtr) (((struct activation *) actPtr)->salience) #define GetAgendaChanged() EnvGetAgendaChanged(GetCurrentEnvironment()) #define GetNextActivation(a) EnvGetNextActivation(GetCurrentEnvironment(),a) #define GetSalienceEvaluation() EnvGetSalienceEvaluation(GetCurrentEnvironment()) #define Refresh(a) EnvRefresh(GetCurrentEnvironment(),a) #define RefreshAgenda(a) EnvRefreshAgenda(GetCurrentEnvironment(),a) #define ReorderAgenda(a) EnvReorderAgenda(GetCurrentEnvironment(),a) #define SetActivationSalience(a,b) EnvSetActivationSalience(GetCurrentEnvironment(),a,b) #define SetAgendaChanged(a) EnvSetAgendaChanged(GetCurrentEnvironment(),a) #define SetSalienceEvaluation(a) EnvSetSalienceEvaluation(GetCurrentEnvironment(),a) #endif LOCALE void AddActivation(void *,void *,void *); LOCALE void ClearRuleFromAgenda(void *,void *); LOCALE void *EnvGetNextActivation(void *,void *); LOCALE char *EnvGetActivationName(void *,void *); LOCALE int EnvSetActivationSalience(void *,void *,int); LOCALE void EnvGetActivationPPForm(void *,char *,unsigned,void *); LOCALE void EnvGetActivationBasisPPForm(void *,char *,unsigned,void *); LOCALE intBool MoveActivationToTop(void *,void *); LOCALE intBool EnvDeleteActivation(void *,void *); LOCALE intBool DetachActivation(void *,void *); LOCALE void EnvAgenda(void *,char *,void *); LOCALE void RemoveActivation(void *,void *,int,int); LOCALE void RemoveAllActivations(void *); LOCALE int EnvGetAgendaChanged(void *); LOCALE void EnvSetAgendaChanged(void *,int); LOCALE unsigned long GetNumberOfActivations(void *); LOCALE intBool EnvGetSalienceEvaluation(void *); LOCALE intBool EnvSetSalienceEvaluation(void *,intBool); LOCALE void EnvRefreshAgenda(void *,void *); LOCALE void EnvReorderAgenda(void *,void *); LOCALE void InitializeAgenda(void *); LOCALE void *SetSalienceEvaluationCommand(void *); LOCALE void *GetSalienceEvaluationCommand(void *); LOCALE void RefreshAgendaCommand(void *); LOCALE void RefreshCommand(void *); LOCALE intBool EnvRefresh(void *,void *); #if DEBUGGING_FUNCTIONS LOCALE void AgendaCommand(void *); #endif #endif clips-6.24/clipssrc/msgfun.c0000755000175000017500000010411310441150070014165 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* OBJECT MESSAGE FUNCTIONS */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #include "memalloc.h" #include "envrnmnt.h" #include "extnfunc.h" #include "insfun.h" #include "msgcom.h" #include "prccode.h" #include "router.h" #define _MSGFUN_SOURCE_ #include "msgfun.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS static HANDLER_LINK *DisplayPrimaryCore(void *,char *,HANDLER_LINK *,int); static void PrintPreviewHandler(void *,char *,HANDLER_LINK *,int,char *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************** NAME : UnboundHandlerErr DESCRIPTION : Print out a synopis of the currently executing handler for unbound variable errors INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Error synopsis printed to WERROR NOTES : None ********************************************************/ globle void UnboundHandlerErr( void *theEnv) { EnvPrintRouter(theEnv,WERROR,"message-handler "); PrintHandler(theEnv,WERROR,MessageHandlerData(theEnv)->CurrentCore->hnd,TRUE); } /***************************************************************** NAME : PrintNoHandlerError DESCRIPTION : Print "No primaries found" error message for send INPUTS : The name of the message RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *****************************************************************/ globle void PrintNoHandlerError( void *theEnv, char *msg) { PrintErrorID(theEnv,"MSGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No applicable primary message-handlers found for "); EnvPrintRouter(theEnv,WERROR,msg); EnvPrintRouter(theEnv,WERROR,".\n"); } /*************************************************************** NAME : CheckHandlerArgCount DESCRIPTION : Verifies that the current argument list satisfies the current handler's parameter count restriction INPUTS : None RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : EvaluationError set on errors NOTES : Uses ProcParamArraySize and CurrentCore globals ***************************************************************/ globle int CheckHandlerArgCount( void *theEnv) { HANDLER *hnd; hnd = MessageHandlerData(theEnv)->CurrentCore->hnd; if ((hnd->maxParams == -1) ? (ProceduralPrimitiveData(theEnv)->ProcParamArraySize < hnd->minParams) : (ProceduralPrimitiveData(theEnv)->ProcParamArraySize != hnd->minParams)) { SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"MSGFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Message-handler "); EnvPrintRouter(theEnv,WERROR,ValueToString(hnd->name)); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,MessageHandlerData(theEnv)->hndquals[hnd->type]); EnvPrintRouter(theEnv,WERROR," in class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) hnd->cls)); EnvPrintRouter(theEnv,WERROR," expected "); EnvPrintRouter(theEnv,WERROR,(char *) ((hnd->maxParams == -1) ? "at least " : "exactly ")); PrintLongInteger(theEnv,WERROR,(long) (hnd->minParams-1)); EnvPrintRouter(theEnv,WERROR," argument(s).\n"); return(FALSE); } return(TRUE); } /*************************************************** NAME : SlotAccessViolationError DESCRIPTION : Prints out an error message when attempt is made to set a read-only or initialize-only slot improperly INPUTS : 1) The slot name 2) A flag indicating if the source is a class or an instance 3) A pointer to the source instance/class RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ***************************************************/ globle void SlotAccessViolationError( void *theEnv, char *slotName, intBool instanceFlag, void *theInstanceOrClass) { PrintErrorID(theEnv,"MSGFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,slotName); EnvPrintRouter(theEnv,WERROR," slot in "); if (instanceFlag) PrintInstanceNameAndClass(theEnv,WERROR,(INSTANCE_TYPE *) theInstanceOrClass,FALSE); else { EnvPrintRouter(theEnv,WERROR,"class "); PrintClassName(theEnv,WERROR,(DEFCLASS *) theInstanceOrClass,FALSE); } EnvPrintRouter(theEnv,WERROR,": write access denied.\n"); } /*************************************************** NAME : SlotVisibilityViolationError DESCRIPTION : Prints out an error message when attempt is made to access a private slot improperly INPUTS : 1) The slot descriptor 2) A pointer to the source class RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ***************************************************/ globle void SlotVisibilityViolationError( void *theEnv, SLOT_DESC *sd, DEFCLASS *theDefclass) { PrintErrorID(theEnv,"MSGFUN",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Private slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sd->slotName->name)); EnvPrintRouter(theEnv,WERROR," of class "); PrintClassName(theEnv,WERROR,sd->cls,FALSE); EnvPrintRouter(theEnv,WERROR," cannot be accessed directly\n by handlers attached to class "); PrintClassName(theEnv,WERROR,theDefclass,TRUE); } #if ! RUN_TIME /****************************************************************************** NAME : NewSystemHandler DESCRIPTION : Adds a new system handler for a system class The handler is assumed to be primary and of the form: (defmessage-handler () ()) INPUTS : 1) Name-string of the system class 2) Name-string of the system handler 3) Name-string of the internal H/L function to implement this handler 4) The number of extra arguments (past the instance itself) that the handler willl accept RETURNS : Nothing useful SIDE EFFECTS : Creates the new handler and inserts it in the system class's handler array On errors, generate a system error and exits. NOTES : Does not check to see if handler already exists *******************************************************************************/ globle void NewSystemHandler( void *theEnv, char *cname, char *mname, char *fname, int extraargs) { DEFCLASS *cls; HANDLER *hnd; cls = LookupDefclassInScope(theEnv,cname); hnd = InsertHandlerHeader(theEnv,cls,(SYMBOL_HN *) EnvAddSymbol(theEnv,mname),MPRIMARY); IncrementSymbolCount(hnd->name); hnd->system = 1; hnd->minParams = hnd->maxParams = extraargs + 1; hnd->localVarCount = 0; hnd->actions = get_struct(theEnv,expr); hnd->actions->argList = NULL; hnd->actions->type = FCALL; hnd->actions->value = (void *) FindFunction(theEnv,fname); hnd->actions->nextArg = NULL; } /*************************************************** NAME : InsertHandlerHeader DESCRIPTION : Allocates a new handler header and inserts it in the proper (sorted) position in the class hnd array INPUTS : 1) The class 2) The handler name 3) The handler type RETURNS : The address of the new handler header, NULL on errors SIDE EFFECTS : Class handler array reallocated and resorted NOTES : Assumes handler does not exist ***************************************************/ globle HANDLER *InsertHandlerHeader( void *theEnv, DEFCLASS *cls, SYMBOL_HN *mname, int mtype) { HANDLER *nhnd,*hnd; unsigned *narr,*arr; unsigned i; register int j,ni = -1; hnd = cls->handlers; arr = cls->handlerOrderMap; nhnd = (HANDLER *) gm2(theEnv,(sizeof(HANDLER) * (cls->handlerCount+1))); narr = (unsigned *) gm2(theEnv,(sizeof(unsigned) * (cls->handlerCount+1))); GenCopyMemory(HANDLER,cls->handlerCount,nhnd,hnd); for (i = 0 , j = 0 ; i < cls->handlerCount ; i++ , j++) { if (ni == -1) { if ((hnd[arr[i]].name->bucket > mname->bucket) ? TRUE : (hnd[arr[i]].name == mname)) { ni = (int) i; j++; } } narr[j] = arr[i]; } if (ni == -1) ni = (int) cls->handlerCount; narr[ni] = cls->handlerCount; nhnd[cls->handlerCount].system = 0; nhnd[cls->handlerCount].type = mtype; nhnd[cls->handlerCount].busy = 0; nhnd[cls->handlerCount].mark = 0; #if DEBUGGING_FUNCTIONS nhnd[cls->handlerCount].trace = MessageHandlerData(theEnv)->WatchHandlers; #endif nhnd[cls->handlerCount].name = mname; nhnd[cls->handlerCount].cls = cls; nhnd[cls->handlerCount].minParams = 0; nhnd[cls->handlerCount].maxParams = 0; nhnd[cls->handlerCount].localVarCount = 0; nhnd[cls->handlerCount].actions = NULL; nhnd[cls->handlerCount].ppForm = NULL; nhnd[cls->handlerCount].usrData = NULL; if (cls->handlerCount != 0) { rm(theEnv,(void *) hnd,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) arr,(sizeof(unsigned) * cls->handlerCount)); } cls->handlers = nhnd; cls->handlerOrderMap = narr; cls->handlerCount++; return(&nhnd[cls->handlerCount-1]); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /***************************************************** NAME : HandlersExecuting DESCRIPTION : Determines if any message-handlers for a class are currently executing INPUTS : The class address RETURNS : TRUE if any handlers are executing, FALSE otherwise SIDE EFFECTS : None NOTES : None *****************************************************/ globle int HandlersExecuting( DEFCLASS *cls) { register unsigned i; for (i = 0 ; i < cls->handlerCount ; i++) if (cls->handlers[i].busy > 0) return(TRUE); return(FALSE); } /********************************************************************* NAME : DeleteHandler DESCRIPTION : Deletes one or more message-handlers from a class definition INPUTS : 1) The class address 2) The message-handler name (if this is * and there is no handler called *, then the delete operations will be applied to all handlers matching the type 3) The message-handler type (if this is -1, then the delete operations will be applied to all handlers matching the name 4) A flag saying whether to print error messages when handlers are not found meeting specs RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Handlers deleted NOTES : If any handlers for the class are currently executing, this routine will fail **********************************************************************/ globle int DeleteHandler( void *theEnv, DEFCLASS *cls, SYMBOL_HN *mname, int mtype, int indicate_missing) { register unsigned i; HANDLER *hnd; int found,success = 1; if (cls->handlerCount == 0) { if (indicate_missing) { HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); return(0); } return(1); } if (HandlersExecuting(cls)) { HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); return(0); } if (mtype == -1) { found = FALSE; for (i = MAROUND ; i <= MAFTER ; i++) { hnd = FindHandlerByAddress(cls,mname,(unsigned) i); if (hnd != NULL) { found = TRUE; if (hnd->system == 0) hnd->mark = 1; else { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); success = 0; } } } if ((found == FALSE) ? (strcmp(ValueToString(mname),"*") == 0) : FALSE) { for (i = 0 ; i < cls->handlerCount ; i++) if (cls->handlers[i].system == 0) cls->handlers[i].mark = 1; } } else { hnd = FindHandlerByAddress(cls,mname,(unsigned) mtype); if (hnd == NULL) { if (strcmp(ValueToString(mname),"*") == 0) { for (i = 0 ; i < cls->handlerCount ; i++) if ((cls->handlers[i].type == (unsigned) mtype) && (cls->handlers[i].system == 0)) cls->handlers[i].mark = 1; } else { if (indicate_missing) HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); success = 0; } } else if (hnd->system == 0) hnd->mark = 1; else { if (indicate_missing) { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); } success = 0; } } DeallocateMarkedHandlers(theEnv,cls); return(success); } /*************************************************** NAME : DeallocateMarkedHandlers DESCRIPTION : Removes any handlers from a class that have been previously marked for deletion. INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Marked handlers are deleted NOTES : Assumes none of the handlers are currently executing or have a busy count != 0 for any reason ***************************************************/ globle void DeallocateMarkedHandlers( void *theEnv, DEFCLASS *cls) { unsigned count; HANDLER *hnd,*nhnd; unsigned *arr,*narr; register unsigned i,j; for (i = 0 , count = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; if (hnd->mark == 1) { count++; DecrementSymbolCount(theEnv,hnd->name); ExpressionDeinstall(theEnv,hnd->actions); ReturnPackedExpression(theEnv,hnd->actions); ClearUserDataList(theEnv,hnd->usrData); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else /* ============================================ Use the busy field to count how many message-handlers are removed before this one ============================================ */ hnd->busy = count; } if (count == 0) return; if (count == cls->handlerCount) { rm(theEnv,(void *) cls->handlers,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) cls->handlerOrderMap,(sizeof(unsigned) * cls->handlerCount)); cls->handlers = NULL; cls->handlerOrderMap = NULL; cls->handlerCount = 0; } else { count = cls->handlerCount - count; hnd = cls->handlers; arr = cls->handlerOrderMap; nhnd = (HANDLER *) gm2(theEnv,(sizeof(HANDLER) * count)); narr = (unsigned *) gm2(theEnv,(sizeof(unsigned) * count)); for (i = 0 , j = 0 ; j < count ; i++) { if (hnd[arr[i]].mark == 0) { /* ============================================================== The offsets in the map need to be decremented by the number of preceding nodes which were deleted. Use the value of the busy field set in the first loop. ============================================================== */ narr[j] = arr[i] - hnd[arr[i]].busy; j++; } } for (i = 0 , j = 0 ; j < count ; i++) { if (hnd[i].mark == 0) { hnd[i].busy = 0; GenCopyMemory(HANDLER,1,&nhnd[j],&hnd[i]); j++; } } rm(theEnv,(void *) hnd,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) arr,(sizeof(unsigned) * cls->handlerCount)); cls->handlers = nhnd; cls->handlerOrderMap = narr; cls->handlerCount = count; } } #endif /***************************************************** NAME : HandlerType DESCRIPTION : Determines type of message-handler INPUTS : 1) Calling function string 2) String representing type RETURNS : MAROUND (0) for "around" MBEFORE (1) for "before" MPRIMARY (2) for "primary" MAFTER (3) for "after" MERROR (4) on errors SIDE EFFECTS : None NOTES : None *****************************************************/ globle unsigned HandlerType( void *theEnv, char *func, char *str) { register unsigned i; for (i = MAROUND ; i <= MAFTER ; i++) if (strcmp(str,MessageHandlerData(theEnv)->hndquals[i]) == 0) { return(i); } PrintErrorID(theEnv,"MSGFUN",7,FALSE); EnvPrintRouter(theEnv,"werror","Unrecognized message-handler type in "); EnvPrintRouter(theEnv,"werror",func); EnvPrintRouter(theEnv,"werror",".\n"); return(MERROR); } /***************************************************************** NAME : CheckCurrentMessage DESCRIPTION : Makes sure that a message is available and active for an internal message function INPUTS : 1) The name of the function checking the message 2) A flag indicating whether the object must be a class instance or not (it could be a primitive type) RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : EvaluationError set on errors NOTES : None *****************************************************************/ globle int CheckCurrentMessage( void *theEnv, char *func, int ins_reqd) { register DATA_OBJECT *activeMsgArg; if (!MessageHandlerData(theEnv)->CurrentCore || (MessageHandlerData(theEnv)->CurrentCore->hnd->actions != ProceduralPrimitiveData(theEnv)->CurrentProcActions)) { PrintErrorID(theEnv,"MSGFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR," may only be called from within message-handlers.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } activeMsgArg = GetNthMessageArgument(theEnv,0); if ((ins_reqd == TRUE) ? (activeMsgArg->type != INSTANCE_ADDRESS) : FALSE) { PrintErrorID(theEnv,"MSGFUN",5,FALSE); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR," operates only on instances.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if ((activeMsgArg->type == INSTANCE_ADDRESS) ? (((INSTANCE_TYPE *) activeMsgArg->value)->garbage == 1) : FALSE) { StaleInstanceAddress(theEnv,func,0); SetEvaluationError(theEnv,TRUE); return(FALSE); } return(TRUE); } /*************************************************** NAME : PrintHandler DESCRIPTION : Displays a handler synopsis INPUTS : 1) Logical name of output 2) The handler 5) Flag indicating whether to printout a terminating newline RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void PrintHandler( void *theEnv, char *logName, HANDLER *theHandler, int crtn) { EnvPrintRouter(theEnv,logName,ValueToString(theHandler->name)); EnvPrintRouter(theEnv,logName," "); EnvPrintRouter(theEnv,logName,MessageHandlerData(theEnv)->hndquals[theHandler->type]); EnvPrintRouter(theEnv,logName," in class "); PrintClassName(theEnv,logName,theHandler->cls,crtn); } /*********************************************************** NAME : FindHandlerByAddress DESCRIPTION : Uses a binary search on a class's handler header array INPUTS : 1) The class address 2) The handler symbolic name 3) The handler type (MPRIMARY,etc.) RETURNS : The address of the found handler, NULL if not found SIDE EFFECTS : None NOTES : Assumes array is in ascending order 1st key: symbolic name of handler 2nd key: type of handler ***********************************************************/ globle HANDLER *FindHandlerByAddress( DEFCLASS *cls, SYMBOL_HN *name, unsigned type) { register int b; unsigned i; HANDLER *hnd; unsigned *arr; if ((b = FindHandlerNameGroup(cls,name)) == -1) return(NULL); arr = cls->handlerOrderMap; hnd = cls->handlers; for (i = (unsigned) b ; i < cls->handlerCount ; i++) { if (hnd[arr[i]].name != name) return(NULL); if (hnd[arr[i]].type == type) return(&hnd[arr[i]]); } return(NULL); } /*********************************************************** NAME : FindHandlerByAddress DESCRIPTION : Uses a binary search on a class's handler header array INPUTS : 1) The class address 2) The handler symbolic name 3) The handler type (MPRIMARY,etc.) RETURNS : The index of the found handler, -1 if not found SIDE EFFECTS : None NOTES : Assumes array is in ascending order 1st key: symbolic name of handler 2nd key: type of handler ***********************************************************/ globle int FindHandlerByIndex( DEFCLASS *cls, SYMBOL_HN *name, unsigned type) { register int b; unsigned i; HANDLER *hnd; unsigned *arr; if ((b = FindHandlerNameGroup(cls,name)) == -1) return(-1); arr = cls->handlerOrderMap; hnd = cls->handlers; for (i = (unsigned) b ; i < cls->handlerCount ; i++) { if (hnd[arr[i]].name != name) return(-1); if (hnd[arr[i]].type == type) return((int) arr[i]); } return(-1); } /***************************************************** NAME : FindHandlerNameGroup DESCRIPTION : Uses a binary search on a class's handler header array INPUTS : 1) The class address 2) The handler symbolic name RETURNS : The index of the found handler group -1 if not found SIDE EFFECTS : None NOTES : Assumes array is in ascending order 1st key: handler name symbol bucket *****************************************************/ globle int FindHandlerNameGroup( DEFCLASS *cls, SYMBOL_HN *name) { register int b,e,i,j; HANDLER *hnd; unsigned *arr; int start; if (cls->handlerCount == 0) return(-1); hnd = cls->handlers; arr = cls->handlerOrderMap; b = 0; e = (int) (cls->handlerCount-1); start = -1; do { i = (b+e)/2; if (name->bucket == hnd[arr[i]].name->bucket) { for (j = i ; j >= b ; j--) { if (hnd[arr[j]].name == name) start = j; if (hnd[arr[j]].name->bucket != name->bucket) break; } if (start != -1) return(start); for (j = i+1 ; j <= e ; j++) { if (hnd[arr[j]].name == name) return(j); if (hnd[arr[j]].name->bucket != name->bucket) return(-1); } return(-1); } else if (name->bucket < hnd[arr[i]].name->bucket) e = i-1; else b = i+1; } while (b <= e); return(-1); } /*************************************************** NAME : HandlerDeleteError DESCRIPTION : Prints out an error message when handlers cannot be deleted INPUTS : Name-string of the class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void HandlerDeleteError( void *theEnv, char *cname) { PrintErrorID(theEnv,"MSGFUN",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handler(s) from class "); EnvPrintRouter(theEnv,WERROR,cname); EnvPrintRouter(theEnv,WERROR,".\n"); } #if DEBUGGING_FUNCTIONS /******************************************************************** NAME : DisplayCore DESCRIPTION : Gives a schematic "printout" of the core framework for a message showing arounds, primaries, shadows etc. This routine uses recursion to print indentation to indicate shadowing and where handlers begin and end execution wrt one another. INPUTS : 1) Logical name of output 2) The remaining core 3) The number of handlers this (partial) core shadows RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Expects that the core was created in PREVIEW mode, i.e. implicit handlers are SLOT_DESC addresses (in PERFORM mode they are INSTANCE_SLOT addresses) Assumes (partial) core is not empty ********************************************************************/ globle void DisplayCore( void *theEnv, char *logicalName, HANDLER_LINK *core, int sdepth) { if (core->hnd->type == MAROUND) { PrintPreviewHandler(theEnv,logicalName,core,sdepth,BEGIN_TRACE); if (core->nxt != NULL) DisplayCore(theEnv,logicalName,core->nxt,sdepth+1); PrintPreviewHandler(theEnv,logicalName,core,sdepth,END_TRACE); } else { while ((core != NULL) ? (core->hnd->type == MBEFORE) : FALSE) { PrintPreviewHandler(theEnv,logicalName,core,sdepth,BEGIN_TRACE); PrintPreviewHandler(theEnv,logicalName,core,sdepth,END_TRACE); core = core->nxt; } if ((core != NULL) ? (core->hnd->type == MPRIMARY) : FALSE) core = DisplayPrimaryCore(theEnv,logicalName,core,sdepth); while ((core != NULL) ? (core->hnd->type == MAFTER) : FALSE) { PrintPreviewHandler(theEnv,logicalName,core,sdepth,BEGIN_TRACE); PrintPreviewHandler(theEnv,logicalName,core,sdepth,END_TRACE); core = core->nxt; } } } /******************************************************************* NAME : FindPreviewApplicableHandlers DESCRIPTION : See FindApplicableHandlers However, this function only examines classes rather than instances for implicit slot-accessors INPUTS : 1) The class address 2) The message name symbol RETURNS : The links of applicable handlers, NULL on errors SIDE EFFECTS : Links are allocated for the list NOTES : None ******************************************************************/ globle HANDLER_LINK *FindPreviewApplicableHandlers( void *theEnv, DEFCLASS *cls, SYMBOL_HN *mname) { register int i; HANDLER_LINK *tops[4],*bots[4]; for (i = MAROUND ; i <= MAFTER ; i++) tops[i] = bots[i] = NULL; for (i = 0 ; i < cls->allSuperclasses.classCount ; i++) FindApplicableOfName(theEnv,cls->allSuperclasses.classArray[i],tops,bots,mname); return(JoinHandlerLinks(theEnv,tops,bots,mname)); } /*********************************************************** NAME : WatchMessage DESCRIPTION : Prints a condensed description of a message and its arguments INPUTS : 1) The output logical name 2) BEGIN_TRACE or END_TRACE string RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the global variables ProcParamArray and CurrentMessageName ***********************************************************/ globle void WatchMessage( void *theEnv, char *logName, char *tstring) { EnvPrintRouter(theEnv,logName,"MSG "); EnvPrintRouter(theEnv,logName,tstring); EnvPrintRouter(theEnv,logName," "); EnvPrintRouter(theEnv,logName,ValueToString(MessageHandlerData(theEnv)->CurrentMessageName)); EnvPrintRouter(theEnv,logName," ED:"); PrintLongInteger(theEnv,logName,(long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,logName); } /*********************************************************** NAME : WatchHandler DESCRIPTION : Prints a condensed description of a message-handler and its arguments INPUTS : 1) The output logical name 2) The handler address 3) BEGIN_TRACE or END_TRACE string RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the global variables ProcParamArray and CurrentMessageName ***********************************************************/ globle void WatchHandler( void *theEnv, char *logName, HANDLER_LINK *hndl, char *tstring) { HANDLER *hnd; EnvPrintRouter(theEnv,logName,"HND "); EnvPrintRouter(theEnv,logName,tstring); EnvPrintRouter(theEnv,logName," "); hnd = hndl->hnd; PrintHandler(theEnv,WTRACE,hnd,TRUE); EnvPrintRouter(theEnv,logName," ED:"); PrintLongInteger(theEnv,logName,(long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,logName); } #endif /* DEBUGGING_FUNCTIONS */ /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS /******************************************************************** NAME : DisplayPrimaryCore DESCRIPTION : Gives a schematic "printout" of the primary message showing other shadowed primaries This routine uses recursion to print indentation to indicate shadowing and where handlers begin and end execution wrt one another. INPUTS : 1) The logical name of the output 2) The remaining core 3) The number of handlers this (partial) core shadows RETURNS : The address of the handler following the primary group of handlers in the core SIDE EFFECTS : None NOTES : Expects that the core was created in PREVIEW mode, i.e. implicit handlers are SLOT_DESC addresses (in PERFORM mode they are INSTANCE_SLOT addresses) Assumes (partial) core is not empty ********************************************************************/ static HANDLER_LINK *DisplayPrimaryCore( void *theEnv, char *logicalName, HANDLER_LINK *core, int pdepth) { register HANDLER_LINK *rtn; PrintPreviewHandler(theEnv,logicalName,core,pdepth,BEGIN_TRACE); if ((core->nxt != NULL) ? (core->nxt->hnd->type == MPRIMARY) : FALSE) rtn = DisplayPrimaryCore(theEnv,logicalName,core->nxt,pdepth+1); else rtn = core->nxt; PrintPreviewHandler(theEnv,logicalName,core,pdepth,END_TRACE); return(rtn); } /*************************************************** NAME : PrintPreviewHandler DESCRIPTION : Displays a message preview INPUTS : 1) The logical name of the output 2) Handler-link 3) Number of handlers shadowed 4) The trace-string RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void PrintPreviewHandler( void *theEnv, char *logicalName, HANDLER_LINK *cptr, int sdepth, char *tstr) { register int i; for (i = 0 ; i < sdepth ; i++) EnvPrintRouter(theEnv,logicalName,"| "); EnvPrintRouter(theEnv,logicalName,tstr); EnvPrintRouter(theEnv,logicalName," "); PrintHandler(theEnv,logicalName,cptr->hnd,TRUE); } #endif #endif clips-6.24/clipssrc/modulcmp.c0000755000175000017500000004521710441121235014520 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFMODULE CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defmodule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* */ /*************************************************************/ #define _MODULCMP_SOURCE_ #include "setup.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "moduldef.h" #include "sysdep.h" #include "envrnmnt.h" #include "modulcmp.h" /***************/ /* DEFINITIONS */ /***************/ #define ItemPrefix() ArbitraryPrefix(DefmoduleData(theEnv)->DefmoduleCodeItem,0) #define DefmodulePrefix() ArbitraryPrefix(DefmoduleData(theEnv)->DefmoduleCodeItem,1) #define PortPrefix() ArbitraryPrefix(DefmoduleData(theEnv)->DefmoduleCodeItem,2) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,char *,int,FILE *,int,int); static void InitDefmoduleCode(void *,FILE *,int,int); static struct portItem *GetNextPortItem(void *,struct defmodule **,struct portItem **, int *,int *); static int PortItemsToCode(void *,char *,int,FILE *,int,int,int *); static void BeforeDefmodulesToCode(void *); /***************************************************************/ /* DefmoduleCompilerSetup: Initializes the defmodule construct */ /* for use with the constructs-to-c command. */ /***************************************************************/ globle void DefmoduleCompilerSetup( void *theEnv) { DefmoduleData(theEnv)->DefmoduleCodeItem = AddCodeGeneratorItem(theEnv,"defmodule",200,BeforeDefmodulesToCode, InitDefmoduleCode,ConstructToCode,3); } /***********************************************************/ /* BeforeDefmodulesToCode: Assigns each defmodule a unique */ /* ID which will be used for pointer references when the */ /* data structures are written to a file as C code */ /***********************************************************/ static void BeforeDefmodulesToCode( void *theEnv) { int value = 0; struct defmodule *theModule; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { theModule->bsaveID = value++; } } /*************************************************************/ /* PrintDefmoduleReference: Writes the C code representation */ /* of a reference to a defmodule data structure. */ /*************************************************************/ globle void PrintDefmoduleReference( void *theEnv, FILE *theFile, struct defmodule *theModule) { if (theModule == NULL) fprintf(theFile,"NULL"); else fprintf(theFile,"&%s%d_%ld[%ld]",DefmodulePrefix(),ConstructCompilerData(theEnv)->ImageID, (long) ((theModule->bsaveID / ConstructCompilerData(theEnv)->MaxIndices) + 1), (long) (theModule->bsaveID % ConstructCompilerData(theEnv)->MaxIndices)); } /************************************************/ /* InitDefmoduleCode: Writes out initialization */ /* code for defmodules for a run-time module. */ /************************************************/ #if IBM_TBC #pragma argsused #endif static void InitDefmoduleCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(maxIndices) #endif if (EnvGetNextDefmodule(theEnv,NULL) != NULL) { fprintf(initFP," SetListOfDefmodules(theEnv,(void *) %s%d_1);\n",DefmodulePrefix(),imageID); } else { fprintf(initFP," SetListOfDefmodules(theEnv,NULL);\n"); } fprintf(initFP," EnvSetCurrentModule(theEnv,(void *) EnvGetNextDefmodule(theEnv,NULL));\n"); } /***********************************************************/ /* ConstructToCode: Produces defmodule code for a run-time */ /* module created using the constructs-to-c function. */ /***********************************************************/ static int ConstructToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { struct defmodule *theConstruct; FILE *moduleFile = NULL, *itemsFile; int portItemCount = 0; struct portItem *portItemPtr; int mihCount = 0, moduleCount = 0; int j; struct moduleItem *theItem; int moduleArrayVersion = 1; int fileCount = 2; /*================================================*/ /* Include the appropriate defmodule header file. */ /*================================================*/ fprintf(headerFP,"#include \"moduldef.h\"\n"); /*============================================*/ /* Open up the items file for the defmodules. */ /* Only one file of this type is created so */ /* the maximum number of indices is ignored. */ /*============================================*/ if ((itemsFile = NewCFile(theEnv,fileName,fileID,1,FALSE)) == NULL) { return(FALSE); } fprintf(itemsFile,"struct defmoduleItemHeader *%s%d_%d[] = {\n",ItemPrefix(),imageID,1); fprintf(headerFP,"extern struct defmoduleItemHeader *%s%d_%d[];\n",ItemPrefix(),imageID,1); /*======================================================*/ /* Loop through all the defmodules writing their C code */ /* representation to the file as they are traversed. */ /*======================================================*/ for (theConstruct = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theConstruct != NULL; theConstruct = (struct defmodule *) EnvGetNextDefmodule(theEnv,theConstruct)) { /*===========================================*/ /* Open a new file to write to if necessary. */ /*===========================================*/ moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,fileID,imageID, &fileCount,moduleArrayVersion,headerFP, "struct defmodule",DefmodulePrefix(), FALSE,NULL); if (moduleFile == NULL) { moduleCount = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&moduleCount, &moduleArrayVersion,maxIndices,NULL,NULL); GenClose(theEnv,itemsFile); return(FALSE); } /*======================================*/ /* Write the construct name and ppform. */ /*======================================*/ fprintf(moduleFile,"{"); PrintSymbolReference(theEnv,moduleFile,theConstruct->name); fprintf(moduleFile,",NULL,"); /*=====================================================*/ /* Write the items array pointers to other constructs. */ /*=====================================================*/ fprintf(moduleFile,"&%s%d_1[%d],",ItemPrefix(),imageID,mihCount); for (j = 0, theItem = GetListOfModuleItems(theEnv); (j < GetNumberOfModuleItems(theEnv)) && (theItem != NULL) ; j++, theItem = theItem->next) { mihCount++; if (theItem->constructsToCModuleReference == NULL) { fprintf(itemsFile,"NULL"); } else { (*theItem->constructsToCModuleReference)(theEnv,itemsFile,(int) theConstruct->bsaveID,imageID,maxIndices); } if ((j + 1) < GetNumberOfModuleItems(theEnv)) fprintf(itemsFile,","); else if (theConstruct->next != NULL) fprintf(itemsFile,",\n"); } /*=================================*/ /* Write the importList reference. */ /*=================================*/ if (theConstruct->importList == NULL) { fprintf(moduleFile,"NULL,"); } else { fprintf(moduleFile,"&%s%d_%d[%d],",PortPrefix(),imageID, (portItemCount / maxIndices) + 1, portItemCount % maxIndices); for (portItemPtr = theConstruct->importList; portItemPtr != NULL; portItemPtr = portItemPtr->next) { portItemCount++; } } /*=================================*/ /* Write the exportList reference. */ /*=================================*/ if (theConstruct->exportList == NULL) { fprintf(moduleFile,"NULL,"); } else { fprintf(moduleFile,"&%s%d_%d[%d],",PortPrefix(),imageID, (portItemCount / maxIndices) + 1, portItemCount % maxIndices); for (portItemPtr = theConstruct->exportList; portItemPtr != NULL; portItemPtr = portItemPtr->next) { portItemCount++; } } /*=====================*/ /* Write the bsave id. */ /*=====================*/ fprintf(moduleFile,"0,%ld,",theConstruct->bsaveID); /*======================*/ /* Write the user data. */ /*======================*/ fprintf(moduleFile,"NULL,"); /*===========================*/ /* Write the next reference. */ /*===========================*/ if (theConstruct->next == NULL) { fprintf(moduleFile,"NULL}"); } else { fprintf(moduleFile,"&%s%d_%d[%d]}",ConstructPrefix(DefmoduleData(theEnv)->DefmoduleCodeItem),imageID, (int) (theConstruct->next->bsaveID / maxIndices) + 1, (int) theConstruct->next->bsaveID % maxIndices); } /*===================================================*/ /* Increment the number of defmodule data structures */ /* written and close the output file if necessary. */ /*===================================================*/ moduleCount++; moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleCount,&moduleArrayVersion, maxIndices,NULL,NULL); } /*=========================*/ /* Close the output files. */ /*=========================*/ moduleCount = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&moduleCount, &moduleArrayVersion,maxIndices,NULL,NULL); fprintf(itemsFile,"};\n"); GenClose(theEnv,itemsFile); /*=========================================*/ /* Write out the portItem data structures. */ /*=========================================*/ if (portItemCount == 0) return(TRUE); return(PortItemsToCode(theEnv,fileName,fileID,headerFP,imageID,maxIndices,&fileCount)); } /************************************************************/ /* PortItemsToCode: Writes the C code representation of all */ /* portItem data structure nodes the specified file. */ /************************************************************/ static int PortItemsToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { struct defmodule *theDefmodule = NULL; struct portItem *thePortItem = NULL; int portItemCount = 0; int importChecked = FALSE; int exportChecked = FALSE; FILE *portItemsFile = NULL; int portItemArrayVersion = 1; /*=================================================================*/ /* Loop through each of the portItem data structures writing their */ /* C code representation to the file as they are traversed. */ /*=================================================================*/ for (thePortItem = GetNextPortItem(theEnv,&theDefmodule,&thePortItem,&importChecked,&exportChecked); thePortItem != NULL; thePortItem = GetNextPortItem(theEnv,&theDefmodule,&thePortItem,&importChecked,&exportChecked)) { /*===========================================*/ /* Open a new file to write to if necessary. */ /*===========================================*/ portItemsFile = OpenFileIfNeeded(theEnv,portItemsFile,fileName,fileID,imageID, fileCount,portItemArrayVersion,headerFP, "struct portItem",PortPrefix(), FALSE,NULL); if (portItemsFile == NULL) { portItemCount = maxIndices; CloseFileIfNeeded(theEnv,portItemsFile,&portItemCount, &portItemArrayVersion,maxIndices,NULL,NULL); return(FALSE); } /*================================================*/ /* Write the portItem data structure to the file. */ /*================================================*/ fprintf(portItemsFile,"{"); PrintSymbolReference(theEnv,portItemsFile,thePortItem->moduleName); fprintf(portItemsFile,","); PrintSymbolReference(theEnv,portItemsFile,thePortItem->constructType); fprintf(portItemsFile,","); PrintSymbolReference(theEnv,portItemsFile,thePortItem->constructName); fprintf(portItemsFile,","); if (thePortItem->next == NULL) { fprintf(portItemsFile,"NULL}"); } else { fprintf(portItemsFile,"&%s%d_%d[%d]}",PortPrefix(),imageID, ((portItemCount+1) / maxIndices) + 1, (portItemCount+1) % maxIndices); } /*==================================================*/ /* Increment the number of portItem data structures */ /* written and close the output file if necessary. */ /*==================================================*/ portItemCount++; CloseFileIfNeeded(theEnv,portItemsFile,&portItemCount,&portItemArrayVersion, maxIndices,NULL,NULL); } /*===================================================*/ /* Close the output file and return TRUE to indicate */ /* the data structures were successfully written. */ /*===================================================*/ portItemCount = maxIndices; CloseFileIfNeeded(theEnv,portItemsFile,&portItemCount, &portItemArrayVersion,maxIndices,NULL,NULL); return(TRUE); } /*********************************************************************/ /* GetNextPortItem: Given a pointer to a portItem data structure */ /* and its defmodule, returns the "next" portItem data structure. */ /* If passed a NULL value for both the defmodule and portItem */ /* data structure, it returns the "first" portItem data structure. */ /*********************************************************************/ static struct portItem *GetNextPortItem( void *theEnv, struct defmodule **theDefmodule, struct portItem **thePortItem, int *importChecked, int *exportChecked) { /*====================================================*/ /* If the defmodule pointer is NULL, then the "first" */ /* portItem data structure should be returned. Start */ /* the search in the "first" defmodule. */ /*====================================================*/ if (*theDefmodule == NULL) { *theDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); *thePortItem = NULL; *importChecked = FALSE; *exportChecked = FALSE; } /*==============================================*/ /* Loop through all of the defmodules until the */ /* "next" portItem data structure is found. */ /*==============================================*/ while (*theDefmodule != NULL) { /*==========================================*/ /* Check to see if there's another portItem */ /* in the import/export list that's being */ /* checked in the module being examined. */ /*==========================================*/ if (*thePortItem != NULL) *thePortItem = (*thePortItem)->next; if (*thePortItem != NULL) return(*thePortItem); /*==================================================*/ /* If we haven't checked the import list yet, begin */ /* checking it. If there aren't any items in the */ /* import list, then check the export list. */ /*==================================================*/ if (! (*importChecked)) { *thePortItem = (*theDefmodule)->importList; *importChecked = TRUE; if (*thePortItem == NULL) { *thePortItem = (*theDefmodule)->exportList; *exportChecked = TRUE; } } /*======================================*/ /* Otherwise, if we haven't checked the */ /* export list yet, begin checking it. */ /*======================================*/ else if (! (*exportChecked)) { *exportChecked = TRUE; *thePortItem = (*theDefmodule)->exportList; } /*==========================================*/ /* If the import or export list contained a */ /* portItem data structure, then return it. */ /*==========================================*/ if (*thePortItem != NULL) return(*thePortItem); /*==================================*/ /* Otherwise, check the next module */ /* for a portItem data structure. */ /*==================================*/ *theDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,*theDefmodule); *importChecked = FALSE; *exportChecked = FALSE; } /*=======================================================*/ /* All the portItem data structures have been traversed. */ /* Return NULL to indicate that none are left. */ /*=======================================================*/ return(NULL); } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ clips-6.24/clipssrc/factqpsr.c0000644000175000017500000006142610441143423014523 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FACT-SET QUERIES PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Fact_set Queries Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* 6.23: Added fact-set queries. */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if FACT_SET_QUERIES && (! RUN_TIME) #include #include "envrnmnt.h" #include "exprnpsr.h" #include "extnfunc.h" #include "factqury.h" #include "modulutl.h" #include "prcdrpsr.h" #include "prntutil.h" #include "router.h" #include "scanner.h" #include "strngrtr.h" #define _FACTQPSR_SOURCE_ #include "factqpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define FACT_SLOT_REF ':' /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static EXPRESSION *ParseQueryRestrictions(void *,EXPRESSION *,char *,struct token *); static intBool ReplaceTemplateNameWithReference(void *,EXPRESSION *); static int ParseQueryTestExpression(void *,EXPRESSION *,char *); static int ParseQueryActionExpression(void *,EXPRESSION *,char *,EXPRESSION *,struct token *); static void ReplaceFactVariables(void *,EXPRESSION *,EXPRESSION *,int,int); static void ReplaceSlotReference(void *,EXPRESSION *,EXPRESSION *, struct FunctionDefinition *,int); static int IsQueryFunction(EXPRESSION *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************************** NAME : FactParseQueryNoAction DESCRIPTION : Parses the following functions : (any-factp) (find-first-fact) (find-all-facts) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : ( ) :== (+) :== ( +) Parses into following form : | V -> -> -> (QDS) -> -> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *FactParseQueryNoAction( void *theEnv, EXPRESSION *top, char *readSource) { EXPRESSION *factQuerySetVars; struct token queryInputToken; factQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (factQuerySetVars == NULL) { return(NULL); } IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); GetToken(theEnv,readSource,&queryInputToken); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } ReplaceFactVariables(theEnv,factQuerySetVars,top->argList,TRUE,0); ReturnExpression(theEnv,factQuerySetVars); return(top); } /*********************************************************************** NAME : FactParseQueryAction DESCRIPTION : Parses the following functions : (do-for-fact) (do-for-all-facts) (delayed-do-for-all-facts) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : ( ) :== (+) :== ( +) Parses into following form : | V -> -> -> -> (QDS) -> -> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *FactParseQueryAction( void *theEnv, EXPRESSION *top, char *readSource) { EXPRESSION *factQuerySetVars; struct token queryInputToken; factQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (factQuerySetVars == NULL) { return(NULL); } IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } PPCRAndIndent(theEnv); if (ParseQueryActionExpression(theEnv,top,readSource,factQuerySetVars,&queryInputToken) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } ReplaceFactVariables(theEnv,factQuerySetVars,top->argList,TRUE,0); ReplaceFactVariables(theEnv,factQuerySetVars,top->argList->nextArg,FALSE,0); ReturnExpression(theEnv,factQuerySetVars); return(top); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************** NAME : ParseQueryRestrictions DESCRIPTION : Parses the template restrictions for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input 3) Caller's token buffer RETURNS : The fact-variable expressions SIDE EFFECTS : Entire query expression deleted on errors Nodes allocated for restrictions and fact variable expressions Template restrictions attached to query-expression as arguments NOTES : Expects top != NULL ***************************************************************/ static EXPRESSION *ParseQueryRestrictions( void *theEnv, EXPRESSION *top, char *readSource, struct token *queryInputToken) { EXPRESSION *factQuerySetVars = NULL,*lastFactQuerySetVars = NULL, *templateExp = NULL,*lastTemplateExp, *tmp,*lastOne = NULL; int error = FALSE; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != LPAREN) { goto ParseQueryRestrictionsError1; } GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != LPAREN) { goto ParseQueryRestrictionsError1; } while (queryInputToken->type == LPAREN) { GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != SF_VARIABLE) { goto ParseQueryRestrictionsError1; } tmp = factQuerySetVars; while (tmp != NULL) { if (tmp->value == queryInputToken->value) { PrintErrorID(theEnv,"FACTQPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate fact member variable name in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); goto ParseQueryRestrictionsError2; } tmp = tmp->nextArg; } tmp = GenConstant(theEnv,SF_VARIABLE,queryInputToken->value); if (factQuerySetVars == NULL) { factQuerySetVars = tmp; } else { lastFactQuerySetVars->nextArg = tmp; } lastFactQuerySetVars = tmp; SavePPBuffer(theEnv," "); templateExp = ArgumentParse(theEnv,readSource,&error); if (error) { goto ParseQueryRestrictionsError2; } if (templateExp == NULL) { goto ParseQueryRestrictionsError1; } if (ReplaceTemplateNameWithReference(theEnv,templateExp) == FALSE) { goto ParseQueryRestrictionsError2; } lastTemplateExp = templateExp; SavePPBuffer(theEnv," "); while ((tmp = ArgumentParse(theEnv,readSource,&error)) != NULL) { if (ReplaceTemplateNameWithReference(theEnv,tmp) == FALSE) goto ParseQueryRestrictionsError2; lastTemplateExp->nextArg = tmp; lastTemplateExp = tmp; SavePPBuffer(theEnv," "); } if (error) { goto ParseQueryRestrictionsError2; } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); tmp = GenConstant(theEnv,SYMBOL,(void *) FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); lastTemplateExp->nextArg = tmp; lastTemplateExp = tmp; if (top->argList == NULL) { top->argList = templateExp; } else { lastOne->nextArg = templateExp; } lastOne = lastTemplateExp; templateExp = NULL; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,queryInputToken); } if (queryInputToken->type != RPAREN) { goto ParseQueryRestrictionsError1; } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); return(factQuerySetVars); ParseQueryRestrictionsError1: SyntaxErrorMessage(theEnv,"fact-set query function"); ParseQueryRestrictionsError2: ReturnExpression(theEnv,templateExp); ReturnExpression(theEnv,top); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } /*************************************************** NAME : ReplaceTemplateNameWithReference DESCRIPTION : In parsing an fact-set query, this function replaces a constant template name with an actual pointer to the template INPUTS : The expression RETURNS : TRUE if all OK, FALSE if template cannot be found SIDE EFFECTS : The expression type and value are modified if template is found NOTES : Searches current and imported modules for reference ***************************************************/ static intBool ReplaceTemplateNameWithReference( void *theEnv, EXPRESSION *theExp) { char *theTemplateName; void *theDeftemplate; int count; if (theExp->type == SYMBOL) { theTemplateName = ValueToString(theExp->value); theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,theTemplateName, &count,TRUE,NULL); if (theDeftemplate == NULL) { /* TBD */ CantFindItemErrorMessage(theEnv,"deftemplate",theTemplateName); return(FALSE); } if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",theTemplateName); return(FALSE); } theExp->type = DEFTEMPLATE_PTR; theExp->value = theDeftemplate; } return(TRUE); } /************************************************************* NAME : ParseQueryTestExpression DESCRIPTION : Parses the test-expression for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Entire query-expression deleted on errors Nodes allocated for new expression Test shoved in front of class-restrictions on query argument list NOTES : Expects top != NULL *************************************************************/ static int ParseQueryTestExpression( void *theEnv, EXPRESSION *top, char *readSource) { EXPRESSION *qtest; int error; struct BindInfo *oldBindList; error = FALSE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); qtest = ArgumentParse(theEnv,readSource,&error); if (error == TRUE) { SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(FALSE); } if (qtest == NULL) { SetParsedBindNames(theEnv,oldBindList); SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); return(FALSE); } qtest->nextArg = top->argList; top->argList = qtest; if (ParsedBindNamesEmpty(theEnv) == FALSE) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"FACTQPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in fact-set query in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); ReturnExpression(theEnv,top); return(FALSE); } SetParsedBindNames(theEnv,oldBindList); return(TRUE); } /************************************************************* NAME : ParseQueryActionExpression DESCRIPTION : Parses the action-expression for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input 3) List of query parameters RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Entire query-expression deleted on errors Nodes allocated for new expression Action shoved in front of template-restrictions and in back of test-expression on query argument list NOTES : Expects top != NULL && top->argList != NULL *************************************************************/ static int ParseQueryActionExpression( void *theEnv, EXPRESSION *top, char *readSource, EXPRESSION *factQuerySetVars, struct token *queryInputToken) { EXPRESSION *qaction,*tmpFactSetVars; int error; struct BindInfo *oldBindList,*newBindList,*prev; error = FALSE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); ExpressionData(theEnv)->BreakContext = TRUE; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; qaction = GroupActions(theEnv,readSource,queryInputToken,TRUE,NULL,FALSE); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,queryInputToken->printForm); ExpressionData(theEnv)->BreakContext = FALSE; if (error == TRUE) { SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(FALSE); } if (qaction == NULL) { SetParsedBindNames(theEnv,oldBindList); SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); return(FALSE); } qaction->nextArg = top->argList->nextArg; top->argList->nextArg = qaction; newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { tmpFactSetVars = factQuerySetVars; while (tmpFactSetVars != NULL) { if (tmpFactSetVars->value == (void *) newBindList->name) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"FACTQPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind fact-set member variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(tmpFactSetVars->value)); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); ReturnExpression(theEnv,top); return(FALSE); } tmpFactSetVars = tmpFactSetVars->nextArg; } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) { SetParsedBindNames(theEnv,oldBindList); } else { prev->next = oldBindList; } return(TRUE); } /*********************************************************************************** NAME : ReplaceFactVariables DESCRIPTION : Replaces all references to fact-variables within an fact query-function with function calls to query-fact (which references the fact array at run-time) INPUTS : 1) The fact-variable list 2) A boolean expression containing variable references 3) A flag indicating whether to allow slot references of the type : for direct slot access or not 4) Nesting depth of query functions RETURNS : Nothing useful SIDE EFFECTS : If a SF_VARIABLE node is found and is on the list of fact variables, it is replaced with a query-fact function call. NOTES : Other SF_VARIABLE(S) are left alone for replacement by other parsers. This implies that a user may use defgeneric, defrule, and defmessage-handler variables within a query-function where they do not conflict with fact-variable names. ***********************************************************************************/ static void ReplaceFactVariables( void *theEnv, EXPRESSION *vlist, EXPRESSION *bexp, int sdirect, int ndepth) { EXPRESSION *eptr; struct FunctionDefinition *rindx_func,*rslot_func; int posn; rindx_func = FindFunction(theEnv,"(query-fact)"); rslot_func = FindFunction(theEnv,"(query-fact-slot)"); while (bexp != NULL) { if (bexp->type == SF_VARIABLE) { eptr = vlist; posn = 0; while ((eptr != NULL) ? (eptr->value != bexp->value) : FALSE) { eptr = eptr->nextArg; posn++; } if (eptr != NULL) { bexp->type = FCALL; bexp->value = (void *) rindx_func; eptr = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) ndepth)); eptr->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) posn)); bexp->argList = eptr; } else if (sdirect == TRUE) { ReplaceSlotReference(theEnv,vlist,bexp,rslot_func,ndepth); } } if (bexp->argList != NULL) { if (IsQueryFunction(bexp)) { ReplaceFactVariables(theEnv,vlist,bexp->argList,sdirect,ndepth+1); } else { ReplaceFactVariables(theEnv,vlist,bexp->argList,sdirect,ndepth); } } bexp = bexp->nextArg; } } /************************************************************************* NAME : ReplaceSlotReference DESCRIPTION : Replaces fact-set query function variable references of the form: : with function calls to get these fact-slots at run time INPUTS : 1) The fact-set variable list 2) The expression containing the variable 3) The address of the fact slot access function 4) Nesting depth of query functions RETURNS : Nothing useful SIDE EFFECTS : If the variable is a slot reference, then it is replaced with the appropriate function-call. NOTES : None *************************************************************************/ static void ReplaceSlotReference( void *theEnv, EXPRESSION *vlist, EXPRESSION *theExp, struct FunctionDefinition *func, int ndepth) { unsigned len; int posn,oldpp; register unsigned i; register char *str; EXPRESSION *eptr; struct token itkn; str = ValueToString(theExp->value); len = strlen(str); if (len < 3) return; for (i = len-2 ; i >= 1 ; i--) { if ((str[i] == FACT_SLOT_REF) ? (i >= 1) : FALSE) { eptr = vlist; posn = 0; while (eptr && ((i != strlen(ValueToString(eptr->value))) || strncmp(ValueToString(eptr->value),str, (STD_SIZE) i))) { eptr = eptr->nextArg; posn++; } if (eptr != NULL) { OpenStringSource(theEnv,"query-var",str+i+1,0); oldpp = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,OFF); GetToken(theEnv,"query-var",&itkn); SetPPBufferStatus(theEnv,oldpp); CloseStringSource(theEnv,"query-var"); theExp->type = FCALL; theExp->value = (void *) func; theExp->argList = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) ndepth)); theExp->argList->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) posn)); theExp->argList->nextArg->nextArg = GenConstant(theEnv,itkn.type,itkn.value); break; } } } } /******************************************************************** NAME : IsQueryFunction DESCRIPTION : Determines if an expression is a query function call INPUTS : The expression RETURNS : TRUE if query function call, FALSE otherwise SIDE EFFECTS : None NOTES : None ********************************************************************/ static int IsQueryFunction( EXPRESSION *theExp) { int (*fptr)(void); if (theExp->type != FCALL) return(FALSE); fptr = (int (*)(void)) ExpressionFunctionPointer(theExp); if (fptr == (int (*)(void)) AnyFacts) return(TRUE); if (fptr == (int (*)(void)) QueryFindFact) return(TRUE); if (fptr == (int (*)(void)) QueryFindAllFacts) return(TRUE); if (fptr == (int (*)(void)) QueryDoForFact) return(TRUE); if (fptr == (int (*)(void)) QueryDoForAllFacts) return(TRUE); if (fptr == (int (*)(void)) DelayedQueryDoForAllFacts) return(TRUE); return(FALSE); } #endif clips-6.24/clipssrc/cstrcbin.c0000755000175000017500000001314107422634657014524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* CONSTRUCT BINARY LOAD/SAVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary load/save functions for construct */ /* headers. */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #include "setup.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "envrnmnt.h" #if BLOAD_AND_BSAVE #include "bsave.h" #endif #include "moduldef.h" #define _CSTRCBIN_SOURCE_ #include "cstrcbin.h" #if BLOAD_AND_BSAVE /*************************************************** NAME : MarkConstructHeaderNeededItems DESCRIPTION : Marks symbols and other ephemerals needed by a construct header, and sets the binary-save id for the construct INPUTS : 1) The construct header 2) The binary-save id to assign RETURNS : Nothing useful SIDE EFFECTS : Id set and items marked NOTES : None ***************************************************/ globle void MarkConstructHeaderNeededItems( struct constructHeader *theConstruct, long theBsaveID) { theConstruct->name->neededSymbol = TRUE; theConstruct->bsaveID = theBsaveID; } /****************************************************** NAME : AssignBsaveConstructHeaderVals DESCRIPTION : Assigns value to the construct header for saving in the binary file INPUTS : 1) The binary-save buffer for the construct header values 2) The actual construct header RETURNS : Nothing useful SIDE EFFECTS : Binary-save buffer for construct header written with appropriate values NOTES : Assumes that module items for this construct were saved in the same order as the defmodules. The defmodule binary-save id is used for the whichModule id of this construct. ******************************************************/ globle void AssignBsaveConstructHeaderVals( struct bsaveConstructHeader *theBsaveConstruct, struct constructHeader *theConstruct) { theBsaveConstruct->name = (long) theConstruct->name->bucket; theBsaveConstruct->whichModule = theConstruct->whichModule->theModule->bsaveID; if (theConstruct->next != NULL) theBsaveConstruct->next = ((struct constructHeader *) theConstruct->next)->bsaveID; else theBsaveConstruct->next = -1L; } #endif /* BLOAD_AND_BSAVE */ /*************************************************** NAME : UpdateConstructHeader DESCRIPTION : Determines field values for construct header from binary-load buffer INPUTS : 1) The binary-load data for the construct header 2) The actual construct header 3) The size of a defmodule item for this construct 4) The array of all defmodule items for this construct 5) The size of this construct 6) The array of these constructs RETURNS : Nothing useful SIDE EFFECTS : Header values set NOTES : None ***************************************************/ LOCALE void UpdateConstructHeader( void *theEnv, struct bsaveConstructHeader *theBsaveConstruct, struct constructHeader *theConstruct, int itemModuleSize, void *itemModuleArray, int itemSize, void *itemArray) { long moduleOffset, itemOffset; moduleOffset = itemModuleSize * theBsaveConstruct->whichModule; theConstruct->whichModule = (struct defmoduleItemHeader *) &((char *) itemModuleArray)[moduleOffset]; theConstruct->name = SymbolPointer(theBsaveConstruct->name); IncrementSymbolCount(theConstruct->name); if (theBsaveConstruct->next != -1L) { itemOffset = itemSize * theBsaveConstruct->next; theConstruct->next = (struct constructHeader *) &((char *) itemArray)[itemOffset]; } else theConstruct->next = NULL; theConstruct->ppForm = NULL; theConstruct->bsaveID = 0L; theConstruct->usrData = NULL; } /******************************************************* NAME : UnmarkConstructHeader DESCRIPTION : Releases any ephemerals (symbols, etc.) of a construct header for removal INPUTS : The construct header RETURNS : Nothing useful SIDE EFFECTS : Busy counts fo ephemerals decremented NOTES : None *******************************************************/ globle void UnmarkConstructHeader( void *theEnv, struct constructHeader *theConstruct) { DecrementSymbolCount(theEnv,theConstruct->name); } #endif /* BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE */ clips-6.24/clipssrc/proflfun.h0000755000175000017500000000717510441150657014553 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* CONSTRUCT PROFILING FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_proflfun #define _H_proflfun #ifdef LOCALE #undef LOCALE #endif #ifdef _PROFLFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #include "userdata.h" struct constructProfileInfo { struct userData usrData; long numberOfEntries; unsigned int childCall : 1; double startTime; double totalSelfTime; double totalWithChildrenTime; }; struct profileFrameInfo { unsigned int parentCall : 1; unsigned int profileOnExit : 1; double parentStartTime; struct constructProfileInfo *oldProfileFrame; }; #define PROFLFUN_DATA 15 struct profileFunctionData { double ProfileStartTime; double ProfileEndTime; double ProfileTotalTime; int LastProfileInfo; double PercentThreshold; struct userDataRecord ProfileDataInfo; unsigned char ProfileDataID; int ProfileUserFunctions; int ProfileConstructs; struct constructProfileInfo *ActiveProfileFrame; char *OutputString; }; #define ProfileFunctionData(theEnv) ((struct profileFunctionData *) GetEnvironmentData(theEnv,PROFLFUN_DATA)) LOCALE void ConstructProfilingFunctionDefinitions(void *); LOCALE void ProfileCommand(void *); LOCALE void ProfileInfoCommand(void *); LOCALE void StartProfile(void *, struct profileFrameInfo *, struct userData **, intBool); LOCALE void EndProfile(void *,struct profileFrameInfo *); LOCALE void ProfileResetCommand(void *); LOCALE void ResetProfileInfo(struct constructProfileInfo *); LOCALE double SetProfilePercentThresholdCommand(void *); LOCALE double SetProfilePercentThreshold(void *,double); LOCALE double GetProfilePercentThresholdCommand(void *); LOCALE double GetProfilePercentThreshold(void *); LOCALE intBool Profile(void *,char *); LOCALE void DeleteProfileData(void *,void *); LOCALE void *CreateProfileData(void *); LOCALE char *SetProfileOutputString(void *,char *); #endif clips-6.24/clipssrc/drive.h0000755000175000017500000000374610441112047014020 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DRIVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Handles join network activity associated with */ /* with the addition of a data entity such as a fact or */ /* instance. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_drive #define _H_drive #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DRIVE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif void NetworkAssert(void *,struct partialMatch *,struct joinNode *,int); void PNLDrive(void *,struct joinNode *,struct partialMatch *); intBool EvaluateJoinExpression(void *,struct expr *,struct partialMatch *,struct partialMatch *,struct joinNode *); #endif clips-6.24/clipssrc/._dfinsbin.c0000400000175000017500000000075410177533434014707 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z$<TTFT#uFMWBBMPSRclips-6.24/clipssrc/._agenda.c0000400000175000017500000000075410441602016014315 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0mc0mcn>VKV[QpTTFHgFMWBBMPSRclips-6.24/clipssrc/rulebsc.h0000755000175000017500000001032710441150735014345 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFRULE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the defrule */ /* construct such as clear, reset, save, undefrule, */ /* ppdefrule, list-defrules, and */ /* get-defrule-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_rulebsc #define _H_rulebsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetDefruleList(theEnv,a,b) EnvGetDefruleList(theEnv,a,b) #define GetDefruleWatchActivations(theEnv,a) EnvGetDefruleWatchActivations(theEnv,a) #define GetDefruleWatchFirings(theEnv,a) EnvGetDefruleWatchFirings(theEnv,a) #define ListDefrules(theEnv,a,b) EnvListDefrules(theEnv,a,b) #define SetDefruleWatchActivations(theEnv,a,b) EnvSetDefruleWatchActivations(theEnv,a,b) #define SetDefruleWatchFirings(theEnv,a,b) EnvSetDefruleWatchFirings(theEnv,a,b) #define Undefrule(theEnv,a) EnvUndefrule(theEnv,a) #else #define GetDefruleList(a,b) EnvGetDefruleList(GetCurrentEnvironment(),a,b) #define GetDefruleWatchActivations(a) EnvGetDefruleWatchActivations(GetCurrentEnvironment(),a) #define GetDefruleWatchFirings(a) EnvGetDefruleWatchFirings(GetCurrentEnvironment(),a) #define ListDefrules(a,b) EnvListDefrules(GetCurrentEnvironment(),a,b) #define SetDefruleWatchActivations(a,b) EnvSetDefruleWatchActivations(GetCurrentEnvironment(),a,b) #define SetDefruleWatchFirings(a,b) EnvSetDefruleWatchFirings(GetCurrentEnvironment(),a,b) #define Undefrule(a) EnvUndefrule(GetCurrentEnvironment(),a) #endif LOCALE void DefruleBasicCommands(void *); LOCALE void UndefruleCommand(void *); LOCALE intBool EnvUndefrule(void *,void *); LOCALE void GetDefruleListFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetDefruleList(void *,DATA_OBJECT_PTR,void *); LOCALE void *DefruleModuleFunction(void *); #if DEBUGGING_FUNCTIONS LOCALE void PPDefruleCommand(void *); LOCALE int PPDefrule(void *,char *,char *); LOCALE void ListDefrulesCommand(void *); LOCALE void EnvListDefrules(void *,char *,void *); LOCALE unsigned EnvGetDefruleWatchFirings(void *,void *); LOCALE unsigned EnvGetDefruleWatchActivations(void *,void *); LOCALE void EnvSetDefruleWatchFirings(void *,unsigned,void *); LOCALE void EnvSetDefruleWatchActivations(void *,unsigned,void *); LOCALE unsigned DefruleWatchAccess(void *,int,unsigned,struct expr *); LOCALE unsigned DefruleWatchPrint(void *,char *,int,struct expr *); #endif #endif clips-6.24/clipssrc/._insquery.h0000400000175000017500000000075410441147627014776 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z9,,TTFS FMWBBMPSRclips-6.24/clipssrc/tmpltfun.h0000755000175000017500000001472010441602344014556 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* DEFTEMPLATE FUNCTION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Added deftemplate-slot-names, */ /* deftemplate-slot-default-value, */ /* deftemplate-slot-cardinality, */ /* deftemplate-slot-allowed-values, */ /* deftemplate-slot-range, */ /* deftemplate-slot-types, */ /* deftemplate-slot-multip, */ /* deftemplate-slot-singlep, */ /* deftemplate-slot-existp, and */ /* deftemplate-slot-defaultp functions. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_tmpltfun #define _H_tmpltfun #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #define NO_DEFAULT 0 #define STATIC_DEFAULT 1 #define DYNAMIC_DEFAULT 2 #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DeftemplateSlotNames(theEnv,a,b) EnvDeftemplateSlotNames(theEnv,a,b) #define DeftemplateSlotDefaultValue(theEnv,a,b,c) EnvDeftemplateSlotDefaultValue(theEnv,a,b,c) #define DeftemplateSlotCardinality(theEnv,a,b,c) EnvDeftemplateSlotCardinality(theEnv,a,b,c) #define DeftemplateSlotAllowedValues(theEnv,a,b,c) EnvDeftemplateSlotAllowedValues(theEnv,a,b,c) #define DeftemplateSlotRange(theEnv,a,b,c) EnvDeftemplateSlotRange(theEnv,a,b,c) #define DeftemplateSlotTypes(theEnv,a,b,c) EnvDeftemplateSlotTypes(theEnv,a,b,c) #define DeftemplateSlotMultiP(theEnv,a,b) EnvDeftemplateSlotMultiP(theEnv,a,b) #define DeftemplateSlotSingleP(theEnv,a,b) EnvDeftemplateSlotSingleP(theEnv,a,b) #define DeftemplateSlotExistP(theEnv,a,b) EnvDeftemplateSlotExistP(theEnv,a,b) #define DeftemplateSlotDefaultP(theEnv,a,b) EnvDeftemplateSlotDefaultP(theEnv,a,b) #else #define DeftemplateSlotNames(a,b) EnvDeftemplateSlotNames(GetCurrentEnvironment(),a,b) #define DeftemplateSlotDefaultValue(a,b,c) EnvDeftemplateSlotDefaultValue(GetCurrentEnvironment(),a,b,c) #define DeftemplateSlotCardinality(a,b,c) EnvDeftemplateSlotCardinality(GetCurrentEnvironment(),a,b,c) #define DeftemplateSlotAllowedValues(a,b,c) EnvDeftemplateSlotAllowedValues(GetCurrentEnvironment(),a,b,c) #define DeftemplateSlotRange(a,b,c) EnvDeftemplateSlotRange(GetCurrentEnvironment(),a,b,c) #define DeftemplateSlotTypes(a,b,c) EnvDeftemplateSlotTypes(GetCurrentEnvironment(),a,b,c) #define DeftemplateSlotMultiP(a,b) EnvDeftemplateSlotMultiP(GetCurrentEnvironment(),a,b) #define DeftemplateSlotSingleP(a,b) EnvDeftemplateSlotSingleP(GetCurrentEnvironment(),a,b) #define DeftemplateSlotExistP(a,b) EnvDeftemplateSlotExistP(GetCurrentEnvironment(),a,b) #define DeftemplateSlotDefaultP(a,b) EnvDeftemplateSlotDefaultP(GetCurrentEnvironment(),a,b) #endif LOCALE intBool UpdateModifyDuplicate(void *,struct expr *,char *,void *); LOCALE struct expr *ModifyParse(void *,struct expr *,char *); LOCALE struct expr *DuplicateParse(void *,struct expr *,char *); LOCALE void DeftemplateFunctions( void *); LOCALE void ModifyCommand(void *,DATA_OBJECT_PTR); LOCALE void DuplicateCommand(void *,DATA_OBJECT_PTR); LOCALE void DeftemplateSlotNamesFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotNames(void *,void *,DATA_OBJECT *); LOCALE void DeftemplateSlotDefaultValueFunction(void *,DATA_OBJECT *); LOCALE intBool EnvDeftemplateSlotDefaultValue(void *,void *,char *,DATA_OBJECT *); LOCALE void DeftemplateSlotCardinalityFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotCardinality(void *,void *,char *,DATA_OBJECT *); LOCALE void DeftemplateSlotAllowedValuesFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotAllowedValues(void *,void *,char *,DATA_OBJECT *); LOCALE void DeftemplateSlotRangeFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotRange(void *,void *,char *,DATA_OBJECT *); LOCALE void DeftemplateSlotTypesFunction(void *,DATA_OBJECT *); LOCALE void EnvDeftemplateSlotTypes(void *,void *,char *,DATA_OBJECT *); LOCALE int DeftemplateSlotMultiPFunction(void *); LOCALE int EnvDeftemplateSlotMultiP(void *,void *,char *); LOCALE int DeftemplateSlotSinglePFunction(void *); LOCALE int EnvDeftemplateSlotSingleP(void *,void *,char *); LOCALE int DeftemplateSlotExistPFunction(void *); LOCALE int EnvDeftemplateSlotExistP(void *,void *,char *); LOCALE void *DeftemplateSlotDefaultPFunction(void *); LOCALE int EnvDeftemplateSlotDefaultP(void *,void *,char *); #endif clips-6.24/clipssrc/factrhs.h0000755000175000017500000000361707422635005014347 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT RHS PATTERN PARSER HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factrhs #define _H_factrhs #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTRHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct expr *BuildRHSAssert(void *,char *,struct token *,int *,int,int,char *); LOCALE struct expr *GetAssertArgument(void *,char *,struct token *,int *,int,int,int *); LOCALE struct expr *GetRHSPattern(void *,char *,struct token *,int *,int, int,int,int); LOCALE struct fact *StringToFact(void *,char *); #endif clips-6.24/clipssrc/exprnbin.h0000755000175000017500000000430007422634632014535 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* EXPRESSION BLOAD/BSAVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* expression data structure. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_exprnbin #define _H_exprnbin #ifndef _H_expressn #include "expressn.h" #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _EXPRNBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define ExpressionPointer(i) ((struct expr *) (((i) == -1L) ? NULL : &ExpressionData(theEnv)->ExpressionArray[i])) #define HashedExpressionPointer(i) ExpressionPointer(i) LOCALE void AllocateExpressions(void *); LOCALE void RefreshExpressions(void *); LOCALE void ClearBloadedExpressions(void *); LOCALE void FindHashedExpressions(void *); LOCALE void BsaveHashedExpressions(void *,FILE *); LOCALE void BsaveConstructExpressions(void *,FILE *); LOCALE void BsaveExpression(void *,struct expr *,FILE *); #endif clips-6.24/clipssrc/factqury.h0000644000175000017500000000621010441162151014530 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* 6.23: Added fact-set queries. */ /* */ /* 6.24: Corrected errors when compiling as a C++ file. */ /* DR0868 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_factqury #define _H_factqury #if FACT_SET_QUERIES #ifndef _H_factmngr #include "factmngr.h" #endif typedef struct query_template { struct deftemplate *templatePtr; struct query_template *chain, *nxt; } QUERY_TEMPLATE; typedef struct query_soln { struct fact **soln; struct query_soln *nxt; } QUERY_SOLN; typedef struct query_core { struct fact **solns; EXPRESSION *query,*action; QUERY_SOLN *soln_set,*soln_bottom; unsigned soln_size,soln_cnt; DATA_OBJECT *result; } QUERY_CORE; typedef struct query_stack { QUERY_CORE *core; struct query_stack *nxt; } QUERY_STACK; #define FACT_QUERY_DATA 63 struct factQueryData { SYMBOL_HN *QUERY_DELIMETER_SYMBOL; QUERY_CORE *QueryCore; QUERY_STACK *QueryCoreStack; int AbortQuery; }; #define FactQueryData(theEnv) ((struct factQueryData *) GetEnvironmentData(theEnv,FACT_QUERY_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTQURY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define QUERY_DELIMETER_STRING "(QDS)" LOCALE void SetupFactQuery(void *); LOCALE void GetQueryFact(void *,DATA_OBJECT *); LOCALE void GetQueryFactSlot(void *,DATA_OBJECT *); LOCALE intBool AnyFacts(void *); LOCALE void QueryFindFact(void *,DATA_OBJECT *); LOCALE void QueryFindAllFacts(void *,DATA_OBJECT *); LOCALE void QueryDoForFact(void *,DATA_OBJECT *); LOCALE void QueryDoForAllFacts(void *,DATA_OBJECT *); LOCALE void DelayedQueryDoForAllFacts(void *,DATA_OBJECT *); #endif #endif clips-6.24/clipssrc/._strngrtr.c0000400000175000017500000000075410177533457015005 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacop(p($OsTTFOsXFMWBBMPSRclips-6.24/clipssrc/._objcmp.h0000400000175000017500000000012207422634676014370 0ustar jfsjfsMac OS X  2 RTEXT???? aclips-6.24/clipssrc/exprnops.h0000755000175000017500000000507510441132027014562 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EXPRESSION OPERATIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides utility routines for manipulating and */ /* examining expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_exprnops #define _H_exprnops #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _EXPRNOPS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ConstantExpression(struct expr *); LOCALE void PrintExpression(void *,char *,struct expr *); LOCALE long ExpressionSize(struct expr *); LOCALE int CountArguments(struct expr *); LOCALE struct expr *CopyExpression(void *,struct expr *); LOCALE intBool ExpressionContainsVariables(struct expr *,int); LOCALE intBool IdenticalExpression(struct expr *,struct expr *); LOCALE struct expr *GenConstant(void *,unsigned short,void *); #if ! RUN_TIME LOCALE int CheckArgumentAgainstRestriction(void *,struct expr *,int); #endif LOCALE intBool ConstantType(int); LOCALE struct expr *CombineExpressions(void *,struct expr *,struct expr *); LOCALE struct expr *AppendExpressions(struct expr *,struct expr *); #endif clips-6.24/clipssrc/commline.h0000755000175000017500000000761010441602067014512 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* COMMAND LINE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of routines for processing */ /* commands entered at the top level prompt. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Refactored several functions and added */ /* additional functions for use by an interface */ /* layered on top of CLIPS. */ /* */ /*************************************************************/ #ifndef _H_commline #define _H_commline #define COMMANDLINE_DATA 40 struct commandLineData { int EvaluatingTopLevelCommand; int HaltCommandLoopBatch; #if ! RUN_TIME char *CommandString; unsigned MaximumCharacters; int ParsingTopLevelCommand; char *BannerString; int (*EventFunction)(void *); int (*AfterPromptFunction)(void *); #endif }; #define CommandLineData(theEnv) ((struct commandLineData *) GetEnvironmentData(theEnv,COMMANDLINE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _COMMLINE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeCommandLineData(void *); LOCALE int ExpandCommandString(void *,int); LOCALE void FlushCommandString(void *); LOCALE void SetCommandString(void *,char *); LOCALE void AppendCommandString(void *,char *); LOCALE char *GetCommandString(void *); LOCALE int CompleteCommand(char *); LOCALE void CommandLoop(void *); LOCALE void CommandLoopBatch(void *); LOCALE void CommandLoopBatchDriver(void *); LOCALE void PrintPrompt(void *); LOCALE void PrintBanner(void *); LOCALE void SetAfterPromptFunction(void *,int (*)(void *)); LOCALE intBool RouteCommand(void *,char *,int); LOCALE int (*SetEventFunction(void *,int (*)(void *)))(void *); LOCALE intBool TopLevelCommand(void *); LOCALE void AppendNCommandString(void *,char *,unsigned); LOCALE void SetNCommandString(void *,char *,unsigned); LOCALE char *GetCommandCompletionString(void *,char *,unsigned); LOCALE intBool ExecuteIfCommandComplete(void *); LOCALE void CommandLoopOnceThenBatch(void *); LOCALE intBool CommandCompleteAndNotEmpty(void *); LOCALE void SetHaltCommandLoopBatch(void *,int); LOCALE int GetHaltCommandLoopBatch(void *); #endif clips-6.24/clipssrc/objrtcmp.c0000755000175000017500000004262510441131113014514 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* OBJECT PATTERN NETWORK CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Saves object pattern network for constructs-to-c */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Added environment parameter to GenClose. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && CONSTRUCT_COMPILER #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "envrnmnt.h" #include "objrtfnx.h" #include "objrtmch.h" #include "pattern.h" #include "sysdep.h" #define _OBJRTCMP_SOURCE_ #include "objrtcmp.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define ObjectPNPrefix() ArbitraryPrefix(ObjectReteData(theEnv)->ObjectPatternCodeItem,0) #define ObjectANPrefix() ArbitraryPrefix(ObjectReteData(theEnv)->ObjectPatternCodeItem,1) /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void BeforeObjectPatternsToCode(void *); static OBJECT_PATTERN_NODE *GetNextObjectPatternNode(OBJECT_PATTERN_NODE *); static void InitObjectPatternsCode(void *,FILE *,int,int); static int ObjectPatternsToCode(void *,char *,int,FILE *,int,int); static void IntermediatePatternNodeReference(void *,OBJECT_PATTERN_NODE *,FILE *,int,int); static int IntermediatePatternNodesToCode(void *,char *,int,FILE *,int,int,int); static int AlphaPatternNodesToCode(void *,char *,int,FILE *,int,int,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ObjectPatternsCompilerSetup DESCRIPTION : Sets up interface for object patterns to construct compiler INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item added NOTES : None ***************************************************/ globle void ObjectPatternsCompilerSetup( void *theEnv) { ObjectReteData(theEnv)->ObjectPatternCodeItem = AddCodeGeneratorItem(theEnv,"object-patterns",0,BeforeObjectPatternsToCode, InitObjectPatternsCode,ObjectPatternsToCode,2); } /*************************************************** NAME : ObjectPatternNodeReference DESCRIPTION : Prints out a reference to an object pattern alpha memory for the join network interface to the construct compiler INPUTS : 1) A pointer to the object pattern alpha memory 2) A pointer to the output file 3) The id of constructs-to-c image 4) The maximum number of indices allowed in any single array in the image RETURNS : Nothing useful SIDE EFFECTS : Reference to object pattern alpha memory printed NOTES : None ***************************************************/ globle void ObjectPatternNodeReference( void *theEnv, void *theVPattern, FILE *theFile, int imageID, int maxIndices) { OBJECT_ALPHA_NODE *thePattern; if (theVPattern == NULL) fprintf(theFile,"NULL"); else { thePattern = (OBJECT_ALPHA_NODE *) theVPattern; fprintf(theFile,"&%s%d_%d[%d]", ObjectANPrefix(),imageID, (((int) thePattern->bsaveID) / maxIndices) + 1, ((int) thePattern->bsaveID) % maxIndices); } } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : BeforeObjectPatternsToCode DESCRIPTION : Marks all object pattern intermediate and alpha memory nodes with a unique integer id prior to the constructs-to-c execution INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : bsaveIDs of nodes set NOTES : None *****************************************************/ static void BeforeObjectPatternsToCode( void *theEnv) { long whichPattern; OBJECT_PATTERN_NODE *intermediateNode; OBJECT_ALPHA_NODE *alphaNode; whichPattern = 0L; intermediateNode = ObjectNetworkPointer(theEnv); while (intermediateNode != NULL) { intermediateNode->bsaveID = whichPattern++; intermediateNode = GetNextObjectPatternNode(intermediateNode); } whichPattern = 0L; alphaNode = ObjectNetworkTerminalPointer(theEnv); while (alphaNode != NULL) { alphaNode->bsaveID = whichPattern++; alphaNode = alphaNode->nxtTerminal; } } /*************************************************** NAME : GetNextObjectPatternNode DESCRIPTION : Grabs the next node in a depth first perusal of the object pattern intermediate nodes INPUTS : The previous node RETURNS : The next node (NULL if done) SIDE EFFECTS : None NOTES : Alpha meory nodes are ignored ***************************************************/ static OBJECT_PATTERN_NODE *GetNextObjectPatternNode( OBJECT_PATTERN_NODE *thePattern) { if (thePattern->nextLevel != NULL) return(thePattern->nextLevel); while (thePattern->rightNode == NULL) { thePattern = thePattern->lastLevel; if (thePattern == NULL) return(NULL); } return(thePattern->rightNode); } /*************************************************** NAME : InitObjectPatternsCode DESCRIPTION : Prints out run-time initialization code for object patterns INPUTS : 1) A pointer to the output file 2) The id of constructs-to-c image 3) The maximum number of indices allowed in any single array in the image RETURNS : Nothing useful SIDE EFFECTS : Initialization code written NOTES : None ***************************************************/ static void InitObjectPatternsCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { long firstIntermediateNode,firstAlphaNode; if (ObjectNetworkPointer(theEnv) != NULL) { firstIntermediateNode = ObjectNetworkPointer(theEnv)->bsaveID; firstAlphaNode = ObjectNetworkTerminalPointer(theEnv)->bsaveID; fprintf(initFP," SetObjectNetworkPointer(theEnv,&%s%d_%d[%d]);\n", ObjectPNPrefix(),imageID, (int) ((firstIntermediateNode / maxIndices) + 1), (int) (firstIntermediateNode % maxIndices)); fprintf(initFP," SetObjectNetworkTerminalPointer(theEnv,&%s%d_%d[%d]);\n", ObjectANPrefix(),imageID, (int) ((firstAlphaNode / maxIndices) + 1), (int) (firstAlphaNode % maxIndices)); } else { fprintf(initFP," SetObjectNetworkPointer(theEnv,NULL);\n"); fprintf(initFP," SetObjectNetworkTerminalPointer(theEnv,NULL);\n"); } } /*********************************************************** NAME : ObjectPatternsToCode DESCRIPTION : Writes out data structures for run-time creation of object patterns INPUTS : 1) The base image output file name 2) The base image file id 3) A pointer to the header output file 4) The id of constructs-to-c image 5) The maximum number of indices allowed in any single array in the image RETURNS : 1 if OK, 0 if could not open a file SIDE EFFECTS : Object patterns code written to files NOTES : None ***********************************************************/ static int ObjectPatternsToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int version; version = IntermediatePatternNodesToCode(theEnv,fileName,fileID, headerFP,imageID,maxIndices,1); if (version == 0) return(0); if (! AlphaPatternNodesToCode(theEnv,fileName,fileID,headerFP,imageID,maxIndices,version)) return(0); return(1); } /*************************************************** NAME : IntermediatePatternNodeReference DESCRIPTION : Prints out a reference to an object pattern intermediate node INPUTS : 1) A pointer to the object pattern intermediate node 2) A pointer to the output file 3) The id of constructs-to-c image 4) The maximum number of indices allowed in any single array in the image RETURNS : 1 if OK, 0 if could not open a file SIDE EFFECTS : Reference to object pattern alpha memory printed NOTES : None ***************************************************/ static void IntermediatePatternNodeReference( void *theEnv, OBJECT_PATTERN_NODE *thePattern, FILE *theFile, int imageID, int maxIndices) { if (thePattern == NULL) fprintf(theFile,"NULL"); else { fprintf(theFile,"&%s%d_%d[%d]", ObjectPNPrefix(),imageID, (((int) thePattern->bsaveID) / maxIndices) + 1, ((int) thePattern->bsaveID) % maxIndices); } } /************************************************************* NAME : IntermediatePatternNodesToCode DESCRIPTION : Writes out data structures for run-time creation of object pattern intermediate nodes INPUTS : 1) The base image output file name 2) The base image file id 3) A pointer to the header output file 4) The id of constructs-to-c image 5) The maximum number of indices allowed in any single array in the image RETURNS : Next version file to open, 0 if error SIDE EFFECTS : Object patterns code written to files NOTES : None *************************************************************/ static int IntermediatePatternNodesToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices, int version) { FILE *fp; int arrayVersion; int newHeader; int i; OBJECT_PATTERN_NODE *thePattern; /* ================ Create the file. ================ */ if (ObjectNetworkPointer(theEnv) == NULL) return(1); fprintf(headerFP,"#include \"objrtmch.h\"\n"); /* ================================= Dump the pattern node structures. ================================= */ if ((fp = NewCFile(theEnv,fileName,fileID,version,FALSE)) == NULL) return(0); newHeader = TRUE; arrayVersion = 1; i = 1; thePattern = ObjectNetworkPointer(theEnv); while (thePattern != NULL) { if (newHeader) { fprintf(fp,"OBJECT_PATTERN_NODE %s%d_%d[] = {\n", ObjectPNPrefix(),imageID,arrayVersion); fprintf(headerFP,"extern OBJECT_PATTERN_NODE %s%d_%d[];\n", ObjectPNPrefix(),imageID,arrayVersion); newHeader = FALSE; } fprintf(fp,"{0,%u,%u,%u,%u,0L,%u,",thePattern->multifieldNode, thePattern->endSlot, thePattern->whichField, thePattern->leaveFields, thePattern->slotNameID); PrintHashedExpressionReference(theEnv,fp,thePattern->networkTest,imageID,maxIndices); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->nextLevel,fp,imageID,maxIndices); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->lastLevel,fp,imageID,maxIndices); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->leftNode,fp,imageID,maxIndices); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->rightNode,fp,imageID,maxIndices); fprintf(fp,","); ObjectPatternNodeReference(theEnv,(void *) thePattern->alphaNode,fp,imageID,maxIndices); fprintf(fp,",0L}"); i++; thePattern = GetNextObjectPatternNode(thePattern); if ((i > maxIndices) || (thePattern == NULL)) { fprintf(fp,"};\n"); GenClose(theEnv,fp); i = 1; version++; arrayVersion++; if (thePattern != NULL) { if ((fp = NewCFile(theEnv,fileName,fileID,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else if (thePattern != NULL) { fprintf(fp,",\n"); } } return(version); } /*********************************************************** NAME : AlphaPatternNodesToCode DESCRIPTION : Writes out data structures for run-time creation of object pattern alpha memories INPUTS : 1) The base image output file name 2) The base image file id 3) A pointer to the header output file 4) The id of constructs-to-c image 5) The maximum number of indices allowed in any single array in the image RETURNS : Next version file to open, 0 if error SIDE EFFECTS : Object patterns code written to files NOTES : None ***********************************************************/ static int AlphaPatternNodesToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices, int version) { FILE *fp; int arrayVersion; int newHeader; int i; OBJECT_ALPHA_NODE *thePattern; /* ================ Create the file. ================ */ if (ObjectNetworkTerminalPointer(theEnv) == NULL) return(version); /* ================================= Dump the pattern node structures. ================================= */ if ((fp = NewCFile(theEnv,fileName,fileID,version,FALSE)) == NULL) return(0); newHeader = TRUE; arrayVersion = 1; i = 1; thePattern = ObjectNetworkTerminalPointer(theEnv); while (thePattern != NULL) { if (newHeader) { fprintf(fp,"OBJECT_ALPHA_NODE %s%d_%d[] = {\n", ObjectANPrefix(),imageID,arrayVersion); fprintf(headerFP,"extern OBJECT_ALPHA_NODE %s%d_%d[];\n", ObjectANPrefix(),imageID,arrayVersion); newHeader = FALSE; } fprintf(fp,"{"); PatternNodeHeaderToCode(theEnv,fp,&thePattern->header,imageID,maxIndices); fprintf(fp,",0L,"); PrintBitMapReference(theEnv,fp,thePattern->classbmp); fprintf(fp,","); PrintBitMapReference(theEnv,fp,thePattern->slotbmp); fprintf(fp,","); IntermediatePatternNodeReference(theEnv,thePattern->patternNode,fp,imageID,maxIndices); fprintf(fp,","); ObjectPatternNodeReference(theEnv,thePattern->nxtInGroup,fp,imageID,maxIndices); fprintf(fp,","); ObjectPatternNodeReference(theEnv,thePattern->nxtTerminal,fp,imageID,maxIndices); fprintf(fp,",0L}"); i++; thePattern = thePattern->nxtTerminal; if ((i > maxIndices) || (thePattern == NULL)) { fprintf(fp,"};\n"); GenClose(theEnv,fp); i = 1; version++; arrayVersion++; if (thePattern != NULL) { if ((fp = NewCFile(theEnv,fileName,fileID,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else if (thePattern != NULL) { fprintf(fp,",\n"); } } return(version); } #endif clips-6.24/clipssrc/._edstruct.c0000400000175000017500000000012207422634701014733 0ustar jfsjfsMac OS X  2 RTEXT???? aclips-6.24/clipssrc/._cstrccom.h0000400000175000017500000000075410441602112014715 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zLTTFL(:FMPSRMWBBLclips-6.24/clipssrc/factbld.h0000755000175000017500000000370307422635004014307 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT BUILD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factbld #define _H_factbld #ifndef _H_pattern #include "pattern.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif struct factPatternNode { struct patternNodeHeader header; long bsaveID; unsigned short whichField; unsigned short whichSlot; unsigned short leaveFields; struct expr *networkTest; struct factPatternNode *nextLevel; struct factPatternNode *lastLevel; struct factPatternNode *leftNode; struct factPatternNode *rightNode; }; #ifdef _FACTBUILD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeFactPatterns(void *); LOCALE void DestroyFactPatternNetwork(void *, struct factPatternNode *); #endif clips-6.24/clipssrc/reteutil.h0000755000175000017500000000644210441162461014545 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* RETE UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of utility functions useful to */ /* other modules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /*************************************************************/ #ifndef _H_reteutil #define _H_reteutil #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RETEUTIL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void PrintPartialMatch(void *,char *,struct partialMatch *); LOCALE struct partialMatch *CopyPartialMatch(void *,struct partialMatch *,int,int); LOCALE struct partialMatch *MergePartialMatches(void *,struct partialMatch *,struct partialMatch *,int,int); LOCALE struct partialMatch *AddSingleMatch(void *,struct partialMatch *,struct alphaMatch *,int,int); LOCALE struct partialMatch *NewPseudoFactPartialMatch(void *); LOCALE long int IncrementPseudoFactIndex(void); LOCALE void FlushAlphaBetaMemory(void *,struct partialMatch *); LOCALE void DestroyAlphaBetaMemory(void *,struct partialMatch *); LOCALE int GetPatternNumberFromJoin(struct joinNode *); LOCALE void PrimeJoin(struct joinNode *); LOCALE struct multifieldMarker *CopyMultifieldMarkers(void *,struct multifieldMarker *); LOCALE struct partialMatch *CreateAlphaMatch(void *,void *,struct multifieldMarker *, struct patternNodeHeader *); LOCALE void TraceErrorToRule(void *,struct joinNode *,char *); LOCALE void InitializePatternHeader(void *,struct patternNodeHeader *); LOCALE void MarkRuleNetwork(void *,int); LOCALE void TagRuleNetwork(void *,long *,long *,long *); LOCALE int FindEntityInPartialMatch(struct patternEntity *,struct partialMatch *); #endif clips-6.24/clipssrc/._multifun.h0000400000175000017500000000075410441602255014753 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco00:TTFL,FMPSRMWBBLclips-6.24/clipssrc/._dffnxfun.h0000400000175000017500000000075410441111752014723 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zTTFS lFMWBBMPSRclips-6.24/clipssrc/moduldef.c0000755000175000017500000006552110441150014014474 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFMODULE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic defmodule primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* defmodule data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _MODULDEF_SOURCE_ #include "setup.h" #include #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "constant.h" #include "router.h" #include "extnfunc.h" #include "argacces.h" #include "constrct.h" #include "modulpsr.h" #include "modulcmp.h" #include "modulbsc.h" #include "utility.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "modulbin.h" #endif #include "moduldef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) static void ReturnDefmodule(void *,struct defmodule *,intBool); #endif static void DeallocateDefmoduleData(void *); /**************************************************************/ /* InitializeDefmodules: Initializes the defmodule construct. */ /**************************************************************/ globle void AllocateDefmoduleGlobals( void *theEnv) { AllocateEnvironmentData(theEnv,DEFMODULE_DATA,sizeof(struct defmoduleData),NULL); AddEnvironmentCleanupFunction(theEnv,"defmodules",DeallocateDefmoduleData,-1000); DefmoduleData(theEnv)->CallModuleChangeFunctions = TRUE; DefmoduleData(theEnv)->MainModuleRedefinable = TRUE; } /****************************************************/ /* DeallocateDefmoduleData: Deallocates environment */ /* data for the defmodule construct. */ /****************************************************/ static void DeallocateDefmoduleData( void *theEnv) { struct moduleStackItem *tmpMSPtr, *nextMSPtr; struct moduleItem *tmpMIPtr, *nextMIPtr; #if (! RUN_TIME) && (! BLOAD_ONLY) struct defmodule *tmpDMPtr, *nextDMPtr; struct portConstructItem *tmpPCPtr, *nextPCPtr; #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) int i; unsigned long space; #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) for (i = 0; i < DefmoduleData(theEnv)->BNumberOfDefmodules; i++) { if (DefmoduleData(theEnv)->DefmoduleArray[i].itemsArray != NULL) { rm(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].itemsArray, sizeof(void *) * GetNumberOfModuleItems(theEnv)); } } space = DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule); if (space != 0) { genlongfree(theEnv,(void *) DefmoduleData(theEnv)->DefmoduleArray,space); DefmoduleData(theEnv)->ListOfDefmodules = NULL; } space = DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem); if (space != 0) genlongfree(theEnv,(void *) DefmoduleData(theEnv)->PortItemArray,space); #endif #if (! RUN_TIME) && (! BLOAD_ONLY) tmpDMPtr = DefmoduleData(theEnv)->ListOfDefmodules; while (tmpDMPtr != NULL) { nextDMPtr = tmpDMPtr->next; ReturnDefmodule(theEnv,tmpDMPtr,TRUE); tmpDMPtr = nextDMPtr; } tmpPCPtr = DefmoduleData(theEnv)->ListOfPortConstructItems; while (tmpPCPtr != NULL) { nextPCPtr = tmpPCPtr->next; rtn_struct(theEnv,portConstructItem,tmpPCPtr); tmpPCPtr = nextPCPtr; } #endif tmpMSPtr = DefmoduleData(theEnv)->ModuleStack; while (tmpMSPtr != NULL) { nextMSPtr = tmpMSPtr->next; rtn_struct(theEnv,moduleStackItem,tmpMSPtr); tmpMSPtr = nextMSPtr; } tmpMIPtr = DefmoduleData(theEnv)->ListOfModuleItems; while (tmpMIPtr != NULL) { nextMIPtr = tmpMIPtr->next; rtn_struct(theEnv,moduleItem,tmpMIPtr); tmpMIPtr = nextMIPtr; } #if (! RUN_TIME) && (! BLOAD_ONLY) DeallocateCallList(theEnv,DefmoduleData(theEnv)->AfterModuleDefinedFunctions); #endif DeallocateCallList(theEnv,DefmoduleData(theEnv)->AfterModuleChangeFunctions); } /**************************************************************/ /* InitializeDefmodules: Initializes the defmodule construct. */ /**************************************************************/ globle void InitializeDefmodules( void *theEnv) { DefmoduleBasicCommands(theEnv); #if (! RUN_TIME) CreateMainModule(theEnv); #endif #if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) AddConstruct(theEnv,"defmodule","defmodules",ParseDefmodule,NULL,NULL,NULL,NULL, NULL,NULL,NULL,NULL,NULL); #endif #if (! RUN_TIME) && DEFMODULE_CONSTRUCT EnvDefineFunction2(theEnv,"get-current-module", 'w', PTIEF GetCurrentModuleCommand, "GetCurrentModuleCommand", "00"); EnvDefineFunction2(theEnv,"set-current-module", 'w', PTIEF SetCurrentModuleCommand, "SetCurrentModuleCommand", "11w"); #endif } /******************************************************/ /* RegisterModuleItem: Called to register a construct */ /* which can be placed within a module. */ /******************************************************/ globle int RegisterModuleItem( void *theEnv, char *theItem, void *(*allocateFunction)(void *), void (*freeFunction)(void *,void *), void *(*bloadModuleReference)(void *,int), void (*constructsToCModuleReference)(void *,FILE *,int,int,int), void *(*findFunction)(void *,char *)) { struct moduleItem *newModuleItem; newModuleItem = get_struct(theEnv,moduleItem); newModuleItem->name = theItem; newModuleItem->allocateFunction = allocateFunction; newModuleItem->freeFunction = freeFunction; newModuleItem->bloadModuleReference = bloadModuleReference; newModuleItem->constructsToCModuleReference = constructsToCModuleReference; newModuleItem->findFunction = findFunction; newModuleItem->moduleIndex = DefmoduleData(theEnv)->NumberOfModuleItems++; newModuleItem->next = NULL; if (DefmoduleData(theEnv)->LastModuleItem == NULL) { DefmoduleData(theEnv)->ListOfModuleItems = newModuleItem; DefmoduleData(theEnv)->LastModuleItem = newModuleItem; } else { DefmoduleData(theEnv)->LastModuleItem->next = newModuleItem; DefmoduleData(theEnv)->LastModuleItem = newModuleItem; } return(newModuleItem->moduleIndex); } /***********************************************************/ /* GetListOfModuleItems: Returns the list of module items. */ /***********************************************************/ globle struct moduleItem *GetListOfModuleItems( void *theEnv) { return (DefmoduleData(theEnv)->ListOfModuleItems); } /***************************************************************/ /* GetNumberOfModuleItems: Returns the number of module items. */ /***************************************************************/ globle int GetNumberOfModuleItems( void *theEnv) { return (DefmoduleData(theEnv)->NumberOfModuleItems); } /********************************************************/ /* FindModuleItem: Finds the module item data structure */ /* corresponding to the specified name. */ /********************************************************/ globle struct moduleItem *FindModuleItem( void *theEnv, char *theName) { struct moduleItem *theModuleItem; for (theModuleItem = DefmoduleData(theEnv)->ListOfModuleItems; theModuleItem != NULL; theModuleItem = theModuleItem->next) { if (strcmp(theModuleItem->name,theName) == 0) return(theModuleItem); } return(NULL); } /******************************************/ /* EnvGetCurrentModule: Returns a pointer */ /* to the current module. */ /******************************************/ globle void *EnvGetCurrentModule( void *theEnv) { return ((void *) DefmoduleData(theEnv)->CurrentModule); } /**************************************************************/ /* EnvSetCurrentModule: Sets the value of the current module. */ /**************************************************************/ globle void *EnvSetCurrentModule( void *theEnv, void *xNewValue) { struct defmodule *newValue = (struct defmodule *) xNewValue; struct callFunctionItem *changeFunctions; void *rv; /*=============================================*/ /* Change the current module to the specified */ /* module and save the previous current module */ /* for the return value. */ /*=============================================*/ rv = (void *) DefmoduleData(theEnv)->CurrentModule; DefmoduleData(theEnv)->CurrentModule = newValue; /*==========================================================*/ /* Call the list of registered functions that need to know */ /* when the module has changed. The module change functions */ /* should only be called if this is a "real" module change. */ /* Many routines temporarily change the module to look for */ /* constructs, etc. The SaveCurrentModule function will */ /* disable the change functions from being called. */ /*==========================================================*/ if (DefmoduleData(theEnv)->CallModuleChangeFunctions) { DefmoduleData(theEnv)->ModuleChangeIndex++; changeFunctions = DefmoduleData(theEnv)->AfterModuleChangeFunctions; while (changeFunctions != NULL) { (* (void (*)(void *)) changeFunctions->func)(theEnv); changeFunctions = changeFunctions->next; } } /*=====================================*/ /* Return the previous current module. */ /*=====================================*/ return(rv); } /********************************************************/ /* SaveCurrentModule: Saves current module on stack and */ /* prevents SetCurrentModule() from calling change */ /* functions */ /********************************************************/ globle void SaveCurrentModule( void *theEnv) { MODULE_STACK_ITEM *tmp; tmp = get_struct(theEnv,moduleStackItem); tmp->changeFlag = DefmoduleData(theEnv)->CallModuleChangeFunctions; DefmoduleData(theEnv)->CallModuleChangeFunctions = FALSE; tmp->theModule = DefmoduleData(theEnv)->CurrentModule; tmp->next = DefmoduleData(theEnv)->ModuleStack; DefmoduleData(theEnv)->ModuleStack = tmp; } /**********************************************************/ /* RestoreCurrentModule: Restores saved module and resets */ /* ability of SetCurrentModule() to call changed */ /* functions to previous state */ /**********************************************************/ globle void RestoreCurrentModule( void *theEnv) { MODULE_STACK_ITEM *tmp; tmp = DefmoduleData(theEnv)->ModuleStack; DefmoduleData(theEnv)->ModuleStack = tmp->next; DefmoduleData(theEnv)->CallModuleChangeFunctions = tmp->changeFlag; DefmoduleData(theEnv)->CurrentModule = tmp->theModule; rtn_struct(theEnv,moduleStackItem,tmp); } /*************************************************************/ /* GetModuleItem: Returns the data pointer for the specified */ /* module item in the specified module. If no module is */ /* indicated, then the module item for the current module */ /* is returned. */ /*************************************************************/ globle void *GetModuleItem( void *theEnv, struct defmodule *theModule, int moduleItemIndex) { if (theModule == NULL) { if (DefmoduleData(theEnv)->CurrentModule == NULL) return(NULL); theModule = DefmoduleData(theEnv)->CurrentModule; } if (theModule->itemsArray == NULL) return (NULL); return ((void *) theModule->itemsArray[moduleItemIndex]); } /************************************************************/ /* SetModuleItem: Sets the data pointer for the specified */ /* module item in the specified module. If no module is */ /* indicated, then the module item for the current module */ /* is returned. */ /************************************************************/ globle void SetModuleItem( void *theEnv, struct defmodule *theModule, int moduleItemIndex, void *newValue) { if (theModule == NULL) { if (DefmoduleData(theEnv)->CurrentModule == NULL) return; theModule = DefmoduleData(theEnv)->CurrentModule; } if (theModule->itemsArray == NULL) return; theModule->itemsArray[moduleItemIndex] = (struct defmoduleItemHeader *) newValue; } /******************************************************/ /* CreateMainModule: Creates the default MAIN module. */ /******************************************************/ 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); } /*********************************************************************/ /* SetListOfDefmodules: Sets the list of defmodules to the specified */ /* value. Normally used when initializing a run-time module or */ /* when bloading a binary file to install the list of defmodules. */ /*********************************************************************/ globle void SetListOfDefmodules( void *theEnv, void *defmodulePtr) { DefmoduleData(theEnv)->ListOfDefmodules = (struct defmodule *) defmodulePtr; DefmoduleData(theEnv)->LastDefmodule = DefmoduleData(theEnv)->ListOfDefmodules; if (DefmoduleData(theEnv)->LastDefmodule == NULL) return; while (DefmoduleData(theEnv)->LastDefmodule->next != NULL) DefmoduleData(theEnv)->LastDefmodule = DefmoduleData(theEnv)->LastDefmodule->next; } /********************************************************************/ /* EnvGetNextDefmodule: If passed a NULL pointer, returns the first */ /* defmodule in the ListOfDefmodules. Otherwise returns the next */ /* defmodule following the defmodule passed as an argument. */ /********************************************************************/ globle void *EnvGetNextDefmodule( void *theEnv, void *defmodulePtr) { if (defmodulePtr == NULL) { return((void *) DefmoduleData(theEnv)->ListOfDefmodules); } else { return((void *) (((struct defmodule *) defmodulePtr)->next)); } } /*****************************************/ /* EnvGetDefmoduleName: Returns the name */ /* of the specified defmodule. */ /*****************************************/ #if IBM_TBC #pragma argsused #endif globle char *EnvGetDefmoduleName( void *theEnv, void *defmodulePtr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(ValueToString(((struct defmodule *) defmodulePtr)->name)); } /***************************************************/ /* EnvGetDefmodulePPForm: Returns the pretty print */ /* representation of the specified defmodule. */ /***************************************************/ #if IBM_TBC #pragma argsused #endif globle char *EnvGetDefmodulePPForm( void *theEnv, void *defmodulePtr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((struct defmodule *) defmodulePtr)->ppForm); } #if (! RUN_TIME) /***********************************************/ /* RemoveAllDefmodules: Removes all defmodules */ /* from the current environment. */ /***********************************************/ globle void RemoveAllDefmodules( void *theEnv) { struct defmodule *nextDefmodule; while (DefmoduleData(theEnv)->ListOfDefmodules != NULL) { nextDefmodule = DefmoduleData(theEnv)->ListOfDefmodules->next; ReturnDefmodule(theEnv,DefmoduleData(theEnv)->ListOfDefmodules,FALSE); DefmoduleData(theEnv)->ListOfDefmodules = nextDefmodule; } DefmoduleData(theEnv)->CurrentModule = NULL; DefmoduleData(theEnv)->LastDefmodule = NULL; } /************************************************************/ /* ReturnDefmodule: Returns the data structures associated */ /* with a defmodule construct to the pool of free memory. */ /************************************************************/ static void ReturnDefmodule( void *theEnv, struct defmodule *theDefmodule, intBool environmentClear) { int i; struct moduleItem *theItem; struct portItem *theSpec, *nextSpec; /*=====================================================*/ /* Set the current module to the module being deleted. */ /*=====================================================*/ if (theDefmodule == NULL) return; if (! environmentClear) { EnvSetCurrentModule(theEnv,(void *) theDefmodule); } /*============================================*/ /* Call the free functions for the constructs */ /* belonging to this module. */ /*============================================*/ if (theDefmodule->itemsArray != NULL) { if (! environmentClear) { for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems; (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL); i++, theItem = theItem->next) { if (theItem->freeFunction != NULL) { (*theItem->freeFunction)(theEnv,theDefmodule->itemsArray[i]); } } } rm(theEnv,theDefmodule->itemsArray,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems); } /*======================================================*/ /* Decrement the symbol count for the defmodule's name. */ /*======================================================*/ if (! environmentClear) { DecrementSymbolCount(theEnv,theDefmodule->name); } /*====================================*/ /* Free the items in the import list. */ /*====================================*/ theSpec = theDefmodule->importList; while (theSpec != NULL) { nextSpec = theSpec->next; if (! environmentClear) { if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName); if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType); if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName); } rtn_struct(theEnv,portItem,theSpec); theSpec = nextSpec; } /*====================================*/ /* Free the items in the export list. */ /*====================================*/ theSpec = theDefmodule->exportList; while (theSpec != NULL) { nextSpec = theSpec->next; if (! environmentClear) { if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName); if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType); if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName); } rtn_struct(theEnv,portItem,theSpec); theSpec = nextSpec; } /*=========================================*/ /* Free the defmodule pretty print string. */ /*=========================================*/ if (theDefmodule->ppForm != NULL) { rm(theEnv,theDefmodule->ppForm, (int) sizeof(char) * (strlen(theDefmodule->ppForm) + 1)); } /*=======================*/ /* Return the user data. */ /*=======================*/ ClearUserDataList(theEnv,theDefmodule->usrData); /*======================================*/ /* Return the defmodule data structure. */ /*======================================*/ rtn_struct(theEnv,defmodule,theDefmodule); } #endif /* (! RUN_TIME) */ /**********************************************************************/ /* EnvFindDefmodule: Searches for a defmodule in the list of defmodules. */ /* Returns a pointer to the defmodule if found, otherwise NULL. */ /**********************************************************************/ globle void *EnvFindDefmodule( void *theEnv, char *defmoduleName) { struct defmodule *defmodulePtr; SYMBOL_HN *findValue; if ((findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,defmoduleName)) == NULL) return(NULL); defmodulePtr = DefmoduleData(theEnv)->ListOfDefmodules; while (defmodulePtr != NULL) { if (defmodulePtr->name == findValue) { return((void *) defmodulePtr); } defmodulePtr = defmodulePtr->next; } return(NULL); } /*************************************************/ /* GetCurrentModuleCommand: H/L access routine */ /* for the get-current-module command. */ /*************************************************/ globle void *GetCurrentModuleCommand( void *theEnv) { struct defmodule *theModule; EnvArgCountCheck(theEnv,"get-current-module",EXACTLY,0); theModule = (struct defmodule *) EnvGetCurrentModule(theEnv); if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); return((SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(theModule->name))); } /*************************************************/ /* SetCurrentModuleCommand: H/L access routine */ /* for the set-current-module command. */ /*************************************************/ globle void *SetCurrentModuleCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; struct defmodule *theModule; SYMBOL_HN *defaultReturn; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); defaultReturn = (SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(((struct defmodule *) EnvGetCurrentModule(theEnv))->name)); if (EnvArgCountCheck(theEnv,"set-current-module",EXACTLY,1) == -1) { return(defaultReturn); } if (EnvArgTypeCheck(theEnv,"set-current-module",1,SYMBOL,&argPtr) == FALSE) { return(defaultReturn); } argument = DOToString(argPtr); /*================================================*/ /* Set the current module to the specified value. */ /*================================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",argument); return(defaultReturn); } EnvSetCurrentModule(theEnv,(void *) theModule); /*================================*/ /* Return the new current module. */ /*================================*/ return((SYMBOL_HN *) defaultReturn); } /*************************************************/ /* AddAfterModuleChangeFunction: Adds a function */ /* to the list of functions to be called after */ /* a module change occurs. */ /*************************************************/ globle void AddAfterModuleChangeFunction( void *theEnv, char *name, void (*func)(void *), int priority) { DefmoduleData(theEnv)->AfterModuleChangeFunctions = AddFunctionToCallList(theEnv,name,priority,func,DefmoduleData(theEnv)->AfterModuleChangeFunctions,TRUE); } /************************************************/ /* IllegalModuleSpecifierMessage: Error message */ /* for the illegal use of a module specifier. */ /************************************************/ globle void IllegalModuleSpecifierMessage( void *theEnv) { PrintErrorID(theEnv,"MODULDEF",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Illegal use of the module specifier.\n"); } clips-6.24/clipssrc/._tmpltrhs.h0000400000175000017500000000012207422634554014766 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._strngrtr.h0000400000175000017500000000012207422634607014775 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/multifun.h0000755000175000017500000000764610441602255014562 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* MULTIFIELD FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary Riley and Brian Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved ImplodeMultifield to multifld.c. */ /* */ /*************************************************************/ #ifndef _H_multifun #define _H_multifun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MULTIFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void MultifieldFunctionDefinitions(void *); #if MULTIFIELD_FUNCTIONS LOCALE void DeleteFunction(void *,DATA_OBJECT_PTR); LOCALE void MVDeleteFunction(void *,DATA_OBJECT_PTR); LOCALE void ReplaceFunction(void *,DATA_OBJECT_PTR); LOCALE void MVReplaceFunction(void *,DATA_OBJECT_PTR); LOCALE void DeleteMemberFunction(void *,DATA_OBJECT_PTR); LOCALE void ReplaceMemberFunction(void *,DATA_OBJECT_PTR); LOCALE void InsertFunction(void *,DATA_OBJECT_PTR); LOCALE void ExplodeFunction(void *,DATA_OBJECT_PTR); LOCALE void *ImplodeFunction(void *); LOCALE void SubseqFunction(void *,DATA_OBJECT_PTR); LOCALE void MVSubseqFunction(void *,DATA_OBJECT_PTR); LOCALE void FirstFunction(void *,DATA_OBJECT_PTR); LOCALE void RestFunction(void *,DATA_OBJECT_PTR); LOCALE void NthFunction(void *,DATA_OBJECT_PTR); LOCALE intBool SubsetpFunction(void *); LOCALE void MemberFunction(void *,DATA_OBJECT_PTR); LOCALE void MultifieldPrognFunction(void *,DATA_OBJECT_PTR); LOCALE void GetMvPrognField(void *,DATA_OBJECT_PTR); LOCALE long GetMvPrognIndex(void *); LOCALE intBool FindDOsInSegment(DATA_OBJECT_PTR,int,DATA_OBJECT_PTR, long *,long *,long *,int); #endif LOCALE int ReplaceMultiValueField(void *,struct dataObject *, struct dataObject *, long, long,struct dataObject *,char *); LOCALE int InsertMultiValueField(void *,struct dataObject *, struct dataObject *, long,struct dataObject *,char *); LOCALE int DeleteMultiValueField(void *,struct dataObject *,struct dataObject *, long,long,char *); #endif clips-6.24/clipssrc/._expressn.c0000400000175000017500000000075410441165566014763 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco00Od bb "TTF/B!&FMPSRMWBBLclips-6.24/clipssrc/._match.h0000400000175000017500000000075407422634530014212 0ustar jfsjfsMac OS X  2 RTEXT???? aTTFH Monacoe?oe?opx } TTF|ADFMWBBMPSRclips-6.24/clipssrc/._miscfun.c0000400000175000017500000000075410441147776014563 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco?l?l:.99TTFS FMWBBMPSRclips-6.24/clipssrc/expressn.h0000755000175000017500000001153010441132010014534 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EXPRESSION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains routines for creating, deleting, */ /* compacting, installing, and hashing expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_expressn #define _H_expressn struct expr; struct exprHashNode; #ifndef _H_exprnops #include "exprnops.h" #endif /******************************/ /* Expression Data Structures */ /******************************/ struct expr { unsigned short type; void *value; struct expr *argList; struct expr *nextArg; }; #define arg_list argList #define next_arg nextArg typedef struct expr EXPRESSION; typedef struct exprHashNode { unsigned hashval; unsigned count; struct expr *exp; struct exprHashNode *next; long bsaveID; } EXPRESSION_HN; #define EXPRESSION_HASH_SIZE 503 /*************************/ /* Type and Value Macros */ /*************************/ #define GetType(target) ((target).type) #define GetpType(target) ((target)->type) #define SetType(target,val) ((target).type = (unsigned short) (val)) #define SetpType(target,val) ((target)->type = (unsigned short) (val)) #define GetValue(target) ((target).value) #define GetpValue(target) ((target)->value) #define SetValue(target,val) ((target).value = (void *) (val)) #define SetpValue(target,val) ((target)->value = (void *) (val)) #define EnvGetType(theEnv,target) ((target).type) #define EnvGetpType(theEnv,target) ((target)->type) #define EnvSetType(theEnv,target,val) ((target).type = (unsigned short) (val)) #define EnvSetpType(theEnv,target,val) ((target)->type = (unsigned short) (val)) #define EnvGetValue(theEnv,target) ((target).value) #define EnvGetpValue(theEnv,target) ((target)->value) #define EnvSetValue(theEnv,target,val) ((target).value = (void *) (val)) #define EnvSetpValue(theEnv,target,val) ((target)->value = (void *) (val)) /********************/ /* ENVIRONMENT DATA */ /********************/ #ifndef _H_exprnpsr #include "exprnpsr.h" #endif #define EXPRESSION_DATA 45 struct expressionData { void *PTR_AND; void *PTR_OR; void *PTR_EQ; void *PTR_NEQ; void *PTR_NOT; EXPRESSION_HN **ExpressionHashTable; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) long NumberOfExpressions; struct expr *ExpressionArray; long int ExpressionCount; #endif #if (! RUN_TIME) SAVED_CONTEXTS *svContexts; int ReturnContext; int BreakContext; #endif intBool SequenceOpMode; }; #define ExpressionData(theEnv) ((struct expressionData *) GetEnvironmentData(theEnv,EXPRESSION_DATA)) /********************/ /* Global Functions */ /********************/ #ifdef LOCALE #undef LOCALE #endif #ifdef _EXPRESSN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ReturnExpression(void *,struct expr *); LOCALE void ExpressionInstall(void *,struct expr *); LOCALE void ExpressionDeinstall(void *,struct expr *); LOCALE struct expr *PackExpression(void *,struct expr *); LOCALE void ReturnPackedExpression(void *,struct expr *); LOCALE void InitExpressionData(void *); LOCALE void InitExpressionPointers(void *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE EXPRESSION *AddHashedExpression(void *,EXPRESSION *); #endif #if (! RUN_TIME) LOCALE void RemoveHashedExpression(void *,EXPRESSION *); #endif #if BLOAD_AND_BSAVE || BLOAD_ONLY || BLOAD || CONSTRUCT_COMPILER LOCALE long HashedExpressionIndex(void *,EXPRESSION *); #endif #endif clips-6.24/clipssrc/._factmch.c0000400000175000017500000000075410441143364014511 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco2 2 1$99TTFS FMWBBMPSRclips-6.24/clipssrc/._incrrset.c0000400000175000017500000000075410441147376014744 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z9.yyTTFS FMWBBMPSRclips-6.24/clipssrc/expressn.c0000755000175000017500000003541610441165566014566 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EXPRESSION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains routines for creating, deleting, */ /* compacting, installing, and hashing expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Corrected link errors with non-default */ /* setup.h configuration settings. */ /* */ /*************************************************************/ #define _EXPRESSN_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include "bload.h" #include "memalloc.h" #include "envrnmnt.h" #include "router.h" #include "extnfunc.h" #include "exprnops.h" #include "prntutil.h" #include "evaluatn.h" #include "expressn.h" #define PRIME_ONE 257 #define PRIME_TWO 263 #define PRIME_THREE 269 /****************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /****************************************/ #if (! RUN_TIME) static long ListToPacked(struct expr *, struct expr *,long); static EXPRESSION_HN *FindHashedExpression(void *,EXPRESSION *,unsigned *,EXPRESSION_HN **); static unsigned HashExpression(EXPRESSION *); #endif static void DeallocateExpressionData(void *); /**************************************************/ /* InitExpressionData: Initializes the function */ /* pointers used in generating some expressions */ /* and the expression hash table. */ /**************************************************/ globle void InitExpressionData( void *theEnv) { #if ! RUN_TIME register unsigned i; #endif AllocateEnvironmentData(theEnv,EXPRESSION_DATA,sizeof(struct expressionData),DeallocateExpressionData); #if ! RUN_TIME InitExpressionPointers(theEnv); ExpressionData(theEnv)->ExpressionHashTable = (EXPRESSION_HN **) gm2(theEnv,(int) (sizeof(EXPRESSION_HN *) * EXPRESSION_HASH_SIZE)); for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++) ExpressionData(theEnv)->ExpressionHashTable[i] = NULL; #endif } /*****************************************/ /* DeallocateExpressionData: Deallocates */ /* environment data for expressions. */ /*****************************************/ static void DeallocateExpressionData( void *theEnv) { #if ! RUN_TIME int i; EXPRESSION_HN *tmpPtr, *nextPtr; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) if (! Bloaded(theEnv)) #endif { for (i = 0; i < EXPRESSION_HASH_SIZE; i++) { tmpPtr = ExpressionData(theEnv)->ExpressionHashTable[i]; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; ReturnPackedExpression(theEnv,tmpPtr->exp); rtn_struct(theEnv,exprHashNode,tmpPtr); tmpPtr = nextPtr; } } } rm(theEnv,ExpressionData(theEnv)->ExpressionHashTable, (int) (sizeof(EXPRESSION_HN *) * EXPRESSION_HASH_SIZE)); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) if ((ExpressionData(theEnv)->NumberOfExpressions != 0) && Bloaded(theEnv)) { genlongfree(theEnv,(void *) ExpressionData(theEnv)->ExpressionArray, ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr)); } #endif } /****************************************************/ /* InitExpressionPointers: Initializes the function */ /* pointers used in generating some expressions. */ /****************************************************/ globle void InitExpressionPointers( void *theEnv) { ExpressionData(theEnv)->PTR_AND = (void *) FindFunction(theEnv,"and"); ExpressionData(theEnv)->PTR_OR = (void *) FindFunction(theEnv,"or"); ExpressionData(theEnv)->PTR_EQ = (void *) FindFunction(theEnv,"eq"); ExpressionData(theEnv)->PTR_NEQ = (void *) FindFunction(theEnv,"neq"); ExpressionData(theEnv)->PTR_NOT = (void *) FindFunction(theEnv,"not"); if ((ExpressionData(theEnv)->PTR_AND == NULL) || (ExpressionData(theEnv)->PTR_OR == NULL) || (ExpressionData(theEnv)->PTR_EQ == NULL) || (ExpressionData(theEnv)->PTR_NEQ == NULL) || (ExpressionData(theEnv)->PTR_NOT == NULL)) { SystemError(theEnv,"EXPRESSN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } } /***************************************************/ /* ExpressionInstall: Increments the busy count of */ /* atomic data values found in an expression. */ /***************************************************/ globle void ExpressionInstall( void *theEnv, struct expr *expression) { if (expression == NULL) return; while (expression != NULL) { AtomInstall(theEnv,expression->type,expression->value); ExpressionInstall(theEnv,expression->argList); expression = expression->nextArg; } } /*****************************************************/ /* ExpressionDeinstall: Decrements the busy count of */ /* atomic data values found in an expression. */ /*****************************************************/ globle void ExpressionDeinstall( void *theEnv, struct expr *expression) { if (expression == NULL) return; while (expression != NULL) { AtomDeinstall(theEnv,expression->type,expression->value); ExpressionDeinstall(theEnv,expression->argList); expression = expression->nextArg; } } #if (! RUN_TIME) /***********************************************************************/ /* PackExpression: Copies an expression (created using multiple memory */ /* requests) into an array (created using a single memory request) */ /* while maintaining all appropriate links in the expression. A */ /* packed expression requires less total memory because it reduces */ /* the overhead required for multiple memory allocations. */ /***********************************************************************/ globle struct expr *PackExpression( void *theEnv, struct expr *original) { struct expr *packPtr; if (original == NULL) return (NULL); packPtr = (struct expr *) gm3(theEnv,(long) sizeof (struct expr) * (long) ExpressionSize(original)); ListToPacked(original,packPtr,0L); return(packPtr); } /***********************************************************/ /* ListToPacked: Copies a list of expressions to an array. */ /***********************************************************/ static long ListToPacked( struct expr *original, struct expr *destination, long count) { long i; if (original == NULL) { return(count); } while (original != NULL) { i = count; count++; destination[i].type = original->type; destination[i].value = original->value; if (original->argList == NULL) { destination[i].argList = NULL; } else { destination[i].argList = (struct expr *) &destination[(long) count]; count = ListToPacked(original->argList,destination,count); } if (original->nextArg == NULL) { destination[i].nextArg = NULL; } else { destination[i].nextArg = (struct expr *) &destination[(long) count]; } original = original->nextArg; } return(count); } /***************************************************************/ /* ReturnPackedExpression: Returns a packed expression created */ /* using PackExpression to the memory manager. */ /***************************************************************/ globle void ReturnPackedExpression( void *theEnv, struct expr *packPtr) { if (packPtr != NULL) { rm3(theEnv,(void *) packPtr,(long) sizeof (struct expr) * ExpressionSize(packPtr)); } } #endif /* (! RUN_TIME) */ /***********************************************/ /* ReturnExpression: Returns a multiply linked */ /* list of expr data structures. */ /***********************************************/ globle void ReturnExpression( void *theEnv, struct expr *waste) { register struct expr *tmp; while (waste != NULL) { if (waste->argList != NULL) ReturnExpression(theEnv,waste->argList); tmp = waste; waste = waste->nextArg; rtn_struct(theEnv,expr,tmp); } } #if (! RUN_TIME) /*************************************************** NAME : FindHashedExpression DESCRIPTION : Determines if a given expression is in the expression hash table INPUTS : 1) The expression 2) A buffer to hold the hash value 3) A buffer to hold the previous node in the hash chain RETURNS : The expression hash table entry (NULL if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ static EXPRESSION_HN *FindHashedExpression( void *theEnv, EXPRESSION *theExp, unsigned *hashval, EXPRESSION_HN **prv) { EXPRESSION_HN *exphash; if (theExp == NULL) return(NULL); *hashval = HashExpression(theExp); *prv = NULL; exphash = ExpressionData(theEnv)->ExpressionHashTable[*hashval]; while (exphash != NULL) { if (IdenticalExpression(exphash->exp,theExp)) return(exphash); *prv = exphash; exphash = exphash->next; } return(NULL); } /*************************************************** NAME : HashExpression DESCRIPTION : Assigns a deterministic number to an expression INPUTS : The expression RETURNS : The "value" of the expression SIDE EFFECTS : None NOTES : None ***************************************************/ static unsigned HashExpression( EXPRESSION *theExp) { unsigned long tally = PRIME_THREE; if (theExp->argList != NULL) tally += HashExpression(theExp->argList) * PRIME_ONE; while (theExp != NULL) { tally += (unsigned long) (theExp->type * PRIME_TWO); tally += (unsigned long) theExp->value; theExp = theExp->nextArg; } return((unsigned) (tally % EXPRESSION_HASH_SIZE)); } /*************************************************** NAME : RemoveHashedExpression DESCRIPTION : Removes a hashed expression from the hash table INPUTS : The expression RETURNS : Nothing useful SIDE EFFECTS : Hash node removed (or use count decremented). If the hash node is removed, the expression is deinstalled and deleted NOTES : If the expression is in use by others, then the use count is merely decremented ***************************************************/ globle void RemoveHashedExpression( void *theEnv, EXPRESSION *theExp) { EXPRESSION_HN *exphash,*prv; unsigned hashval; exphash = FindHashedExpression(theEnv,theExp,&hashval,&prv); if (exphash == NULL) return; if (--exphash->count != 0) return; if (prv == NULL) ExpressionData(theEnv)->ExpressionHashTable[hashval] = exphash->next; else prv->next = exphash->next; ExpressionDeinstall(theEnv,exphash->exp); ReturnPackedExpression(theEnv,exphash->exp); rtn_struct(theEnv,exprHashNode,exphash); } #endif /* (! RUN_TIME) */ #if (! BLOAD_ONLY) && (! RUN_TIME) /***************************************************** 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); } #endif /* (! BLOAD_ONLY) && (! RUN_TIME) */ #if (BLOAD_AND_BSAVE || BLOAD_ONLY || BLOAD || CONSTRUCT_COMPILER) && (! RUN_TIME) /*************************************************** NAME : HashedExpressionIndex DESCRIPTION : Finds the expression bload array index for a hashed expression INPUTS : The expression RETURNS : The bload index SIDE EFFECTS : None NOTES : None ***************************************************/ globle long HashedExpressionIndex( void *theEnv, EXPRESSION *theExp) { EXPRESSION_HN *exphash,*prv; unsigned hashval; if (theExp == NULL) return(-1L); exphash = FindHashedExpression(theEnv,theExp,&hashval,&prv); return((exphash != NULL) ? exphash->bsaveID : -1L); } #endif /* (BLOAD_AND_BSAVE || BLOAD_ONLY || BLOAD || CONSTRUCT_COMPILER) && (! RUN_TIME) */ clips-6.24/clipssrc/._insfile.h0000400000175000017500000000075410441147502014540 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco==9rTTFS FMWBBMPSRclips-6.24/clipssrc/parsefun.c0000755000175000017500000003254210441602266014530 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* PARSING FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several parsing related */ /* functions including... */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /*************************************************************/ #define _PARSEFUN_SOURCE_ #include "setup.h" #include #include "argacces.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "extnfunc.h" #include "memalloc.h" #include "multifld.h" #include "prcdrpsr.h" #include "router.h" #include "strngrtr.h" #include "utility.h" #include "parsefun.h" #define PARSEFUN_DATA 11 struct parseFunctionData { char *ErrorString; int ErrorCurrentPosition; unsigned ErrorMaximumPosition; char *WarningString; int WarningCurrentPosition; unsigned WarningMaximumPosition; }; #define ParseFunctionData(theEnv) ((struct parseFunctionData *) GetEnvironmentData(theEnv,PARSEFUN_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static int FindErrorCapture(void *,char *); static int PrintErrorCapture(void *,char *,char *); static void DeactivateErrorCapture(void *); static void SetErrorCaptureValues(void *,DATA_OBJECT_PTR); #endif /*****************************************/ /* ParseFunctionDefinitions: Initializes */ /* the parsing related functions. */ /*****************************************/ globle void ParseFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,PARSEFUN_DATA,sizeof(struct parseFunctionData),NULL); #if ! RUN_TIME EnvDefineFunction2(theEnv,"check-syntax",'u',PTIEF CheckSyntaxFunction,"CheckSyntaxFunction","11s"); #endif } #if (! RUN_TIME) && (! BLOAD_ONLY) /*******************************************/ /* CheckSyntaxFunction: H/L access routine */ /* for the check-syntax function. */ /*******************************************/ globle void CheckSyntaxFunction( void *theEnv, DATA_OBJECT *returnValue) { DATA_OBJECT theArg; /*===============================*/ /* Set up a default return value */ /* (TRUE for problems found). */ /*===============================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvTrueSymbol(theEnv)); /*=====================================================*/ /* Function check-syntax expects exactly one argument. */ /*=====================================================*/ if (EnvArgCountCheck(theEnv,"check-syntax",EXACTLY,1) == -1) return; /*========================================*/ /* The argument should be of type STRING. */ /*========================================*/ if (EnvArgTypeCheck(theEnv,"check-syntax",1,STRING,&theArg) == FALSE) { return; } /*===================*/ /* Check the syntax. */ /*===================*/ CheckSyntax(theEnv,DOToString(theArg),returnValue); } /*********************************/ /* CheckSyntax: C access routine */ /* for the build function. */ /*********************************/ globle int CheckSyntax( void *theEnv, char *theString, DATA_OBJECT_PTR returnValue) { char *name; struct token theToken; struct expr *top; short rv; /*==============================*/ /* Set the default return value */ /* (TRUE for problems found). */ /*==============================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvTrueSymbol(theEnv)); /*===========================================*/ /* Create a string source router so that the */ /* string can be used as an input source. */ /*===========================================*/ if (OpenStringSource(theEnv,"check-syntax",theString,0) == 0) { return(TRUE); } /*=================================*/ /* Only expressions and constructs */ /* can have their syntax checked. */ /*=================================*/ GetToken(theEnv,"check-syntax",&theToken); if (theToken.type != LPAREN) { CloseStringSource(theEnv,"check-syntax"); SetpValue(returnValue,EnvAddSymbol(theEnv,"MISSING-LEFT-PARENTHESIS")); return(TRUE); } /*========================================*/ /* The next token should be the construct */ /* type or function name. */ /*========================================*/ GetToken(theEnv,"check-syntax",&theToken); if (theToken.type != SYMBOL) { CloseStringSource(theEnv,"check-syntax"); SetpValue(returnValue,EnvAddSymbol(theEnv,"EXPECTED-SYMBOL-AFTER-LEFT-PARENTHESIS")); return(TRUE); } name = ValueToString(theToken.value); /*==============================================*/ /* Set up a router to capture the error output. */ /*==============================================*/ EnvAddRouter(theEnv,"error-capture",40, FindErrorCapture, PrintErrorCapture, NULL, NULL, NULL); /*================================*/ /* Determine if it's a construct. */ /*================================*/ if (FindConstruct(theEnv,name)) { ConstructData(theEnv)->CheckSyntaxMode = TRUE; rv = (short) ParseConstruct(theEnv,name,"check-syntax"); GetToken(theEnv,"check-syntax",&theToken); ConstructData(theEnv)->CheckSyntaxMode = FALSE; if (rv) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); } DestroyPPBuffer(theEnv); CloseStringSource(theEnv,"check-syntax"); if ((rv != FALSE) || (ParseFunctionData(theEnv)->WarningString != NULL)) { SetErrorCaptureValues(theEnv,returnValue); DeactivateErrorCapture(theEnv); return(TRUE); } if (theToken.type != STOP) { SetpValue(returnValue,EnvAddSymbol(theEnv,"EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS")); DeactivateErrorCapture(theEnv); return(TRUE); } SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); DeactivateErrorCapture(theEnv); return(FALSE); } /*=======================*/ /* Parse the expression. */ /*=======================*/ top = Function2Parse(theEnv,"check-syntax",name); GetToken(theEnv,"check-syntax",&theToken); ClearParsedBindNames(theEnv); CloseStringSource(theEnv,"check-syntax"); if (top == NULL) { SetErrorCaptureValues(theEnv,returnValue); DeactivateErrorCapture(theEnv); return(TRUE); } if (theToken.type != STOP) { SetpValue(returnValue,EnvAddSymbol(theEnv,"EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS")); DeactivateErrorCapture(theEnv); ReturnExpression(theEnv,top); return(TRUE); } DeactivateErrorCapture(theEnv); ReturnExpression(theEnv,top); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); return(FALSE); } /**************************************************/ /* DeactivateErrorCapture: Deactivates the error */ /* capture router and the strings used to store */ /* the captured information. */ /**************************************************/ static void DeactivateErrorCapture( void *theEnv) { if (ParseFunctionData(theEnv)->ErrorString != NULL) { rm(theEnv,ParseFunctionData(theEnv)->ErrorString,ParseFunctionData(theEnv)->ErrorMaximumPosition); ParseFunctionData(theEnv)->ErrorString = NULL; } if (ParseFunctionData(theEnv)->WarningString != NULL) { rm(theEnv,ParseFunctionData(theEnv)->WarningString,ParseFunctionData(theEnv)->WarningMaximumPosition); ParseFunctionData(theEnv)->WarningString = NULL; } ParseFunctionData(theEnv)->ErrorCurrentPosition = 0; ParseFunctionData(theEnv)->ErrorMaximumPosition = 0; ParseFunctionData(theEnv)->WarningCurrentPosition = 0; ParseFunctionData(theEnv)->WarningMaximumPosition = 0; EnvDeleteRouter(theEnv,"error-capture"); } /******************************************************************/ /* SetErrorCaptureValues: Stores the error/warnings captured when */ /* parsing an expression or construct into a multifield value. */ /* The first field contains the output sent to the WERROR */ /* logical name and the second field contains the output sent */ /* to the WWARNING logical name. FALSE is stored in either */ /* position if no output was sent to those logical names. */ /******************************************************************/ static void SetErrorCaptureValues( void *theEnv, DATA_OBJECT_PTR returnValue) { struct multifield *theMultifield; theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,2L); if (ParseFunctionData(theEnv)->ErrorString != NULL) { SetMFType(theMultifield,1,STRING); SetMFValue(theMultifield,1,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->ErrorString)); } else { SetMFType(theMultifield,1,SYMBOL); SetMFValue(theMultifield,1,EnvFalseSymbol(theEnv)); } if (ParseFunctionData(theEnv)->WarningString != NULL) { SetMFType(theMultifield,2,STRING); SetMFValue(theMultifield,2,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->WarningString)); } else { SetMFType(theMultifield,2,SYMBOL); SetMFValue(theMultifield,2,EnvFalseSymbol(theEnv)); } SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,2); SetpValue(returnValue,(void *) theMultifield); } /**********************************/ /* FindErrorCapture: Find routine */ /* for the check-syntax router. */ /**********************************/ #if IBM_TBC #pragma argsused #endif static int FindErrorCapture( void *theEnv, char *logicalName) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if ((strcmp(logicalName,WERROR) == 0) || (strcmp(logicalName,WWARNING) == 0)) { return(TRUE); } return(FALSE); } /************************************/ /* PrintErrorCapture: Print routine */ /* for the check-syntax router. */ /************************************/ static int PrintErrorCapture( void *theEnv, char *logicalName, char *str) { if (strcmp(logicalName,WERROR) == 0) { ParseFunctionData(theEnv)->ErrorString = AppendToString(theEnv,str,ParseFunctionData(theEnv)->ErrorString, &ParseFunctionData(theEnv)->ErrorCurrentPosition, &ParseFunctionData(theEnv)->ErrorMaximumPosition); } else if (strcmp(logicalName,WWARNING) == 0) { ParseFunctionData(theEnv)->WarningString = AppendToString(theEnv,str,ParseFunctionData(theEnv)->WarningString, &ParseFunctionData(theEnv)->WarningCurrentPosition, &ParseFunctionData(theEnv)->WarningMaximumPosition); } return(1); } #else /****************************************************/ /* CheckSyntaxFunction: This is the non-functional */ /* stub provided for use with a run-time version. */ /****************************************************/ globle void CheckSyntaxFunction( void *theEnv, DATA_OBJECT *returnValue) { PrintErrorID(theEnv,"PARSEFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function check-syntax does not work in run time modules.\n"); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvTrueSymbol(theEnv)); } /************************************************/ /* CheckSyntax: This is the non-functional stub */ /* provided for use with a run-time version. */ /************************************************/ globle int CheckSyntax( void *theEnv, char *theString, DATA_OBJECT_PTR returnValue) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theString) #pragma unused(returnValue) #endif PrintErrorID(theEnv,"PARSEFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function check-syntax does not work in run time modules.\n"); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvTrueSymbol(theEnv)); return(TRUE); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ clips-6.24/clipssrc/._extnfunc.c0000400000175000017500000000075410441602202014725 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH MonacoTmTm!"ppTTFL+FMPSRMWBBLclips-6.24/clipssrc/utility.h0000755000175000017500000001203610441151275014410 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of utility functions useful to */ /* other modules. Primarily these are the functions for */ /* handling periodic garbage collection and appending */ /* string data. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_utility #define _H_utility #ifdef LOCALE #undef LOCALE #endif struct cleanupFunction { char *name; void (*ip)(void *); int priority; struct cleanupFunction *next; short int environmentAware; }; struct callFunctionItem { char *name; void (*func)(void *); int priority; struct callFunctionItem *next; short int environmentAware; }; #define UTILITY_DATA 55 struct utilityData { struct cleanupFunction *ListOfCleanupFunctions; struct cleanupFunction *ListOfPeriodicFunctions; short GarbageCollectionLocks; short GarbageCollectionHeuristicsEnabled; short PeriodicFunctionsEnabled; short YieldFunctionEnabled; unsigned long EphemeralItemCount; unsigned long EphemeralItemSize; unsigned long CurrentEphemeralCountMax; unsigned long CurrentEphemeralSizeMax; void (*YieldTimeFunction)(void); int LastEvaluationDepth ; }; #define UtilityData(theEnv) ((struct utilityData *) GetEnvironmentData(theEnv,UTILITY_DATA)) #ifdef _UTILITY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DecrementGCLocks(theEnv) EnvDecrementGCLocks(theEnv) #define IncrementGCLocks(theEnv) EnvIncrementGCLocks(theEnv) #define RemovePeriodicFunction(theEnv,a) EnvRemovePeriodicFunction(theEnv,a) #else #define DecrementGCLocks() EnvDecrementGCLocks(GetCurrentEnvironment()) #define IncrementGCLocks() EnvIncrementGCLocks(GetCurrentEnvironment()) #define RemovePeriodicFunction(a) EnvRemovePeriodicFunction(GetCurrentEnvironment(),a) #endif LOCALE void InitializeUtilityData(void *); LOCALE void PeriodicCleanup(void *,intBool,intBool); LOCALE intBool AddCleanupFunction(void *,char *,void (*)(void *),int); LOCALE intBool EnvAddPeriodicFunction(void *,char *,void (*)(void *),int); LOCALE intBool AddPeriodicFunction(char *,void (*)(void),int); LOCALE intBool RemoveCleanupFunction(void *,char *); LOCALE intBool EnvRemovePeriodicFunction(void *,char *); LOCALE char *AppendStrings(void *,char *,char *); LOCALE char *StringPrintForm(void *,char *); LOCALE char *AppendToString(void *,char *,char *,int *,unsigned *); LOCALE char *AppendNToString(void *,char *,char *,unsigned,int *,unsigned *); LOCALE char *ExpandStringWithChar(void *,int,char *,int *,unsigned *,unsigned); LOCALE struct callFunctionItem *AddFunctionToCallList(void *,char *,int,void (*)(void *), struct callFunctionItem *,intBool); LOCALE struct callFunctionItem *RemoveFunctionFromCallList(void *,char *, struct callFunctionItem *, int *); LOCALE void DeallocateCallList(void *,struct callFunctionItem *); LOCALE unsigned ItemHashValue(void *,unsigned short,void *,unsigned); LOCALE void YieldTime(void *); LOCALE short SetGarbageCollectionHeuristics(void *,short); LOCALE void EnvIncrementGCLocks(void *); LOCALE void EnvDecrementGCLocks(void *); LOCALE short EnablePeriodicFunctions(void *,short); LOCALE short EnableYieldFunction(void *,short); #endif clips-6.24/clipssrc/tmpltcmp.h0000755000175000017500000000304207422634772014557 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFTEMPLATE CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_tmpltcmp #define _H_tmpltcmp #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeftemplateCompilerSetup(void *); LOCALE void DeftemplateCModuleReference(void *,FILE *,int,int,int); LOCALE void DeftemplateCConstructReference(void *,FILE *,void *,int,int); #endif clips-6.24/clipssrc/._envrnmnt.h0000400000175000017500000000075410441602151014752 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacoqqn,,5TTFHFMWBBMPSRclips-6.24/clipssrc/._incrrset.h0000400000175000017500000000075410441147405014742 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z95,,TTFS FMWBBMPSRclips-6.24/clipssrc/._dffnxbin.c0000400000175000017500000000075410177533433014710 0ustar jfsjfsMac OS X  2 RTEXT???? aTTFH Monaco0z0z$;4TTFT#FMWBBMPSRclips-6.24/clipssrc/._tmpltlhs.c0000400000175000017500000000075410441151234014746 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z<TTFS FMWBBMPSRclips-6.24/clipssrc/._insmult.h0000400000175000017500000000075410441147600014601 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z9TTFS FMWBBMPSRclips-6.24/clipssrc/dffctbsc.c0000755000175000017500000002407410441111617014457 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFFACTS BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deffacts */ /* construct such as clear, reset, save, undeffacts, */ /* ppdeffacts, list-deffacts, and get-deffacts-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _DFFCTBSC_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "argacces.h" #include "memalloc.h" #include "scanner.h" #include "router.h" #include "extnfunc.h" #include "constrct.h" #include "cstrccom.h" #include "factrhs.h" #include "tmpltdef.h" #include "cstrcpsr.h" #include "dffctpsr.h" #include "dffctdef.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "dffctbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "dffctcmp.h" #endif #include "dffctbsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ResetDeffacts(void *); static void ClearDeffacts(void *); static void SaveDeffacts(void *,void *,char *); static void ResetDeffactsAction(void *,struct constructHeader *,void *); /***************************************************************/ /* DeffactsBasicCommands: Initializes basic deffacts commands. */ /***************************************************************/ globle void DeffactsBasicCommands( void *theEnv) { EnvAddResetFunction(theEnv,"deffacts",ResetDeffacts,0); EnvAddClearFunction(theEnv,"deffacts",ClearDeffacts,0); AddSaveFunction(theEnv,"deffacts",SaveDeffacts,10); #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-deffacts-list",'m',PTIEF GetDeffactsListFunction,"GetDeffactsListFunction","01w"); EnvDefineFunction2(theEnv,"undeffacts",'v',PTIEF UndeffactsCommand,"UndeffactsCommand","11w"); EnvDefineFunction2(theEnv,"deffacts-module",'w',PTIEF DeffactsModuleFunction,"DeffactsModuleFunction","11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-deffacts",'v', PTIEF ListDeffactsCommand,"ListDeffactsCommand","01w"); EnvDefineFunction2(theEnv,"ppdeffacts",'v',PTIEF PPDeffactsCommand,"PPDeffactsCommand","11w"); #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DeffactsBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeffactsCompilerSetup(theEnv); #endif #endif } /**********************************************************/ /* ResetDeffacts: Deffacts reset routine for use with the */ /* reset command. Asserts all of the facts contained in */ /* deffacts constructs. */ /**********************************************************/ static void ResetDeffacts( void *theEnv) { DoForAllConstructs(theEnv,ResetDeffactsAction,DeffactsData(theEnv)->DeffactsModuleIndex,TRUE,NULL); } /*****************************************************/ /* ResetDeffactsAction: Action to be applied to each */ /* deffacts construct during a reset command. */ /*****************************************************/ #if IBM_TBC #pragma argsused #endif static void ResetDeffactsAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif DATA_OBJECT result; struct deffacts *theDeffacts = (struct deffacts *) theConstruct; if (theDeffacts->assertList == NULL) return; SetEvaluationError(theEnv,FALSE); EvaluateExpression(theEnv,theDeffacts->assertList,&result); } /**********************************************************/ /* ClearDeffacts: Deffacts clear routine for use with the */ /* clear command. Creates the initial-facts deffacts. */ /**********************************************************/ static void ClearDeffacts( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) struct expr *stub; struct deffacts *newDeffacts; /*=====================================*/ /* Create the data structures for the */ /* expression (assert (initial-fact)). */ /*=====================================*/ stub = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert")); stub->argList = GenConstant(theEnv,DEFTEMPLATE_PTR,EnvFindDeftemplate(theEnv,"initial-fact")); ExpressionInstall(theEnv,stub); /*=============================================*/ /* Create a deffacts data structure to contain */ /* the expression and initialize it. */ /*=============================================*/ newDeffacts = get_struct(theEnv,deffacts); newDeffacts->header.whichModule = (struct defmoduleItemHeader *) GetDeffactsModuleItem(theEnv,NULL); newDeffacts->header.name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"); IncrementSymbolCount(newDeffacts->header.name); newDeffacts->assertList = PackExpression(theEnv,stub); newDeffacts->header.next = NULL; newDeffacts->header.ppForm = NULL; newDeffacts->header.usrData = NULL; ReturnExpression(theEnv,stub); /*===========================================*/ /* Store the deffacts in the current module. */ /*===========================================*/ AddConstructToModule(&newDeffacts->header); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /***************************************/ /* SaveDeffacts: Deffacts save routine */ /* for use with the save command. */ /***************************************/ static void SaveDeffacts( void *theEnv, void *theModule, char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DeffactsData(theEnv)->DeffactsConstruct); } /*******************************************/ /* UndeffactsCommand: H/L access routine */ /* for the undeffacts command. */ /*******************************************/ globle void UndeffactsCommand( void *theEnv) { UndefconstructCommand(theEnv,"undeffacts",DeffactsData(theEnv)->DeffactsConstruct); } /***********************************/ /* EnvUndeffacts: C access routine */ /* for the undeffacts command. */ /***********************************/ globle intBool EnvUndeffacts( void *theEnv, void *theDeffacts) { return(Undefconstruct(theEnv,theDeffacts,DeffactsData(theEnv)->DeffactsConstruct)); } /*************************************************/ /* GetDeffactsListFunction: H/L access routine */ /* for the get-deffacts-list function. */ /*************************************************/ globle void GetDeffactsListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-deffacts-list",returnValue,DeffactsData(theEnv)->DeffactsConstruct); } /*****************************************/ /* EnvGetDeffactsList: C access routine */ /* for the get-deffacts-list function. */ /*****************************************/ globle void EnvGetDeffactsList( void *theEnv, DATA_OBJECT_PTR returnValue, void *theModule) { GetConstructList(theEnv,returnValue,DeffactsData(theEnv)->DeffactsConstruct,(struct defmodule *) theModule); } /************************************************/ /* DeffactsModuleFunction: H/L access routine */ /* for the deffacts-module function. */ /************************************************/ globle void *DeffactsModuleFunction( void *theEnv) { return(GetConstructModuleCommand(theEnv,"deffacts-module",DeffactsData(theEnv)->DeffactsConstruct)); } #if DEBUGGING_FUNCTIONS /*******************************************/ /* PPDeffactsCommand: H/L access routine */ /* for the ppdeffacts command. */ /*******************************************/ globle void PPDeffactsCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdeffacts",DeffactsData(theEnv)->DeffactsConstruct); } /************************************/ /* PPDeffacts: C access routine for */ /* the ppdeffacts command. */ /************************************/ globle int PPDeffacts( void *theEnv, char *deffactsName, char *logicalName) { return(PPConstruct(theEnv,deffactsName,logicalName,DeffactsData(theEnv)->DeffactsConstruct)); } /*********************************************/ /* ListDeffactsCommand: H/L access routine */ /* for the list-deffacts command. */ /*********************************************/ globle void ListDeffactsCommand( void *theEnv) { ListConstructCommand(theEnv,"list-deffacts",DeffactsData(theEnv)->DeffactsConstruct); } /*************************************/ /* EnvListDeffacts: C access routine */ /* for the list-deffacts command. */ /*************************************/ globle void EnvListDeffacts( void *theEnv, char *logicalName, void *theModule) { ListConstruct(theEnv,DeffactsData(theEnv)->DeffactsConstruct,logicalName,(struct defmodule *) theModule); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFFACTS_CONSTRUCT */ clips-6.24/clipssrc/tmpltbin.h0000755000175000017500000000523607422634610014546 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFTEMPLATE BSAVE/BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #if (! RUN_TIME) #ifndef _H_tmpltbin #define _H_tmpltbin struct bsaveTemplateSlot { unsigned long slotName; unsigned int multislot : 1; unsigned int noDefault : 1; unsigned int defaultPresent : 1; unsigned int defaultDynamic : 1; long constraints; long defaultList; long next; }; struct bsaveDeftemplate; struct bsaveDeftemplateModule; #include "cstrcbin.h" struct bsaveDeftemplate { struct bsaveConstructHeader header; long slotList; unsigned int implied : 1; unsigned int numberOfSlots : 15; long patternNetwork; }; #include "modulbin.h" struct bsaveDeftemplateModule { struct bsaveDefmoduleItemHeader header; }; #define TMPLTBIN_DATA 61 struct deftemplateBinaryData { struct deftemplate *DeftemplateArray; long NumberOfDeftemplates; long NumberOfTemplateSlots; long NumberOfTemplateModules; struct templateSlot *SlotArray; struct deftemplateModule *ModuleArray; }; #define DeftemplateBinaryData(theEnv) ((struct deftemplateBinaryData *) GetEnvironmentData(theEnv,TMPLTBIN_DATA)) #define DeftemplatePointer(i) ((struct deftemplate *) (&DeftemplateBinaryData(theEnv)->DeftemplateArray[i])) #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeftemplateBinarySetup(void *); LOCALE void *BloadDeftemplateModuleReference(void *,int); #endif #endif clips-6.24/clipssrc/engine.h0000755000175000017500000001703110443656422014160 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* ENGINE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functionality primarily associated with */ /* the run and focus commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed INCREMENTAL_RESET and */ /* LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added access functions to the HaltRules flag. */ /* */ /* Added EnvGetNextFocus, EnvGetFocusChanged, and */ /* EnvSetFocusChanged functions. */ /* */ /*************************************************************/ #ifndef _H_engine #define _H_engine #ifndef _H_lgcldpnd #include "lgcldpnd.h" #endif #ifndef _H_ruledef #include "ruledef.h" #endif #ifndef _H_network #include "network.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_retract #include "retract.h" #endif struct focus { struct defmodule *theModule; struct defruleModule *theDefruleModule; struct focus *next; }; #define ENGINE_DATA 18 struct engineData { struct defrule *ExecutingRule; intBool HaltRules; struct joinNode *TheLogicalJoin; struct dependency *UnsupportedDataEntities; int alreadyEntered; struct callFunctionItem *ListOfRunFunctions; struct focus *CurrentFocus; int FocusChanged; #if DEBUGGING_FUNCTIONS unsigned WatchStatistics; unsigned WatchFocus; #endif intBool IncrementalResetInProgress; intBool IncrementalResetFlag; intBool JoinOperationInProgress; struct partialMatch *GlobalLHSBinds; struct partialMatch *GlobalRHSBinds; struct joinNode *GlobalJoin; struct rdriveinfo *DriveRetractionList; struct partialMatch *GarbagePartialMatches; struct alphaMatch *GarbageAlphaMatches; int AlreadyRunning; }; #define EngineData(theEnv) ((struct engineData *) GetEnvironmentData(theEnv,ENGINE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _ENGINE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /**************************************************************/ /* The GetFocus function is remapped under certain conditions */ /* because it conflicts with a Windows 3.1 function. */ /**************************************************************/ /* #if ! ((GENERIC || IBM) && WINDOW_INTERFACE) #define WRGetFocus GetFocus #endif */ #define MAX_PATTERNS_CHECKED 64 #if ENVIRONMENT_API_ONLY #define ClearFocusStack(theEnv) EnvClearFocusStack(theEnv) #define DefruleHasBreakpoint(theEnv,a) EnvDefruleHasBreakpoint(theEnv,a) #define Focus(theEnv,a) EnvFocus(theEnv,a) #define GetFocus(theEnv) EnvGetFocus(theEnv) #define GetFocusChanged(theEnv) EnvGetFocusChanged(theEnv) #define GetFocusStack(theEnv,a) EnvGetFocusStack(theEnv,a) #define GetNextFocus(theEnv,a) EnvGetNextFocus(theEnv,a) #define ListFocusStack(theEnv,a) EnvListFocusStack(theEnv,a) #define PopFocus(theEnv) EnvPopFocus(theEnv) #define RemoveBreak(theEnv,a) EnvRemoveBreak(theEnv,a) #define RemoveRunFunction(theEnv,a) EnvRemoveRunFunction(theEnv,a) #define Run(theEnv,a) EnvRun(theEnv,a) #define SetBreak(theEnv,a) EnvSetBreak(theEnv,a) #define SetFocusChanged(theEnv,a) EnvSetFocusChanged(theEnv,a) #define ShowBreaks(theEnv,a,b) EnvShowBreaks(theEnv,a,b) #else #define ClearFocusStack() EnvClearFocusStack(GetCurrentEnvironment()) #define DefruleHasBreakpoint(a) EnvDefruleHasBreakpoint(GetCurrentEnvironment(),a) #define Focus(a) EnvFocus(GetCurrentEnvironment(),a) #define GetFocus() EnvGetFocus(GetCurrentEnvironment()) #define GetFocusChanged() EnvGetFocusChanged(GetCurrentEnvironment()) #define GetFocusStack(a) EnvGetFocusStack(GetCurrentEnvironment(),a) #define GetNextFocus(a) EnvGetNextFocus(GetCurrentEnvironment(),a) #define ListFocusStack(a) EnvListFocusStack(GetCurrentEnvironment(),a) #define PopFocus() EnvPopFocus(GetCurrentEnvironment()) #define RemoveBreak(a) EnvRemoveBreak(GetCurrentEnvironment(),a) #define RemoveRunFunction(a) EnvRemoveRunFunction(GetCurrentEnvironment(),a) #define Run(a) EnvRun(GetCurrentEnvironment(),a) #define SetBreak(a) EnvSetBreak(GetCurrentEnvironment(),a) #define SetFocusChanged(a) EnvSetFocusChanged(GetCurrentEnvironment(),a) #define ShowBreaks(a,b) EnvShowBreaks(GetCurrentEnvironment(),a,b) #endif LOCALE intBool EnvAddRunFunction(void *,char *, void (*)(void *),int); LOCALE intBool AddRunFunction(char *,void (*)(void),int); LOCALE long EnvRun(void *,long); LOCALE intBool EnvRemoveRunFunction(void *,char *); LOCALE void InitializeEngine(void *); LOCALE void EnvSetBreak(void *,void *); LOCALE intBool EnvRemoveBreak(void *,void *); LOCALE void RemoveAllBreakpoints(void *); LOCALE void EnvShowBreaks(void *,char *,void *); LOCALE intBool EnvDefruleHasBreakpoint(void *,void *); LOCALE void RunCommand(void *); LOCALE void SetBreakCommand(void *); LOCALE void RemoveBreakCommand(void *); LOCALE void ShowBreaksCommand(void *); LOCALE void HaltCommand(void *); LOCALE int FocusCommand(void *); LOCALE void ClearFocusStackCommand(void *); LOCALE void EnvClearFocusStack(void *); LOCALE void *EnvGetNextFocus(void *,void *); LOCALE void EnvFocus(void *,void *); LOCALE int EnvGetFocusChanged(void *); LOCALE void EnvSetFocusChanged(void *,int); LOCALE void ListFocusStackCommand(void *); LOCALE void EnvListFocusStack(void *,char *); LOCALE void GetFocusStackFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetFocusStack(void *,DATA_OBJECT_PTR); LOCALE void *PopFocusFunction(void *); LOCALE void *GetFocusFunction(void *); LOCALE void *EnvPopFocus(void *); LOCALE void *EnvGetFocus(void *); LOCALE intBool EnvGetHaltRules(void *); LOCALE void EnvSetHaltRules(void *,intBool); #endif clips-6.24/clipssrc/._ruledlt.c0000400000175000017500000000452210441151115014545 0ustar jfsjfsMac OS X  2 R TEXTR*ch an ruledlt.ctrol PanelTCmr.txt.docTEXTR*ch@ p)2 " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco0u0u<}99nS nGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/._cstrncmp.h0000400000175000017500000000012207422634770014742 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/rulecstr.c0000755000175000017500000007751510441151030014545 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* RULE CONSTRAINTS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for detecting constraint */ /* conflicts in the LHS and RHS of rules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _RULECSTR_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "analysis.h" #include "cstrnchk.h" #include "cstrnops.h" #include "cstrnutl.h" #include "envrnmnt.h" #include "extnfunc.h" #include "prcdrpsr.h" #include "reorder.h" #include "router.h" #include "rulepsr.h" #include "rulecstr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool CheckForUnmatchableConstraints(void *,struct lhsParseNode *,int); static intBool MultifieldCardinalityViolation(void *,struct lhsParseNode *); static struct lhsParseNode *UnionVariableConstraints(void *,struct lhsParseNode *, struct lhsParseNode *); static struct lhsParseNode *AddToVariableConstraints(void *,struct lhsParseNode *, struct lhsParseNode *); static void ConstraintConflictMessage(void *,struct symbolHashNode *, int,int,struct symbolHashNode *); static intBool CheckArgumentForConstraintError(void *,struct expr *,struct expr*, int,struct FunctionDefinition *, struct lhsParseNode *); /***********************************************************/ /* CheckForUnmatchableConstraints: Determines if a LHS CE */ /* node contains unmatchable constraints. Return TRUE if */ /* there are unmatchable constraints, otherwise FALSE. */ /***********************************************************/ static intBool CheckForUnmatchableConstraints( void *theEnv, struct lhsParseNode *theNode, int whichCE) { if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(FALSE); if (UnmatchableConstraint(theNode->constraints)) { ConstraintConflictMessage(theEnv,(SYMBOL_HN *) theNode->value,whichCE, theNode->index,theNode->slot); return(TRUE); } return(FALSE); } /******************************************************/ /* ConstraintConflictMessage: Error message used when */ /* a constraint restriction for a slot prevents any */ /* value from matching the pattern constraint. */ /******************************************************/ static void ConstraintConflictMessage( void *theEnv, struct symbolHashNode *variableName, int thePattern, int theField, struct symbolHashNode *theSlot) { /*=========================*/ /* Print the error header. */ /*=========================*/ PrintErrorID(theEnv,"RULECSTR",1,TRUE); /*======================================================*/ /* Print the variable name (if available) and CE number */ /* for which the constraint violation occurred. */ /*======================================================*/ if (variableName != NULL) { EnvPrintRouter(theEnv,WERROR,"Variable ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(variableName)); EnvPrintRouter(theEnv,WERROR," in CE #"); PrintLongInteger(theEnv,WERROR,(long int) thePattern); } else { EnvPrintRouter(theEnv,WERROR,"Pattern #"); PrintLongInteger(theEnv,WERROR,(long int) thePattern); } /*=======================================*/ /* Print the slot name or field position */ /* in which the violation occurred. */ /*=======================================*/ if (theSlot == NULL) { EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long int) theField); } else { EnvPrintRouter(theEnv,WERROR," slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(theSlot)); } /*======================================*/ /* Print the rest of the error message. */ /*======================================*/ EnvPrintRouter(theEnv,WERROR,"\nhas constraint conflicts which make the pattern unmatchable.\n"); } /***************************************************************/ /* MultifieldCardinalityViolation: Determines if a cardinality */ /* violation has occurred for a LHS CE node. */ /***************************************************************/ static intBool MultifieldCardinalityViolation( void *theEnv, struct lhsParseNode *theNode) { struct lhsParseNode *tmpNode; struct expr *tmpMax; long minFields = 0; long maxFields = 0; int posInfinity = FALSE; CONSTRAINT_RECORD *newConstraint, *tempConstraint; /*================================*/ /* A single field slot can't have */ /* a cardinality violation. */ /*================================*/ if (theNode->multifieldSlot == FALSE) return(FALSE); /*=============================================*/ /* Determine the minimum and maximum number of */ /* fields the slot could contain based on the */ /* slot constraints found in the pattern. */ /*=============================================*/ for (tmpNode = theNode->bottom; tmpNode != NULL; tmpNode = tmpNode->right) { /*====================================================*/ /* A single field variable increases both the minimum */ /* and maximum number of fields by one. */ /*====================================================*/ if ((tmpNode->type == SF_VARIABLE) || (tmpNode->type == SF_WILDCARD)) { minFields++; maxFields++; } /*=================================================*/ /* Otherwise a multifield wildcard or variable has */ /* been encountered. If it is constrained then use */ /* minimum and maximum number of fields constraint */ /* associated with this LHS node. */ /*=================================================*/ else if (tmpNode->constraints != NULL) { /*=======================================*/ /* The lowest minimum of all the min/max */ /* pairs will be the first in the list. */ /*=======================================*/ if (tmpNode->constraints->minFields->value != SymbolData(theEnv)->NegativeInfinity) { minFields += ValueToLong(tmpNode->constraints->minFields->value); } /*=========================================*/ /* The greatest maximum of all the min/max */ /* pairs will be the last in the list. */ /*=========================================*/ tmpMax = tmpNode->constraints->maxFields; while (tmpMax->nextArg != NULL) tmpMax = tmpMax->nextArg; if (tmpMax->value == SymbolData(theEnv)->PositiveInfinity) { posInfinity = TRUE; } else { maxFields += ValueToLong(tmpMax->value); } } /*================================================*/ /* Otherwise an unconstrained multifield wildcard */ /* or variable increases the maximum number of */ /* fields to positive infinity. */ /*================================================*/ else { posInfinity = TRUE; } } /*==================================================================*/ /* Create a constraint record for the cardinality of the sum of the */ /* cardinalities of the restrictions inside the multifield slot. */ /*==================================================================*/ if (theNode->constraints == NULL) tempConstraint = GetConstraintRecord(theEnv); else tempConstraint = CopyConstraintRecord(theEnv,theNode->constraints); ReturnExpression(theEnv,tempConstraint->minFields); ReturnExpression(theEnv,tempConstraint->maxFields); tempConstraint->minFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) minFields)); if (posInfinity) tempConstraint->maxFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity); else tempConstraint->maxFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) maxFields)); /*================================================================*/ /* Determine the final cardinality for the multifield slot by */ /* intersecting the cardinality sum of the restrictions within */ /* the multifield slot with the original cardinality of the slot. */ /*================================================================*/ newConstraint = IntersectConstraints(theEnv,theNode->constraints,tempConstraint); if (theNode->derivedConstraints) RemoveConstraint(theEnv,theNode->constraints); RemoveConstraint(theEnv,tempConstraint); theNode->constraints = newConstraint; theNode->derivedConstraints = TRUE; /*===================================================================*/ /* Determine if the final cardinality for the slot can be satisfied. */ /*===================================================================*/ if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(FALSE); if (UnmatchableConstraint(newConstraint)) return(TRUE); return(FALSE); } /***************************************************/ /* ProcessConnectedConstraints: Examines a single */ /* connected constraint searching for constraint */ /* violations. */ /***************************************************/ globle intBool ProcessConnectedConstraints( void *theEnv, struct lhsParseNode *theNode, struct lhsParseNode *multifieldHeader, struct lhsParseNode *patternHead) { struct constraintRecord *orConstraints = NULL, *andConstraints; struct constraintRecord *tmpConstraints, *rvConstraints; struct lhsParseNode *orNode, *andNode; struct expr *tmpExpr; /*============================================*/ /* Loop through all of the or (|) constraints */ /* found in the connected constraint. */ /*============================================*/ for (orNode = theNode->bottom; orNode != NULL; orNode = orNode->bottom) { /*=================================================*/ /* Intersect all of the &'ed constraints together. */ /*=================================================*/ andConstraints = NULL; for (andNode = orNode; andNode != NULL; andNode = andNode->right) { if (! andNode->negated) { if (andNode->type == RETURN_VALUE_CONSTRAINT) { if (andNode->expression->type == FCALL) { rvConstraints = FunctionCallToConstraintRecord(theEnv,andNode->expression->value); tmpConstraints = andConstraints; andConstraints = IntersectConstraints(theEnv,andConstraints,rvConstraints); RemoveConstraint(theEnv,tmpConstraints); RemoveConstraint(theEnv,rvConstraints); } } else if (ConstantType(andNode->type)) { tmpExpr = GenConstant(theEnv,andNode->type,andNode->value); rvConstraints = ExpressionToConstraintRecord(theEnv,tmpExpr); tmpConstraints = andConstraints; andConstraints = IntersectConstraints(theEnv,andConstraints,rvConstraints); RemoveConstraint(theEnv,tmpConstraints); RemoveConstraint(theEnv,rvConstraints); ReturnExpression(theEnv,tmpExpr); } else if (andNode->constraints != NULL) { tmpConstraints = andConstraints; andConstraints = IntersectConstraints(theEnv,andConstraints,andNode->constraints); RemoveConstraint(theEnv,tmpConstraints); } } } /*===========================================================*/ /* Intersect the &'ed constraints with the slot constraints. */ /*===========================================================*/ tmpConstraints = andConstraints; andConstraints = IntersectConstraints(theEnv,andConstraints,theNode->constraints); RemoveConstraint(theEnv,tmpConstraints); /*===============================================================*/ /* Remove any negated constants from the list of allowed values. */ /*===============================================================*/ for (andNode = orNode; andNode != NULL; andNode = andNode->right) { if ((andNode->negated) && ConstantType(andNode->type)) { RemoveConstantFromConstraint(theEnv,andNode->type,andNode->value,andConstraints); } } /*=======================================================*/ /* Union the &'ed constraints with the |'ed constraints. */ /*=======================================================*/ tmpConstraints = orConstraints; orConstraints = UnionConstraints(theEnv,orConstraints,andConstraints); RemoveConstraint(theEnv,tmpConstraints); RemoveConstraint(theEnv,andConstraints); } /*===============================================*/ /* Replace the constraints for the slot with the */ /* constraints derived from the connected */ /* constraints (which should be a subset. */ /*===============================================*/ if (orConstraints != NULL) { if (theNode->derivedConstraints) RemoveConstraint(theEnv,theNode->constraints); theNode->constraints = orConstraints; theNode->derivedConstraints = TRUE; } /*==================================*/ /* Check for constraint violations. */ /*==================================*/ if (CheckForUnmatchableConstraints(theEnv,theNode,(int) patternHead->whichCE)) { return(TRUE); } /*=========================================*/ /* If the constraints are for a multifield */ /* slot, check for cardinality violations. */ /*=========================================*/ if ((multifieldHeader != NULL) && (theNode->right == NULL)) { if (MultifieldCardinalityViolation(theEnv,multifieldHeader)) { ConstraintViolationErrorMessage(theEnv,"The group of restrictions", NULL,FALSE, (int) patternHead->whichCE, multifieldHeader->slot, multifieldHeader->index, CARDINALITY_VIOLATION, multifieldHeader->constraints,TRUE); return(TRUE); } } /*=======================================*/ /* Return FALSE indicating no constraint */ /* violations were detected. */ /*=======================================*/ return(FALSE); } /**************************************************/ /* ConstraintReferenceErrorMessage: Generic error */ /* message for LHS constraint violation errors */ /* that occur within an expression. */ /**************************************************/ globle void ConstraintReferenceErrorMessage( void *theEnv, struct symbolHashNode *theVariable, struct lhsParseNode *theExpression, int whichArgument, int whichCE, struct symbolHashNode *slotName, int theField) { struct expr *temprv; PrintErrorID(theEnv,"RULECSTR",2,TRUE); /*==========================*/ /* Print the variable name. */ /*==========================*/ EnvPrintRouter(theEnv,WERROR,"Previous variable bindings of ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(theVariable)); EnvPrintRouter(theEnv,WERROR," caused the type restrictions"); /*============================*/ /* Print the argument number. */ /*============================*/ EnvPrintRouter(theEnv,WERROR,"\nfor argument #"); PrintLongInteger(theEnv,WERROR,(long int) whichArgument); /*=======================*/ /* Print the expression. */ /*=======================*/ EnvPrintRouter(theEnv,WERROR," of the expression "); temprv = LHSParseNodesToExpression(theEnv,theExpression); ReturnExpression(theEnv,temprv->nextArg); temprv->nextArg = NULL; PrintExpression(theEnv,WERROR,temprv); EnvPrintRouter(theEnv,WERROR,"\n"); ReturnExpression(theEnv,temprv); /*========================================*/ /* Print out the index of the conditional */ /* element and the slot name or field */ /* index where the violation occured. */ /*========================================*/ EnvPrintRouter(theEnv,WERROR,"found in CE #"); PrintLongInteger(theEnv,WERROR,(long int) whichCE); if (slotName == NULL) { if (theField > 0) { EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long int) theField); } } else { EnvPrintRouter(theEnv,WERROR," slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(slotName)); } EnvPrintRouter(theEnv,WERROR," to be violated.\n"); } /********************************************************/ /* AddToVariableConstraints: Adds the constraints for a */ /* variable to a list of constraints. If the variable */ /* is already in the list, the constraints for the */ /* variable are intersected with the new constraints. */ /********************************************************/ static struct lhsParseNode *AddToVariableConstraints( void *theEnv, struct lhsParseNode *oldList, struct lhsParseNode *newItems) { CONSTRAINT_RECORD *newConstraints; struct lhsParseNode *temp, *trace; /*=================================================*/ /* Loop through each of the new constraints adding */ /* it to the list if it's not already present or */ /* modifying the constraint if it is. */ /*=================================================*/ while (newItems != NULL) { /*==========================================*/ /* Get the next item since the next pointer */ /* value (right) needs to be set to NULL. */ /*==========================================*/ temp = newItems->right; newItems->right = NULL; /*===================================*/ /* Search the list for the variable. */ /*===================================*/ for (trace = oldList; trace != NULL; trace = trace->right) { /*=========================================*/ /* If the variable is already in the list, */ /* modify the constraint already there to */ /* include the new constraint. */ /*=========================================*/ if (trace->value == newItems->value) { newConstraints = IntersectConstraints(theEnv,trace->constraints, newItems->constraints); RemoveConstraint(theEnv,trace->constraints); trace->constraints = newConstraints; ReturnLHSParseNodes(theEnv,newItems); break; } } /*=================================*/ /* Add the variable constraints to */ /* the list if it wasn't found. */ /*=================================*/ if (trace == NULL) { newItems->right = oldList; oldList = newItems; } /*===========================*/ /* Move on to the next item. */ /*===========================*/ newItems = temp; } return(oldList); } /***********************************************************/ /* UnionVariableConstraints: Unions two lists of variable */ /* constraints. If a variable appears in one list but */ /* not the other, then the variable is unconstrained and */ /* thus not included in the unioned list. */ /***********************************************************/ static struct lhsParseNode *UnionVariableConstraints( void *theEnv, struct lhsParseNode *list1, struct lhsParseNode *list2) { struct lhsParseNode *list3 = NULL, *trace, *temp; /*===================================*/ /* Loop through all of the variables */ /* in the first list. */ /*===================================*/ while (list1 != NULL) { /*=============================================*/ /* Search for the variable in the second list. */ /*=============================================*/ for (trace = list2; trace != NULL; trace = trace->right) { /*============================================*/ /* If the variable is found in both lists, */ /* union the constraints and add the variable */ /* to the new list being constructed. */ /*============================================*/ if (list1->value == trace->value) { temp = GetLHSParseNode(theEnv); temp->derivedConstraints = TRUE; temp->value = list1->value; temp->constraints = UnionConstraints(theEnv,list1->constraints,trace->constraints); temp->right = list3; list3 = temp; break; } } /*==============================*/ /* Move on to the next variable */ /* in the first list. */ /*==============================*/ temp = list1->right; list1->right = NULL; ReturnLHSParseNodes(theEnv,list1); list1 = temp; } /*====================================*/ /* Free the items in the second list. */ /*====================================*/ ReturnLHSParseNodes(theEnv,list2); /*======================*/ /* Return the new list. */ /*======================*/ return(list3); } /*****************************************************************/ /* GetExpressionVarConstraints: Given an expression stored using */ /* the LHS parse node data structures, determines and returns */ /* the constraints on variables caused by that expression. For */ /* example, the expression (+ ?x 1) would imply a numeric type */ /* constraint for the variable ?x since the addition function */ /* expects numeric arguments. */ /*****************************************************************/ globle struct lhsParseNode *GetExpressionVarConstraints( void *theEnv, struct lhsParseNode *theExpression) { struct lhsParseNode *list1 = NULL, *list2; for (; theExpression != NULL; theExpression = theExpression->bottom) { if (theExpression->right != NULL) { list2 = GetExpressionVarConstraints(theEnv,theExpression->right); list1 = AddToVariableConstraints(theEnv,list2,list1); } if (theExpression->type == SF_VARIABLE) { list2 = GetLHSParseNode(theEnv); if (theExpression->referringNode != NULL) { list2->type = theExpression->referringNode->type; } else { list2->type = SF_VARIABLE; } list2->value = theExpression->value; list2->derivedConstraints = TRUE; list2->constraints = CopyConstraintRecord(theEnv,theExpression->constraints); list1 = AddToVariableConstraints(theEnv,list2,list1); } } return(list1); } /***********************************************/ /* DeriveVariableConstraints: Derives the list */ /* of variable constraints associated with a */ /* single connected constraint. */ /***********************************************/ globle struct lhsParseNode *DeriveVariableConstraints( void *theEnv, struct lhsParseNode *theNode) { struct lhsParseNode *orNode, *andNode; struct lhsParseNode *list1, *list2, *list3 = NULL; int first = TRUE; /*===============================*/ /* Process the constraints for a */ /* single connected constraint. */ /*===============================*/ for (orNode = theNode->bottom; orNode != NULL; orNode = orNode->bottom) { /*=================================================*/ /* Intersect all of the &'ed constraints together. */ /*=================================================*/ list2 = NULL; for (andNode = orNode; andNode != NULL; andNode = andNode->right) { if ((andNode->type == RETURN_VALUE_CONSTRAINT) || (andNode->type == PREDICATE_CONSTRAINT)) { list1 = GetExpressionVarConstraints(theEnv,andNode->expression); list2 = AddToVariableConstraints(theEnv,list2,list1); } } if (first) { list3 = list2; first = FALSE; } else { list3 = UnionVariableConstraints(theEnv,list3,list2); } } return(list3); } /*******************************************/ /* CheckRHSForConstraintErrors: Checks the */ /* RHS of a rule for constraint errors. */ /*******************************************/ globle intBool CheckRHSForConstraintErrors( void *theEnv, struct expr *expressionList, struct lhsParseNode *theLHS) { struct FunctionDefinition *theFunction; int i; struct expr *lastOne = NULL, *checkList, *tmpPtr; if (expressionList == NULL) return(FALSE); for (checkList = expressionList; checkList != NULL; checkList = checkList->nextArg) { expressionList = checkList->argList; i = 1; if (checkList->type == FCALL) { lastOne = checkList; theFunction = (struct FunctionDefinition *) checkList->value; } else { theFunction = NULL; } while (expressionList != NULL) { if (CheckArgumentForConstraintError(theEnv,expressionList,lastOne,i, theFunction,theLHS)) { return(TRUE); } i++; tmpPtr = expressionList->nextArg; expressionList->nextArg = NULL; if (CheckRHSForConstraintErrors(theEnv,expressionList,theLHS)) return(TRUE); expressionList->nextArg = tmpPtr; expressionList = expressionList->nextArg; } } return(FALSE); } /*************************************************************/ /* CheckArgumentForConstraintError: Checks a single argument */ /* found in the RHS of a rule for constraint errors. */ /* Returns TRUE if an error is detected, otherwise FALSE. */ /*************************************************************/ static intBool CheckArgumentForConstraintError( void *theEnv, struct expr *expressionList, struct expr *lastOne, int i, struct FunctionDefinition *theFunction, struct lhsParseNode *theLHS) { int theRestriction; CONSTRAINT_RECORD *constraint1, *constraint2, *constraint3, *constraint4; struct lhsParseNode *theVariable; struct expr *tmpPtr; int rv = FALSE; /*=============================================================*/ /* Skip anything that isn't a variable or isn't an argument to */ /* a user defined function (i.e. deffunctions and generic have */ /* no constraint information so they aren't checked). */ /*=============================================================*/ if ((expressionList->type != SF_VARIABLE) || (theFunction == NULL)) { return (rv); } /*===========================================*/ /* Get the restrictions for the argument and */ /* convert them to a constraint record. */ /*===========================================*/ theRestriction = GetNthRestriction(theFunction,i); constraint1 = ArgumentTypeToConstraintRecord(theEnv,theRestriction); /*================================================*/ /* Look for the constraint record associated with */ /* binding the variable in the LHS of the rule. */ /*================================================*/ theVariable = FindVariable((SYMBOL_HN *) expressionList->value,theLHS); if (theVariable != NULL) { if (theVariable->type == MF_VARIABLE) { constraint2 = GetConstraintRecord(theEnv); SetConstraintType(MULTIFIELD,constraint2); } else if (theVariable->constraints == NULL) { constraint2 = GetConstraintRecord(theEnv); } else { constraint2 = CopyConstraintRecord(theEnv,theVariable->constraints); } } else { constraint2 = NULL; } /*================================================*/ /* Look for the constraint record associated with */ /* binding the variable on the RHS of the rule. */ /*================================================*/ constraint3 = FindBindConstraints(theEnv,(SYMBOL_HN *) expressionList->value); /*====================================================*/ /* Union the LHS and RHS variable binding constraints */ /* (the variable must satisfy one or the other). */ /*====================================================*/ constraint3 = UnionConstraints(theEnv,constraint3,constraint2); /*====================================================*/ /* Intersect the LHS/RHS variable binding constraints */ /* with the function argument restriction constraints */ /* (the variable must satisfy both). */ /*====================================================*/ constraint4 = IntersectConstraints(theEnv,constraint3,constraint1); /*====================================*/ /* Check for unmatchable constraints. */ /*====================================*/ if (UnmatchableConstraint(constraint4) && EnvGetStaticConstraintChecking(theEnv)) { PrintErrorID(theEnv,"RULECSTR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Previous variable bindings of ?"); EnvPrintRouter(theEnv,WERROR,ValueToString((SYMBOL_HN *) expressionList->value)); EnvPrintRouter(theEnv,WERROR," caused the type restrictions"); EnvPrintRouter(theEnv,WERROR,"\nfor argument #"); PrintLongInteger(theEnv,WERROR,(long int) i); EnvPrintRouter(theEnv,WERROR," of the expression "); tmpPtr = lastOne->nextArg; lastOne->nextArg = NULL; PrintExpression(theEnv,WERROR,lastOne); lastOne->nextArg = tmpPtr; EnvPrintRouter(theEnv,WERROR,"\nfound in the rule's RHS to be violated.\n"); rv = TRUE; } /*===========================================*/ /* Free the temporarily created constraints. */ /*===========================================*/ RemoveConstraint(theEnv,constraint1); RemoveConstraint(theEnv,constraint2); RemoveConstraint(theEnv,constraint3); RemoveConstraint(theEnv,constraint4); /*========================================*/ /* Return TRUE if unmatchable constraints */ /* were detected, otherwise FALSE. */ /*========================================*/ return(rv); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/pattern.h0000755000175000017500000001424710441150475014371 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* PATTERN HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the mechanism for recognizing and */ /* parsing the various types of patterns that can be used */ /* in the LHS of a rule. In version 6.0, the only pattern */ /* types provided are for deftemplate and instance */ /* patterns. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_pattern #define _H_pattern #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif struct patternEntityRecord { struct entityRecord base; void (*decrementBasisCount)(void *,void *); void (*incrementBasisCount)(void *,void *); void (*matchFunction)(void *,void *); intBool (*synchronized)(void *,void *); }; typedef struct patternEntityRecord PTRN_ENTITY_RECORD; typedef struct patternEntityRecord *PTRN_ENTITY_RECORD_PTR; struct patternEntity { struct patternEntityRecord *theInfo; void *dependents; unsigned busyCount; long int timeTag; }; typedef struct patternEntity PATTERN_ENTITY; typedef struct patternEntity * PATTERN_ENTITY_PTR; struct patternParser; #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #define MAXIMUM_NUMBER_OF_PATTERNS 128 struct patternParser { char *name; struct patternEntityRecord *entityType; int positionInArray; int (*recognizeFunction)(SYMBOL_HN *); struct lhsParseNode *(*parseFunction)(void *,char *,struct token *); int (*postAnalysisFunction)(void *,struct lhsParseNode *); struct patternNodeHeader *(*addPatternFunction)(void *,struct lhsParseNode *); void (*removePatternFunction)(void *,struct patternNodeHeader *); struct expr *(*genJNConstantFunction)(void *,struct lhsParseNode *); void (*replaceGetJNValueFunction)(void *,struct expr *,struct lhsParseNode *); struct expr *(*genGetJNValueFunction)(void *,struct lhsParseNode *); struct expr *(*genCompareJNValuesFunction)(void *,struct lhsParseNode *,struct lhsParseNode *); struct expr *(*genPNConstantFunction)(void *,struct lhsParseNode *); void (*replaceGetPNValueFunction)(void *,struct expr *,struct lhsParseNode *); struct expr *(*genGetPNValueFunction)(void *,struct lhsParseNode *); struct expr *(*genComparePNValuesFunction)(void *,struct lhsParseNode *,struct lhsParseNode *); void (*returnUserDataFunction)(void *,void *); void *(*copyUserDataFunction)(void *,void *); void (*markIRPatternFunction)(void *,struct patternNodeHeader *,int); void (*incrementalResetFunction)(void *); struct lhsParseNode *(*initialPatternFunction)(void *); void (*codeReferenceFunction)(void *,void *,FILE *,int,int); int priority; struct patternParser *next; }; struct reservedSymbol { char *theSymbol; char *reservedBy; struct reservedSymbol *next; }; #define MAX_POSITIONS 8 #define PATTERN_DATA 19 struct patternData { struct patternParser *ListOfPatternParsers; struct patternParser *PatternParserArray[MAX_POSITIONS]; int NextPosition; struct reservedSymbol *ListOfReservedPatternSymbols; int WithinNotCE; int GlobalSalience; int GlobalAutoFocus; struct expr *SalienceExpression; }; #define PatternData(theEnv) ((struct patternData *) GetEnvironmentData(theEnv,PATTERN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _PATTERN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializePatterns(void *); LOCALE int AddPatternParser(void *,struct patternParser *); LOCALE struct patternParser *FindPatternParser(void *,char *); LOCALE void DetachPattern(void *,int,struct patternNodeHeader *); LOCALE void GetNextPatternEntity(void *, struct patternParser **, struct patternEntity **); LOCALE struct patternParser *GetPatternParser(void *,int); LOCALE struct lhsParseNode *RestrictionParse(void *,char *,struct token *,int, struct symbolHashNode *,short, struct constraintRecord *,short); LOCALE int PostPatternAnalysis(void *,struct lhsParseNode *); LOCALE void PatternNodeHeaderToCode(void *,FILE *,struct patternNodeHeader *,int,int); LOCALE void AddReservedPatternSymbol(void *,char *,char *); LOCALE intBool ReservedPatternSymbol(void *,char *,char *); LOCALE void ReservedPatternSymbolErrorMsg(void *,char *,char *); #endif clips-6.24/clipssrc/._drive.c0000400000175000017500000000075410441162301014205 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0@g0@gTTF/B\FMPSRMWBBLclips-6.24/clipssrc/genrcexe.c0000755000175000017500000006347410441071747014521 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Function Execution Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT #if OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #include "insfun.h" #endif #include "argacces.h" #include "constrct.h" #include "envrnmnt.h" #include "genrccom.h" #include "prcdrfun.h" #include "prccode.h" #include "proflfun.h" #include "router.h" #include "utility.h" #define _GENRCEXE_SOURCE_ #include "genrcexe.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define BEGIN_TRACE ">>" #define END_TRACE "<<" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static DEFMETHOD *FindApplicableMethod(void *,DEFGENERIC *,DEFMETHOD *); #if DEBUGGING_FUNCTIONS static void WatchGeneric(void *,char *); static void WatchMethod(void *,char *); #endif #if OBJECT_SYSTEM static DEFCLASS *DetermineRestrictionClass(void *,DATA_OBJECT *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************************************** NAME : GenericDispatch DESCRIPTION : Executes the most specific applicable method INPUTS : 1) The generic function 2) The method to start after in the search for an applicable method (ignored if arg #3 is not NULL). 3) A specific method to call (NULL if want highest precedence method to be called) 4) The generic function argument expressions 5) The caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments Any side-effects of evaluating query functions on method parameter restrictions when determining the core (see warning #1) Any side-effects of actual execution of methods (see warning #2) Caller's buffer set to the result of the generic function call In case of errors, the result is FALSE, otherwise it is the result returned by the most specific method (which can choose to ignore or return the values of more general methods) NOTES : WARNING #1: Query functions on method parameter restrictions should not have side-effects, for they might be evaluated even for methods that aren't applicable to the generic function call. WARNING #2: Side-effects of method execution should not always rely on only being executed once per generic function call. Every time a method calls (shadow-call) the same next-most-specific method is executed. Thus, it is possible for a method to be executed multiple times per generic function call. ***********************************************************************************/ globle void GenericDispatch( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *prevmeth, DEFMETHOD *meth, EXPRESSION *params, DATA_OBJECT *result) { DEFGENERIC *previousGeneric; DEFMETHOD *previousMethod; int oldce; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return; oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; previousMethod = DefgenericData(theEnv)->CurrentMethod; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; gfunc->busy++; PushProcParameters(theEnv,params,CountArguments(params), EnvGetDefgenericName(theEnv,(void *) gfunc), "generic function",UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { gfunc->busy--; DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); SetExecutingConstruct(theEnv,oldce); return; } if (meth != NULL) { if (IsMethodApplicable(theEnv,meth)) { meth->busy++; DefgenericData(theEnv)->CurrentMethod = meth; } else { PrintErrorID(theEnv,"GENRCEXE",4,FALSE); SetEvaluationError(theEnv,TRUE); DefgenericData(theEnv)->CurrentMethod = NULL; EnvPrintRouter(theEnv,WERROR,"Generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," method #"); PrintLongInteger(theEnv,WERROR,(long) meth->index); EnvPrintRouter(theEnv,WERROR," is not applicable to the given arguments.\n"); } } else DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth); if (DefgenericData(theEnv)->CurrentMethod != NULL) { #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,BEGIN_TRACE); if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,BEGIN_TRACE); #endif if (DefgenericData(theEnv)->CurrentMethod->system) { EXPRESSION fcall; fcall.type = FCALL; fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value; fcall.nextArg = NULL; fcall.argList = GetProcParamExpressions(theEnv); EvaluateExpression(theEnv,&fcall,result); } else { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &DefgenericData(theEnv)->CurrentMethod->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule, DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount, result,UnboundMethodErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } DefgenericData(theEnv)->CurrentMethod->busy--; #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,END_TRACE); if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,END_TRACE); #endif } else if (! EvaluationData(theEnv)->EvaluationError) { PrintErrorID(theEnv,"GENRCEXE",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No applicable methods for "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } gfunc->busy--; ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; PropagateReturnValue(theEnv,result); PeriodicCleanup(theEnv,FALSE,TRUE); SetExecutingConstruct(theEnv,oldce); } /******************************************************* NAME : UnboundMethodErr DESCRIPTION : Print out a synopis of the currently executing method for unbound variable errors INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Error synopsis printed to WERROR NOTES : None *******************************************************/ globle void UnboundMethodErr( void *theEnv) { EnvPrintRouter(theEnv,WERROR,"generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric)); EnvPrintRouter(theEnv,WERROR," method #"); PrintLongInteger(theEnv,WERROR,(long) DefgenericData(theEnv)->CurrentMethod->index); EnvPrintRouter(theEnv,WERROR,".\n"); } /*********************************************************************** NAME : IsMethodApplicable DESCRIPTION : Tests to see if a method satsifies the arguments of a generic function A method is applicable if all its restrictions are satisfied by the corresponding arguments INPUTS : The method address RETURNS : TRUE if method is applicable, FALSE otherwise SIDE EFFECTS : Any query functions are evaluated NOTES : Uses globals ProcParamArraySize and ProcParamArray ***********************************************************************/ globle intBool IsMethodApplicable( void *theEnv, DEFMETHOD *meth) { DATA_OBJECT temp; register unsigned i,j,k; register RESTRICTION *rp; #if OBJECT_SYSTEM void *type; #else int type; #endif if ((ProceduralPrimitiveData(theEnv)->ProcParamArraySize < meth->minRestrictions) || ((ProceduralPrimitiveData(theEnv)->ProcParamArraySize > meth->minRestrictions) && (meth->maxRestrictions != -1))) return(FALSE); for (i = 0 , k = 0 ; i < (unsigned) ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { rp = &meth->restrictions[k]; if (rp->tcnt != 0) { #if OBJECT_SYSTEM type = (void *) DetermineRestrictionClass(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]); if (type == NULL) return(FALSE); for (j = 0 ; j < rp->tcnt ; j++) { if (type == rp->types[j]) break; if (HasSuperclass((DEFCLASS *) type,(DEFCLASS *) rp->types[j])) break; if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) { if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_ADDRESS) break; } else if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) { if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_NAME) break; } else if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]) { if ((ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_NAME) || (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_ADDRESS)) break; } } #else type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type; for (j = 0 ; j < rp->tcnt ; j++) { if (type == ValueToInteger(rp->types[j])) break; if (SubsumeType(type,ValueToInteger(rp->types[j]))) break; } #endif if (j == rp->tcnt) return(FALSE); } if (rp->query != NULL) { DefgenericData(theEnv)->GenericCurrentArgument = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i]; EvaluateExpression(theEnv,rp->query,&temp); if ((temp.type != SYMBOL) ? FALSE : (temp.value == EnvFalseSymbol(theEnv))) return(FALSE); } if (((int) k) != meth->restrictionCount-1) k++; } return(TRUE); } /*************************************************** NAME : NextMethodP DESCRIPTION : Determines if a shadowed generic function method is available for execution INPUTS : None RETURNS : TRUE if there is a method available, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax: (next-methodp) ***************************************************/ globle int NextMethodP( void *theEnv) { register DEFMETHOD *meth; if (DefgenericData(theEnv)->CurrentMethod == NULL) return(FALSE); meth = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod); if (meth != NULL) { meth->busy--; return(TRUE); } return(FALSE); } /**************************************************** NAME : CallNextMethod DESCRIPTION : Executes the next available method in the core for a generic function INPUTS : Caller's buffer for the result RETURNS : Nothing useful SIDE EFFECTS : Side effects of execution of shadow EvaluationError set if no method is available to execute. NOTES : H/L Syntax: (call-next-method) ****************************************************/ globle void CallNextMethod( void *theEnv, DATA_OBJECT *result) { DEFMETHOD *oldMethod; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EvaluationData(theEnv)->HaltExecution) return; oldMethod = DefgenericData(theEnv)->CurrentMethod; if (DefgenericData(theEnv)->CurrentMethod != NULL) DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod); if (DefgenericData(theEnv)->CurrentMethod == NULL) { DefgenericData(theEnv)->CurrentMethod = oldMethod; PrintErrorID(theEnv,"GENRCEXE",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n"); SetEvaluationError(theEnv,TRUE); return; } #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,BEGIN_TRACE); #endif if (DefgenericData(theEnv)->CurrentMethod->system) { EXPRESSION fcall; fcall.type = FCALL; fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value; fcall.nextArg = NULL; fcall.argList = GetProcParamExpressions(theEnv); EvaluateExpression(theEnv,&fcall,result); } else { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &DefgenericData(theEnv)->CurrentGeneric->header.usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule, DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount, result,UnboundMethodErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } DefgenericData(theEnv)->CurrentMethod->busy--; #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,END_TRACE); #endif DefgenericData(theEnv)->CurrentMethod = oldMethod; ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; } /************************************************************************** NAME : CallSpecificMethod DESCRIPTION : Allows a specific method to be called without regards to higher precedence methods which might also be applicable However, shadowed methods can still be called. INPUTS : A data object buffer to hold the method evaluation result RETURNS : Nothing useful SIDE EFFECTS : Side-effects of method applicability tests and the evaluation of methods NOTES : H/L Syntax: (call-specific-method ) **************************************************************************/ globle void CallSpecificMethod( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT temp; DEFGENERIC *gfunc; int mi; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"call-specific-method",1,SYMBOL,&temp) == FALSE) return; gfunc = CheckGenericExists(theEnv,"call-specific-method",DOToString(temp)); if (gfunc == NULL) return; if (EnvArgTypeCheck(theEnv,"call-specific-method",2,INTEGER,&temp) == FALSE) return; mi = CheckMethodExists(theEnv,"call-specific-method",gfunc,DOToInteger(temp)); if (mi == -1) return; gfunc->methods[mi].busy++; GenericDispatch(theEnv,gfunc,NULL,&gfunc->methods[mi], GetFirstArgument()->nextArg->nextArg,result); gfunc->methods[mi].busy--; } /*********************************************************************** NAME : OverrideNextMethod DESCRIPTION : Changes the arguments to shadowed methods, thus the set of applicable methods to this call may change INPUTS : A buffer to hold the result of the call RETURNS : Nothing useful SIDE EFFECTS : Any of evaluating method restrictions and bodies NOTES : H/L Syntax: (override-next-method ) ***********************************************************************/ globle void OverrideNextMethod( void *theEnv, DATA_OBJECT *result) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EvaluationData(theEnv)->HaltExecution) return; if (DefgenericData(theEnv)->CurrentMethod == NULL) { PrintErrorID(theEnv,"GENRCEXE",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n"); SetEvaluationError(theEnv,TRUE); return; } GenericDispatch(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod,NULL, GetFirstArgument(),result); } /*********************************************************** NAME : GetGenericCurrentArgument DESCRIPTION : Returns the value of the generic function argument being tested in the method applicability determination process INPUTS : A data-object buffer RETURNS : Nothing useful SIDE EFFECTS : Data-object set NOTES : Useful for queries in wildcard restrictions ***********************************************************/ globle void GetGenericCurrentArgument( void *theEnv, DATA_OBJECT *result) { result->type = DefgenericData(theEnv)->GenericCurrentArgument->type; result->value = DefgenericData(theEnv)->GenericCurrentArgument->value; result->begin = DefgenericData(theEnv)->GenericCurrentArgument->begin; result->end = DefgenericData(theEnv)->GenericCurrentArgument->end; } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************ NAME : FindApplicableMethod DESCRIPTION : Finds the first/next applicable method for a generic function call INPUTS : 1) The generic function pointer 2) The address of the current method (NULL to find the first) RETURNS : The address of the first/next applicable method (NULL on errors) SIDE EFFECTS : Any from evaluating query restrictions Methoid busy count incremented if applicable NOTES : None ************************************************************/ static DEFMETHOD *FindApplicableMethod( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth) { if (meth != NULL) meth++; else meth = gfunc->methods; for ( ; meth < &gfunc->methods[gfunc->mcnt] ; meth++) { meth->busy++; if (IsMethodApplicable(theEnv,meth)) return(meth); meth->busy--; } return(NULL); } #if DEBUGGING_FUNCTIONS /********************************************************************** NAME : WatchGeneric DESCRIPTION : Prints out a trace of the beginning or end of the execution of a generic function INPUTS : A string to indicate beginning or end of execution RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the globals CurrentGeneric, ProcParamArraySize and ProcParamArray for other trace info **********************************************************************/ static void WatchGeneric( void *theEnv, char *tstring) { EnvPrintRouter(theEnv,WTRACE,"GNC "); EnvPrintRouter(theEnv,WTRACE,tstring); EnvPrintRouter(theEnv,WTRACE," "); if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule)); EnvPrintRouter(theEnv,WTRACE,"::"); } EnvPrintRouter(theEnv,WTRACE,ValueToString((void *) DefgenericData(theEnv)->CurrentGeneric->header.name)); EnvPrintRouter(theEnv,WTRACE," "); EnvPrintRouter(theEnv,WTRACE," ED:"); PrintLongInteger(theEnv,WTRACE,(long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,WTRACE); } /********************************************************************** NAME : WatchMethod DESCRIPTION : Prints out a trace of the beginning or end of the execution of a generic function method INPUTS : A string to indicate beginning or end of execution RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Uses the globals CurrentGeneric, CurrentMethod, ProcParamArraySize and ProcParamArray for other trace info **********************************************************************/ static void WatchMethod( void *theEnv, char *tstring) { EnvPrintRouter(theEnv,WTRACE,"MTH "); EnvPrintRouter(theEnv,WTRACE,tstring); EnvPrintRouter(theEnv,WTRACE," "); if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule)); EnvPrintRouter(theEnv,WTRACE,"::"); } EnvPrintRouter(theEnv,WTRACE,ValueToString((void *) DefgenericData(theEnv)->CurrentGeneric->header.name)); EnvPrintRouter(theEnv,WTRACE,":#"); if (DefgenericData(theEnv)->CurrentMethod->system) EnvPrintRouter(theEnv,WTRACE,"SYS"); PrintLongInteger(theEnv,WTRACE,(long) DefgenericData(theEnv)->CurrentMethod->index); EnvPrintRouter(theEnv,WTRACE," "); EnvPrintRouter(theEnv,WTRACE," ED:"); PrintLongInteger(theEnv,WTRACE,(long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,WTRACE); } #endif #if OBJECT_SYSTEM /*************************************************** NAME : DetermineRestrictionClass DESCRIPTION : Finds the class of an argument in the ProcParamArray INPUTS : The argument data object RETURNS : The class address, NULL if error SIDE EFFECTS : EvaluationError set on errors NOTES : None ***************************************************/ static DEFCLASS *DetermineRestrictionClass( void *theEnv, DATA_OBJECT *dobj) { INSTANCE_TYPE *ins; DEFCLASS *cls; if (dobj->type == INSTANCE_NAME) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) dobj->value); cls = (ins != NULL) ? ins->cls : NULL; } else if (dobj->type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) dobj->value; cls = (ins->garbage == 0) ? ins->cls : NULL; } else return(DefclassData(theEnv)->PrimitiveClassMap[dobj->type]); if (cls == NULL) { SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"GENRCEXE",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to determine class of "); PrintDataObject(theEnv,WERROR,dobj); EnvPrintRouter(theEnv,WERROR," in generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric)); EnvPrintRouter(theEnv,WERROR,".\n"); } return(cls); } #endif #endif clips-6.24/clipssrc/classexm.c0000755000175000017500000012540210441602055014516 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CLASS EXAMINATION MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Class browsing and examination commands */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Modified the slot-writablep function to return */ /* FALSE for slots having initialize-only access. */ /* DR0860 */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* The slot-default-value function crashes when no */ /* default exists for a slot (the ?NONE value was */ /* specified). DR0870 */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "classini.h" #include "envrnmnt.h" #include "insfun.h" #include "memalloc.h" #include "msgcom.h" #include "msgfun.h" #include "router.h" #include "strngrtr.h" #define _CLASSEXM_SOURCE_ #include "classexm.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static int CheckTwoClasses(void *,char *,DEFCLASS **,DEFCLASS **); static SLOT_DESC *CheckSlotExists(void *,char *,DEFCLASS **,intBool,intBool); static SLOT_DESC *LookupSlot(void *,DEFCLASS *,char *,intBool); #if DEBUGGING_FUNCTIONS static DEFCLASS *CheckClass(void *,char *,char *); static char *GetClassNameArgument(void *,char *); static void PrintClassBrowse(void *,char *,DEFCLASS *,unsigned); static void DisplaySeparator(void *,char *,char *,int,int); static void DisplaySlotBasicInfo(void *,char *,char *,char *,char *,DEFCLASS *); static intBool PrintSlotSources(void *,char *,SYMBOL_HN *,PACKED_CLASS_LINKS *,unsigned,int); static void DisplaySlotConstraintInfo(void *,char *,char *,char *,unsigned,DEFCLASS *); static char *ConstraintCode(CONSTRAINT_RECORD *,unsigned,unsigned); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS /**************************************************************** NAME : BrowseClassesCommand DESCRIPTION : Displays a "graph" of the class hierarchy INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (browse-classes []) ****************************************************************/ globle void BrowseClassesCommand( void *theEnv) { register DEFCLASS *cls; if (EnvRtnArgCount(theEnv) == 0) /* ================================================ Find the OBJECT root class (has no superclasses) ================================================ */ cls = LookupDefclassByMdlOrScope(theEnv,OBJECT_TYPE_NAME); else { DATA_OBJECT tmp; if (EnvArgTypeCheck(theEnv,"browse-classes",1,SYMBOL,&tmp) == FALSE) return; cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (cls == NULL) { ClassExistError(theEnv,"browse-classes",DOToString(tmp)); return; } } EnvBrowseClasses(theEnv,WDISPLAY,(void *) cls); } /**************************************************************** NAME : EnvBrowseClasses DESCRIPTION : Displays a "graph" of the class hierarchy INPUTS : 1) The logical name of the output 2) Class pointer RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ****************************************************************/ globle void EnvBrowseClasses( void *theEnv, char *logicalName, void *clsptr) { PrintClassBrowse(theEnv,logicalName,(DEFCLASS *) clsptr,0); } /**************************************************************** NAME : DescribeClassCommand DESCRIPTION : Displays direct superclasses and subclasses and the entire precedence list for a class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (describe-class ) ****************************************************************/ globle void DescribeClassCommand( void *theEnv) { char *cname; DEFCLASS *cls; cname = GetClassNameArgument(theEnv,"describe-class"); if (cname == NULL) return; cls = CheckClass(theEnv,"describe-class",cname); if (cls == NULL) return; EnvDescribeClass(theEnv,WDISPLAY,(void *) cls); } /****************************************************** NAME : EnvDescribeClass DESCRIPTION : Displays direct superclasses and subclasses and the entire precedence list for a class INPUTS : 1) The logical name of the output 2) Class pointer RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ******************************************************/ globle void EnvDescribeClass( void *theEnv, char *logicalName, void *clsptr) { DEFCLASS *cls; char buf[83], slotNamePrintFormat[12], overrideMessagePrintFormat[12]; int messageBanner; unsigned i; size_t slotNameLength, maxSlotNameLength; size_t overrideMessageLength, maxOverrideMessageLength; cls = (DEFCLASS *) clsptr; DisplaySeparator(theEnv,logicalName,buf,82,'='); DisplaySeparator(theEnv,logicalName,buf,82,'*'); if (cls->abstract) EnvPrintRouter(theEnv,logicalName,"Abstract: direct instances of this class cannot be created.\n\n"); else { EnvPrintRouter(theEnv,logicalName,"Concrete: direct instances of this class can be created.\n"); #if DEFRULE_CONSTRUCT if (cls->reactive) EnvPrintRouter(theEnv,logicalName,"Reactive: direct instances of this class can match defrule patterns.\n\n"); else EnvPrintRouter(theEnv,logicalName,"Non-reactive: direct instances of this class cannot match defrule patterns.\n\n"); #else EnvPrintRouter(theEnv,logicalName,"\n"); #endif } PrintPackedClassLinks(theEnv,logicalName,"Direct Superclasses:",&cls->directSuperclasses); PrintPackedClassLinks(theEnv,logicalName,"Inheritance Precedence:",&cls->allSuperclasses); PrintPackedClassLinks(theEnv,logicalName,"Direct Subclasses:",&cls->directSubclasses); if (cls->instanceTemplate != NULL) { DisplaySeparator(theEnv,logicalName,buf,82,'-'); maxSlotNameLength = 5; maxOverrideMessageLength = 8; for (i = 0 ; i < cls->instanceSlotCount ; i++) { slotNameLength = strlen(ValueToString(cls->instanceTemplate[i]->slotName->name)); if (slotNameLength > maxSlotNameLength) maxSlotNameLength = slotNameLength; if (cls->instanceTemplate[i]->noWrite == 0) { overrideMessageLength = strlen(ValueToString(cls->instanceTemplate[i]->overrideMessage)); if (overrideMessageLength > maxOverrideMessageLength) maxOverrideMessageLength = overrideMessageLength; } } if (maxSlotNameLength > 16) maxSlotNameLength = 16; if (maxOverrideMessageLength > 12) maxOverrideMessageLength = 12; sprintf(slotNamePrintFormat,"%%-%ld.%lds : ",maxSlotNameLength,maxSlotNameLength); sprintf(overrideMessagePrintFormat,"%%-%ld.%lds ",maxOverrideMessageLength, maxOverrideMessageLength); DisplaySlotBasicInfo(theEnv,logicalName,slotNamePrintFormat,overrideMessagePrintFormat,buf,cls); EnvPrintRouter(theEnv,logicalName,"\nConstraint information for slots:\n\n"); DisplaySlotConstraintInfo(theEnv,logicalName,slotNamePrintFormat,buf,82,cls); } if (cls->handlerCount > 0) messageBanner = TRUE; else { messageBanner = FALSE; for (i = 1 ; i < cls->allSuperclasses.classCount ; i++) if (cls->allSuperclasses.classArray[i]->handlerCount > 0) { messageBanner = TRUE; break; } } if (messageBanner) { DisplaySeparator(theEnv,logicalName,buf,82,'-'); EnvPrintRouter(theEnv,logicalName,"Recognized message-handlers:\n"); DisplayHandlersInLinks(theEnv,logicalName,&cls->allSuperclasses,0); } DisplaySeparator(theEnv,logicalName,buf,82,'*'); DisplaySeparator(theEnv,logicalName,buf,82,'='); } #endif /********************************************************** NAME : GetCreateAccessorString DESCRIPTION : Gets a string describing which accessors are implicitly created for a slot: R, W, RW or NIL INPUTS : The slot descriptor RETURNS : The string description SIDE EFFECTS : None NOTES : Used by (describe-class) and (slot-facets) **********************************************************/ globle char *GetCreateAccessorString( void *vsd) { SLOT_DESC *sd = (SLOT_DESC *) vsd; if (sd->createReadAccessor && sd->createWriteAccessor) return("RW"); if ((sd->createReadAccessor == 0) && (sd->createWriteAccessor == 0)) return("NIL"); else return((char *) (sd->createReadAccessor ? "R" : "W")); } /************************************************************ NAME : GetDefclassModuleCommand DESCRIPTION : Determines to which module a class belongs INPUTS : None RETURNS : The symbolic name of the module SIDE EFFECTS : None NOTES : H/L Syntax: (defclass-module ) ************************************************************/ globle void *GetDefclassModuleCommand( void *theEnv) { return(GetConstructModuleCommand(theEnv,"defclass-module",DefclassData(theEnv)->DefclassConstruct)); } /********************************************************************* NAME : SuperclassPCommand DESCRIPTION : Determines if a class is a superclass of another INPUTS : None RETURNS : TRUE if class-1 is a superclass of class-2 SIDE EFFECTS : None NOTES : H/L Syntax : (superclassp ) *********************************************************************/ globle intBool SuperclassPCommand( void *theEnv) { DEFCLASS *c1,*c2; if (CheckTwoClasses(theEnv,"superclassp",&c1,&c2) == FALSE) return(FALSE); return(EnvSuperclassP(theEnv,(void *) c1,(void *) c2)); } /*************************************************** NAME : EnvSuperclassP DESCRIPTION : Determines if the first class is a superclass of the other INPUTS : 1) First class 2) Second class RETURNS : TRUE if first class is a superclass of the first, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool EnvSuperclassP( void *theEnv, void *firstClass, void *secondClass) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(HasSuperclass((DEFCLASS *) secondClass,(DEFCLASS *) firstClass)); } /********************************************************************* NAME : SubclassPCommand DESCRIPTION : Determines if a class is a subclass of another INPUTS : None RETURNS : TRUE if class-1 is a subclass of class-2 SIDE EFFECTS : None NOTES : H/L Syntax : (subclassp ) *********************************************************************/ globle intBool SubclassPCommand( void *theEnv) { DEFCLASS *c1,*c2; if (CheckTwoClasses(theEnv,"subclassp",&c1,&c2) == FALSE) return(FALSE); return(EnvSubclassP(theEnv,(void *) c1,(void *) c2)); } /*************************************************** NAME : EnvSubclassP DESCRIPTION : Determines if the first class is a subclass of the other INPUTS : 1) First class 2) Second class RETURNS : TRUE if first class is a subclass of the first, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool EnvSubclassP( void *theEnv, void *firstClass, void *secondClass) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(HasSuperclass((DEFCLASS *) firstClass,(DEFCLASS *) secondClass)); } /********************************************************************* NAME : SlotExistPCommand DESCRIPTION : Determines if a slot is present in a class INPUTS : None RETURNS : TRUE if the slot exists, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-existp [inherit]) *********************************************************************/ globle int SlotExistPCommand( void *theEnv) { DEFCLASS *cls; SLOT_DESC *sd; int inheritFlag = FALSE; DATA_OBJECT dobj; sd = CheckSlotExists(theEnv,"slot-existp",&cls,FALSE,TRUE); if (sd == NULL) return(FALSE); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"slot-existp",3,SYMBOL,&dobj) == FALSE) return(FALSE); if (strcmp(DOToString(dobj),"inherit") != 0) { ExpectedTypeError1(theEnv,"slot-existp",3,"keyword \"inherit\""); SetEvaluationError(theEnv,TRUE); return(FALSE); } inheritFlag = TRUE; } return((sd->cls == cls) ? TRUE : inheritFlag); } /*************************************************** NAME : EnvSlotExistP DESCRIPTION : Determines if a slot exists INPUTS : 1) The class 2) The slot name 3) A flag indicating if the slot can be inherited or not RETURNS : TRUE if slot exists, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotExistP( void *theEnv, void *theDefclass, char *slotName, intBool inheritFlag) { return((LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,inheritFlag) != NULL) ? TRUE : FALSE); } /************************************************************************************ NAME : MessageHandlerExistPCommand DESCRIPTION : Determines if a message-handler is present in a class INPUTS : None RETURNS : TRUE if the message header is present, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (message-handler-existp []) ************************************************************************************/ globle int MessageHandlerExistPCommand( void *theEnv) { DEFCLASS *cls; SYMBOL_HN *mname; DATA_OBJECT temp; unsigned mtype = MPRIMARY; if (EnvArgTypeCheck(theEnv,"message-handler-existp",1,SYMBOL,&temp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (cls == NULL) { ClassExistError(theEnv,"message-handler-existp",DOToString(temp)); return(FALSE); } if (EnvArgTypeCheck(theEnv,"message-handler-existp",2,SYMBOL,&temp) == FALSE) return(FALSE); mname = (SYMBOL_HN *) GetValue(temp); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"message-handler-existp",3,SYMBOL,&temp) == FALSE) return(FALSE); mtype = HandlerType(theEnv,"message-handler-existp",DOToString(temp)); if (mtype == MERROR) { SetEvaluationError(theEnv,TRUE); return(FALSE); } } if (FindHandlerByAddress(cls,mname,mtype) != NULL) return(TRUE); return(FALSE); } /********************************************************************** NAME : SlotWritablePCommand DESCRIPTION : Determines if an existing slot can be written to INPUTS : None RETURNS : TRUE if the slot is writable, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-writablep ) **********************************************************************/ globle intBool SlotWritablePCommand( void *theEnv) { DEFCLASS *theDefclass; SLOT_DESC *sd; sd = CheckSlotExists(theEnv,"slot-writablep",&theDefclass,TRUE,TRUE); if (sd == NULL) return(FALSE); return((sd->noWrite || sd->initializeOnly) ? FALSE : TRUE); } /*************************************************** NAME : EnvSlotWritableP DESCRIPTION : Determines if a slot is writable INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is writable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotWritableP( void *theEnv, void *theDefclass, char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL) return(FALSE); return((sd->noWrite || sd->initializeOnly) ? FALSE : TRUE); } /********************************************************************** NAME : SlotInitablePCommand DESCRIPTION : Determines if an existing slot can be initialized via an init message-handler or slot-override INPUTS : None RETURNS : TRUE if the slot is writable, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-initablep ) **********************************************************************/ globle intBool SlotInitablePCommand( void *theEnv) { DEFCLASS *theDefclass; SLOT_DESC *sd; sd = CheckSlotExists(theEnv,"slot-initablep",&theDefclass,TRUE,TRUE); if (sd == NULL) return(FALSE); return((sd->noWrite && (sd->initializeOnly == 0)) ? FALSE : TRUE); } /*************************************************** NAME : EnvSlotInitableP DESCRIPTION : Determines if a slot is initable INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is initable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotInitableP( void *theEnv, void *theDefclass, char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL) return(FALSE); return((sd->noWrite && (sd->initializeOnly == 0)) ? FALSE : TRUE); } /********************************************************************** NAME : SlotPublicPCommand DESCRIPTION : Determines if an existing slot is publicly visible for direct reference by subclasses INPUTS : None RETURNS : TRUE if the slot is public, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-publicp ) **********************************************************************/ globle intBool SlotPublicPCommand( void *theEnv) { DEFCLASS *theDefclass; SLOT_DESC *sd; sd = CheckSlotExists(theEnv,"slot-publicp",&theDefclass,TRUE,FALSE); if (sd == NULL) return(FALSE); return(sd->publicVisibility ? TRUE : FALSE); } /*************************************************** NAME : EnvSlotPublicP DESCRIPTION : Determines if a slot is public INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is public, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotPublicP( void *theEnv, void *theDefclass, char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,FALSE)) == NULL) return(FALSE); return(sd->publicVisibility ? TRUE : FALSE); } /********************************************************************** NAME : SlotDirectAccessPCommand DESCRIPTION : Determines if an existing slot can be directly referenced by the class - i.e., if the slot is private, is the slot defined in the class INPUTS : None RETURNS : TRUE if the slot is private, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-direct-accessp ) **********************************************************************/ globle intBool SlotDirectAccessPCommand( void *theEnv) { DEFCLASS *theDefclass; SLOT_DESC *sd; sd = CheckSlotExists(theEnv,"slot-direct-accessp",&theDefclass,TRUE,TRUE); if (sd == NULL) return(FALSE); return((sd->publicVisibility || (sd->cls == theDefclass)) ? TRUE : FALSE); } /*************************************************** NAME : EnvSlotDirectAccessP DESCRIPTION : Determines if a slot is directly accessible from message-handlers on class INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot is directly accessible, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvSlotDirectAccessP( void *theEnv, void *theDefclass, char *slotName) { SLOT_DESC *sd; if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL) return(FALSE); return((sd->publicVisibility || (sd->cls == (DEFCLASS *) theDefclass)) ? TRUE : FALSE); } /********************************************************************** NAME : SlotDefaultValueCommand DESCRIPTION : Determines the default avlue for the specified slot of the specified class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (slot-default-value ) **********************************************************************/ globle void SlotDefaultValueCommand( void *theEnv, DATA_OBJECT_PTR theValue) { DEFCLASS *theDefclass; SLOT_DESC *sd; SetpType(theValue,SYMBOL); SetpValue(theValue,EnvFalseSymbol(theEnv)); sd = CheckSlotExists(theEnv,"slot-default-value",&theDefclass,TRUE,TRUE); if (sd == NULL) return; if (sd->noDefault) { SetpType(theValue,SYMBOL); SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE")); return; } if (sd->dynamicDefault) EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple, (EXPRESSION *) sd->defaultValue, theValue,TRUE); else GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue); } /********************************************************* NAME : SlotDefaultValue DESCRIPTION : Determines the default value for the specified slot of the specified class INPUTS : 1) The class 2) The slot name RETURNS : TRUE if slot default value is set, FALSE otherwise SIDE EFFECTS : Slot default value evaluated - dynamic defaults will cause any side effects NOTES : None *********************************************************/ globle intBool EnvSlotDefaultValue( void *theEnv, void *theDefclass, char *slotName, DATA_OBJECT_PTR theValue) { SLOT_DESC *sd; SetpType(theValue,SYMBOL); SetpValue(theValue,EnvFalseSymbol(theEnv)); if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL) return(FALSE); if (sd->noDefault) { SetpType(theValue,SYMBOL); SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE")); return(TRUE); } if (sd->dynamicDefault) return(EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple, (EXPRESSION *) sd->defaultValue, theValue,TRUE)); GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue); return(TRUE); } /******************************************************** NAME : ClassExistPCommand DESCRIPTION : Determines if a class exists INPUTS : None RETURNS : TRUE if class exists, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (class-existp ) ********************************************************/ globle intBool ClassExistPCommand( void *theEnv) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,"class-existp",1,SYMBOL,&temp) == FALSE) return(FALSE); return((LookupDefclassByMdlOrScope(theEnv,DOToString(temp)) != NULL) ? TRUE : FALSE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /****************************************************** NAME : CheckTwoClasses DESCRIPTION : Checks for exactly two class arguments for a H/L function INPUTS : 1) The function name 2) Caller's buffer for first class 3) Caller's buffer for second class RETURNS : TRUE if both found, FALSE otherwise SIDE EFFECTS : Caller's buffers set NOTES : Assumes exactly 2 arguments ******************************************************/ static int CheckTwoClasses( void *theEnv, char *func, DEFCLASS **c1, DEFCLASS **c2) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE) return(FALSE); *c1 = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*c1 == NULL) { ClassExistError(theEnv,func,ValueToString(temp.value)); return(FALSE); } if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE) return(FALSE); *c2 = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*c2 == NULL) { ClassExistError(theEnv,func,ValueToString(temp.value)); return(FALSE); } return(TRUE); } /*************************************************** NAME : CheckSlotExists DESCRIPTION : Checks first two arguments of a function for a valid class and (inherited) slot INPUTS : 1) The name of the function 2) A buffer to hold the found class 3) A flag indicating whether the non-existence of the slot should be an error 4) A flag indicating if the slot can be inherited or not RETURNS : NULL if slot not found, slot descriptor otherwise SIDE EFFECTS : Class buffer set if no errors, NULL on errors NOTES : None ***************************************************/ static SLOT_DESC *CheckSlotExists( void *theEnv, char *func, DEFCLASS **classBuffer, intBool existsErrorFlag, intBool inheritFlag) { SYMBOL_HN *ssym; int slotIndex; SLOT_DESC *sd; ssym = CheckClassAndSlot(theEnv,func,classBuffer); if (ssym == NULL) return(NULL); slotIndex = FindInstanceTemplateSlot(theEnv,*classBuffer,ssym); if (slotIndex == -1) { if (existsErrorFlag) { SlotExistError(theEnv,ValueToString(ssym),func); SetEvaluationError(theEnv,TRUE); } return(NULL); } sd = (*classBuffer)->instanceTemplate[slotIndex]; if ((sd->cls == *classBuffer) || inheritFlag) return(sd); PrintErrorID(theEnv,"CLASSEXM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Inherited slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(ssym)); EnvPrintRouter(theEnv,WERROR," from class "); PrintClassName(theEnv,WERROR,sd->cls,FALSE); EnvPrintRouter(theEnv,WERROR," is not valid for function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,"\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } /*************************************************** NAME : LookupSlot DESCRIPTION : Finds a slot in a class INPUTS : 1) The class 2) The slot name 3) A flag indicating if inherited slots are OK or not RETURNS : The slot descriptor address, or NULL if not found SIDE EFFECTS : None NOTES : None ***************************************************/ static SLOT_DESC *LookupSlot( void *theEnv, DEFCLASS *theDefclass, char *slotName, intBool inheritFlag) { SYMBOL_HN *slotSymbol; int slotIndex; SLOT_DESC *sd; slotSymbol = FindSymbolHN(theEnv,slotName); if (slotSymbol == NULL) return(NULL); slotIndex = FindInstanceTemplateSlot(theEnv,theDefclass,slotSymbol); if (slotIndex == -1) return(NULL); sd = theDefclass->instanceTemplate[slotIndex]; if ((sd->cls != theDefclass) && (inheritFlag == FALSE)) return(NULL); return(sd); } #if DEBUGGING_FUNCTIONS /***************************************************** NAME : CheckClass DESCRIPTION : Used for to check class name for class accessor functions such as ppdefclass and undefclass INPUTS : 1) The name of the H/L function 2) Name of the class RETURNS : The class address, or NULL if ther was an error SIDE EFFECTS : None NOTES : None ******************************************************/ static DEFCLASS *CheckClass( void *theEnv, char *func, char *cname) { DEFCLASS *cls; cls = LookupDefclassByMdlOrScope(theEnv,cname); if (cls == NULL) ClassExistError(theEnv,func,cname); return(cls); } /********************************************************* NAME : GetClassNameArgument DESCRIPTION : Gets a class name-string INPUTS : Calling function name RETURNS : Class name (NULL on errors) SIDE EFFECTS : None NOTES : Assumes only 1 argument *********************************************************/ static char *GetClassNameArgument( void *theEnv, char *fname) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,fname,1,SYMBOL,&temp) == FALSE) return(NULL); return(DOToString(temp)); } /**************************************************************** NAME : PrintClassBrowse DESCRIPTION : Displays a "graph" of class and subclasses INPUTS : 1) The logical name of the output 2) The class address 3) The depth of the graph RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ****************************************************************/ static void PrintClassBrowse( void *theEnv, char *logicalName, DEFCLASS *cls, unsigned depth) { register unsigned i; for (i = 0 ; i < depth ; i++) EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,EnvGetDefclassName(theEnv,(void *) cls)); if (cls->directSuperclasses.classCount > 1) EnvPrintRouter(theEnv,logicalName," *"); EnvPrintRouter(theEnv,logicalName,"\n"); for (i = 0 ;i < cls->directSubclasses.classCount ; i++) PrintClassBrowse(theEnv,logicalName,cls->directSubclasses.classArray[i],depth+1); } /********************************************************* NAME : DisplaySeparator DESCRIPTION : Prints a separator line for DescribeClass INPUTS : 1) The logical name of the output 2) The buffer to use for the line 3) The buffer size 4) The character to use RETURNS : Nothing useful SIDE EFFECTS : Buffer overwritten and displayed NOTES : None *********************************************************/ static void DisplaySeparator( void *theEnv, char *logicalName, char *buf, int maxlen, int sepchar) { register int i; for (i = 0 ; i < maxlen-2 ; i++) buf[i] = (char) sepchar; buf[i++] = '\n'; buf[i] = '\0'; EnvPrintRouter(theEnv,logicalName,buf); } /************************************************************* NAME : DisplaySlotBasicInfo DESCRIPTION : Displays a table summary of basic facets for the slots of a class including: single/multiple default/no-default/default-dynamic inherit/no-inherit read-write/initialize-only/read-only local/shared composite/exclusive reactive/non-reactive public/private create-accessor read/write override-message The function also displays the source class(es) for the facets INPUTS : 1) The logical name of the output 2) A format string for use in sprintf (for printing slot names) 3) A format string for use in sprintf (for printing slot override message names) 4) A buffer to store the display in 5) A pointer to the class RETURNS : Nothing useful SIDE EFFECTS : Buffer written to and displayed NOTES : None *************************************************************/ static void DisplaySlotBasicInfo( void *theEnv, char *logicalName, char *slotNamePrintFormat, char *overrideMessagePrintFormat, char *buf, DEFCLASS *cls) { register unsigned i; SLOT_DESC *sp; char *createString; sprintf(buf,slotNamePrintFormat,"SLOTS"); #if DEFRULE_CONSTRUCT strcat(buf,"FLD DEF PRP ACC STO MCH SRC VIS CRT "); #else strcat(buf,"FLD DEF PRP ACC STO SRC VIS CRT "); #endif EnvPrintRouter(theEnv,logicalName,buf); sprintf(buf,overrideMessagePrintFormat,"OVRD-MSG"); EnvPrintRouter(theEnv,logicalName,buf); EnvPrintRouter(theEnv,logicalName,"SOURCE(S)\n"); for (i = 0 ; i < cls->instanceSlotCount ; i++) { sp = cls->instanceTemplate[i]; sprintf(buf,slotNamePrintFormat,ValueToString(sp->slotName->name)); strcat(buf,sp->multiple ? "MLT " : "SGL "); if (sp->noDefault) strcat(buf,"NIL "); else strcat(buf,sp->dynamicDefault ? "DYN " : "STC "); strcat(buf,sp->noInherit ? "NIL " : "INH "); if (sp->initializeOnly) strcat(buf,"INT "); else if (sp->noWrite) strcat(buf," R "); else strcat(buf,"RW "); strcat(buf,sp->shared ? "SHR " : "LCL "); #if DEFRULE_CONSTRUCT strcat(buf,sp->reactive ? "RCT " : "NIL "); #endif strcat(buf,sp->composite ? "CMP " : "EXC "); strcat(buf,sp->publicVisibility ? "PUB " : "PRV "); createString = GetCreateAccessorString(sp); if (createString[1] == '\0') strcat(buf," "); strcat(buf,createString); if ((createString[1] == '\0') ? TRUE : (createString[2] == '\0')) strcat(buf," "); strcat(buf," "); EnvPrintRouter(theEnv,logicalName,buf); sprintf(buf,overrideMessagePrintFormat, sp->noWrite ? "NIL" : ValueToString(sp->overrideMessage)); EnvPrintRouter(theEnv,logicalName,buf); PrintSlotSources(theEnv,logicalName,sp->slotName->name,&sp->cls->allSuperclasses,0,TRUE); EnvPrintRouter(theEnv,logicalName,"\n"); } } /*************************************************** NAME : PrintSlotSources DESCRIPTION : Displays a list of source classes for a composite class (in order of most general to specific) INPUTS : 1) The logical name of the output 2) The name of the slot 3) The precedence list of the class of the slot (the source class shold be first in the list) 4) The index into the packed links array 5) Flag indicating whether to disregard noniherit facet RETURNS : TRUE if a class is printed, FALSE otherwise SIDE EFFECTS : Recursively prints out appropriate memebers from list in reverse order NOTES : None ***************************************************/ static intBool PrintSlotSources( void *theEnv, char *logicalName, SYMBOL_HN *sname, PACKED_CLASS_LINKS *sprec, unsigned theIndex, int inhp) { SLOT_DESC *csp; if (theIndex == sprec->classCount) return(FALSE); csp = FindClassSlot(sprec->classArray[theIndex],sname); if ((csp != NULL) ? ((csp->noInherit == 0) || inhp) : FALSE) { if (csp->composite) { if (PrintSlotSources(theEnv,logicalName,sname,sprec,theIndex+1,FALSE)) EnvPrintRouter(theEnv,logicalName," "); } PrintClassName(theEnv,logicalName,sprec->classArray[theIndex],FALSE); return(TRUE); } else return(PrintSlotSources(theEnv,logicalName,sname,sprec,theIndex+1,FALSE)); } /********************************************************* NAME : DisplaySlotConstraintInfo DESCRIPTION : Displays a table summary of type-checking facets for the slots of a class including: type allowed-symbols allowed-integers allowed-floats allowed-values allowed-instance-names range min-number-of-elements max-number-of-elements The function also displays the source class(es) for the facets INPUTS : 1) A format string for use in sprintf 2) A buffer to store the display in 3) Maximum buffer size 4) A pointer to the class RETURNS : Nothing useful SIDE EFFECTS : Buffer written to and displayed NOTES : None *********************************************************/ static void DisplaySlotConstraintInfo( void *theEnv, char *logicalName, char *slotNamePrintFormat, char *buf, unsigned maxlen, DEFCLASS *cls) { register unsigned i; CONSTRAINT_RECORD *cr; char *strdest = "***describe-class***"; sprintf(buf,slotNamePrintFormat,"SLOTS"); strcat(buf,"SYM STR INN INA EXA FTA INT FLT\n"); EnvPrintRouter(theEnv,logicalName,buf); for (i = 0 ; i < cls->instanceSlotCount ; i++) { cr = cls->instanceTemplate[i]->constraint; sprintf(buf,slotNamePrintFormat,ValueToString(cls->instanceTemplate[i]->slotName->name)); if (cr != NULL) { strcat(buf,ConstraintCode(cr,(unsigned) cr->symbolsAllowed, (unsigned) cr->symbolRestriction)); strcat(buf,ConstraintCode(cr,(unsigned) cr->stringsAllowed, (unsigned) cr->stringRestriction)); strcat(buf,ConstraintCode(cr,(unsigned) cr->instanceNamesAllowed, (unsigned) (cr->instanceNameRestriction || cr->classRestriction))); strcat(buf,ConstraintCode(cr,(unsigned) cr->instanceAddressesAllowed, (unsigned) cr->classRestriction)); strcat(buf,ConstraintCode(cr,(unsigned) cr->externalAddressesAllowed,0)); strcat(buf,ConstraintCode(cr,(unsigned) cr->factAddressesAllowed,0)); strcat(buf,ConstraintCode(cr,(unsigned) cr->integersAllowed, (unsigned) cr->integerRestriction)); strcat(buf,ConstraintCode(cr,(unsigned) cr->floatsAllowed, (unsigned) cr->floatRestriction)); OpenStringDestination(theEnv,strdest,buf + strlen(buf),(maxlen - strlen(buf) - 1)); if (cr->integersAllowed || cr->floatsAllowed || cr->anyAllowed) { EnvPrintRouter(theEnv,strdest,"RNG:["); PrintExpression(theEnv,strdest,cr->minValue); EnvPrintRouter(theEnv,strdest,".."); PrintExpression(theEnv,strdest,cr->maxValue); EnvPrintRouter(theEnv,strdest,"] "); } if (cls->instanceTemplate[i]->multiple) { EnvPrintRouter(theEnv,strdest,"CRD:["); PrintExpression(theEnv,strdest,cr->minFields); EnvPrintRouter(theEnv,strdest,".."); PrintExpression(theEnv,strdest,cr->maxFields); EnvPrintRouter(theEnv,strdest,"]"); } } else { OpenStringDestination(theEnv,strdest,buf,maxlen); EnvPrintRouter(theEnv,strdest," + + + + + + + + RNG:[-oo..+oo]"); if (cls->instanceTemplate[i]->multiple) EnvPrintRouter(theEnv,strdest," CRD:[0..+oo]"); } EnvPrintRouter(theEnv,strdest,"\n"); CloseStringDestination(theEnv,strdest); EnvPrintRouter(theEnv,logicalName,buf); } } /****************************************************** NAME : ConstraintCode DESCRIPTION : Gives a string code representing the type of constraint INPUTS : 1) The constraint record 2) Allowed Flag 3) Restricted Values flag RETURNS : " " for type not allowed " + " for any value of type allowed " # " for some values of type allowed SIDE EFFECTS : None NOTES : Used by DisplaySlotConstraintInfo ******************************************************/ static char *ConstraintCode( CONSTRAINT_RECORD *cr, unsigned allow, unsigned restrictValues) { if (allow || cr->anyAllowed) return((char *) ((restrictValues || cr->anyRestriction) ? " # " : " + ")); return(" "); } #endif #endif clips-6.24/clipssrc/rulepsr.c0000755000175000017500000007760710441073232014407 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* RULE PARSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses a defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* and LOGICAL_DEPENDENCIES compilation flags. */ /* */ /*************************************************************/ #define _RULEPSR_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "analysis.h" #include "constant.h" #include "constrct.h" #include "cstrcpsr.h" #include "cstrnchk.h" #include "cstrnops.h" #include "engine.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "incrrset.h" #include "memalloc.h" #include "pattern.h" #include "prccode.h" #include "prcdrpsr.h" #include "router.h" #include "rulebld.h" #include "rulebsc.h" #include "rulecstr.h" #include "ruledef.h" #include "ruledlt.h" #include "rulelhs.h" #include "scanner.h" #include "symbol.h" #include "watch.h" #include "lgcldpnd.h" #if DEFTEMPLATE_CONSTRUCT #include "tmpltfun.h" #endif #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "rulepsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct expr *ParseRuleRHS(void *,char *); static int ReplaceRHSVariable(void *,struct expr *,void *); static struct defrule *ProcessRuleLHS(void *,struct lhsParseNode *,struct expr *,SYMBOL_HN *,short *); static struct defrule *CreateNewDisjunct(void *,SYMBOL_HN *,int,struct expr *, int,unsigned,struct joinNode *); static int RuleComplexity(void *,struct lhsParseNode *); static int ExpressionComplexity(void *,struct expr *); static int LogicalAnalysis(void *,struct lhsParseNode *); static void AddToDefruleList(struct defrule *); #endif /****************************************************/ /* ParseDefrule: Coordinates all actions necessary */ /* for the parsing and creation of a defrule into */ /* the current environment. */ /****************************************************/ globle int ParseDefrule( void *theEnv, char *readSource) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,readSource) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) SYMBOL_HN *ruleName; struct lhsParseNode *theLHS; struct expr *actions; struct token theToken; struct defrule *topDisjunct, *tempPtr; struct defruleModule *theModuleItem; short error; /*================================================*/ /* Flush the buffer which stores the pretty print */ /* representation for a rule. Add the already */ /* parsed keyword defrule to this buffer. */ /*================================================*/ SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SavePPBuffer(theEnv,"(defrule "); /*=========================================================*/ /* Rules 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,"defrule"); return(TRUE); } #endif /*================================================*/ /* Parse the name and comment fields of the rule, */ /* deleting the rule if it already exists. */ /*================================================*/ #if DEBUGGING_FUNCTIONS DefruleData(theEnv)->DeletedRuleDebugFlags = 0; #endif ruleName = GetConstructNameAndComment(theEnv,readSource,&theToken,"defrule", EnvFindDefrule,EnvUndefrule,"*",FALSE, TRUE,TRUE); if (ruleName == NULL) return(TRUE); /*============================*/ /* Parse the LHS of the rule. */ /*============================*/ theLHS = ParseRuleLHS(theEnv,readSource,&theToken,ValueToString(ruleName)); if (theLHS == NULL) { ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; return(TRUE); } /*============================*/ /* Parse the RHS of the rule. */ /*============================*/ ClearParsedBindNames(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseRuleRHS(theEnv,readSource); if (actions == NULL) { ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; ReturnLHSParseNodes(theEnv,theLHS); return(TRUE); } /*=======================*/ /* Process the rule LHS. */ /*=======================*/ topDisjunct = ProcessRuleLHS(theEnv,theLHS,actions,ruleName,&error); ReturnExpression(theEnv,actions); ClearParsedBindNames(theEnv); ReturnLHSParseNodes(theEnv,theLHS); if (error) { ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; return(TRUE); } /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed defrule to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; return(FALSE); } PatternData(theEnv)->SalienceExpression = NULL; /*======================================*/ /* Save the nice printout of the rules. */ /*======================================*/ SavePPBuffer(theEnv,"\n"); if (EnvGetConserveMemory(theEnv) == TRUE) { topDisjunct->header.ppForm = NULL; } else { topDisjunct->header.ppForm = CopyPPBuffer(theEnv); } /*=======================================*/ /* Store a pointer to the rule's module. */ /*=======================================*/ theModuleItem = (struct defruleModule *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex); for (tempPtr = topDisjunct; tempPtr != NULL; tempPtr = tempPtr->disjunct) { tempPtr->header.whichModule = (struct defmoduleItemHeader *) theModuleItem; } /*===============================================*/ /* Rule completely parsed. Add to list of rules. */ /*===============================================*/ AddToDefruleList(topDisjunct); /*========================================================================*/ /* If a rule is redefined, then we want to restore its breakpoint status. */ /*========================================================================*/ #if DEBUGGING_FUNCTIONS if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,0)) { EnvSetBreak(theEnv,topDisjunct); } if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,1) || EnvGetWatchItem(theEnv,"activations")) { EnvSetDefruleWatchActivations(theEnv,ON,(void *) topDisjunct); } if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,2) || EnvGetWatchItem(theEnv,"rules")) { EnvSetDefruleWatchFirings(theEnv,ON,(void *) topDisjunct); } #endif /*================================*/ /* Perform the incremental reset. */ /*================================*/ IncrementalReset(theEnv,topDisjunct); /*=============================================*/ /* Return FALSE to indicate no errors occured. */ /*=============================================*/ #endif return(FALSE); } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************************************/ /* ProcessRuleLHS: Processes each of the disjuncts of a rule. */ /**************************************************************/ static struct defrule *ProcessRuleLHS( void *theEnv, struct lhsParseNode *theLHS, struct expr *actions, SYMBOL_HN *ruleName, short *error) { struct lhsParseNode *tempNode = NULL; struct defrule *topDisjunct = NULL, *currentDisjunct, *lastDisjunct = NULL; struct expr *newActions, *packPtr; int logicalJoin; int localVarCnt; int complexity; struct joinNode *lastJoin; /*================================================*/ /* Initially set the parsing error flag to FALSE. */ /*================================================*/ *error = FALSE; /*===========================================================*/ /* The top level of the construct representing the LHS of a */ /* rule is assumed to be an OR. If the implied OR is at the */ /* top level of the pattern construct, then remove it. */ /*===========================================================*/ if (theLHS->type == OR_CE) theLHS = theLHS->right; /*=========================================*/ /* Loop through each disjunct of the rule. */ /*=========================================*/ localVarCnt = CountParsedBindNames(theEnv); for (; theLHS != NULL; theLHS = theLHS->bottom) { /*===================================*/ /* Analyze the LHS of this disjunct. */ /*===================================*/ if (theLHS->type == AND_CE) tempNode = theLHS->right; else if (theLHS->type == PATTERN_CE) tempNode = theLHS; if (VariableAnalysis(theEnv,tempNode)) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); return(NULL); } /*=========================================*/ /* Perform entity dependent post analysis. */ /*=========================================*/ if (PostPatternAnalysis(theEnv,tempNode)) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); return(NULL); } /*========================================================*/ /* Print out developer information if it's being watched. */ /*========================================================*/ #if DEVELOPER && DEBUGGING_FUNCTIONS /* if (EnvGetWatchItem(theEnv,"rule-analysis")) { struct lhsParseNode *traceNode; char buffer[20]; EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (traceNode = tempNode; traceNode != NULL; traceNode = traceNode->bottom) { if (traceNode->userCE) { sprintf(buffer,"CE %2d: ",traceNode->whichCE); EnvPrintRouter(theEnv,WDISPLAY,buffer); PrintExpression(theEnv,WDISPLAY,traceNode->networkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } } */ #endif /*========================================*/ /* Check to see that logical CEs are used */ /* appropriately in the LHS of the rule. */ /*========================================*/ if ((logicalJoin = LogicalAnalysis(theEnv,tempNode)) < 0) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); return(NULL); } /*======================================================*/ /* Check to see if there are any RHS constraint errors. */ /*======================================================*/ if (CheckRHSForConstraintErrors(theEnv,actions,tempNode)) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); return(NULL); } /*=================================================*/ /* Replace variable references in the RHS with the */ /* appropriate variable retrieval functions. */ /*=================================================*/ newActions = CopyExpression(theEnv,actions); if (ReplaceProcVars(theEnv,"RHS of defrule",newActions,NULL,NULL, ReplaceRHSVariable,(void *) tempNode)) { *error = TRUE; ReturnDefrule(theEnv,topDisjunct); ReturnExpression(theEnv,newActions); return(NULL); } /*==================================*/ /* We're finished for this disjunct */ /* if we're only checking syntax. */ /*==================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,newActions); continue; } /*=================================*/ /* Install the disjunct's actions. */ /*=================================*/ ExpressionInstall(theEnv,newActions); packPtr = PackExpression(theEnv,newActions); ReturnExpression(theEnv,newActions); /*===============================================================*/ /* Create the pattern and join data structures for the new rule. */ /*===============================================================*/ lastJoin = ConstructJoins(theEnv,logicalJoin,tempNode); /*===================================================================*/ /* Determine the rule's complexity for use with conflict resolution. */ /*===================================================================*/ complexity = RuleComplexity(theEnv,tempNode); /*=====================================================*/ /* Create the defrule data structure for this disjunct */ /* and put it in the list of disjuncts for this rule. */ /*=====================================================*/ currentDisjunct = CreateNewDisjunct(theEnv,ruleName,localVarCnt,packPtr,complexity, (unsigned) logicalJoin,lastJoin); /*============================================================*/ /* Place the disjunct in the list of disjuncts for this rule. */ /* If the disjunct is the first disjunct, then increment the */ /* reference counts for the dynamic salience (the expression */ /* for the dynamic salience is only stored with the first */ /* disjuncts and the other disjuncts refer back to the first */ /* disjunct for their dynamic salience value. */ /*============================================================*/ if (topDisjunct == NULL) { topDisjunct = currentDisjunct; ExpressionInstall(theEnv,topDisjunct->dynamicSalience); } else lastDisjunct->disjunct = currentDisjunct; /*===========================================*/ /* Move on to the next disjunct of the rule. */ /*===========================================*/ lastDisjunct = currentDisjunct; } return(topDisjunct); } /************************************************************************/ /* CreateNewDisjunct: Creates and initializes a defrule data structure. */ /************************************************************************/ static struct defrule *CreateNewDisjunct( void *theEnv, SYMBOL_HN *ruleName, int localVarCnt, struct expr *theActions, int complexity, unsigned logicalJoin, struct joinNode *lastJoin) { struct joinNode *tempJoin; struct defrule *newDisjunct; /*===================================================*/ /* Create and initialize the defrule data structure. */ /*===================================================*/ newDisjunct = get_struct(theEnv,defrule); newDisjunct->header.ppForm = NULL; newDisjunct->header.next = NULL; newDisjunct->header.usrData = NULL; newDisjunct->logicalJoin = NULL; newDisjunct->disjunct = NULL; newDisjunct->header.name = ruleName; IncrementSymbolCount(newDisjunct->header.name); newDisjunct->actions = theActions; newDisjunct->salience = PatternData(theEnv)->GlobalSalience; newDisjunct->afterBreakpoint = 0; newDisjunct->watchActivation = 0; newDisjunct->watchFiring = 0; newDisjunct->executing = 0; newDisjunct->complexity = complexity; newDisjunct->autoFocus = PatternData(theEnv)->GlobalAutoFocus; newDisjunct->dynamicSalience = PatternData(theEnv)->SalienceExpression; newDisjunct->localVarCnt = localVarCnt; /*=====================================*/ /* Add a pointer to the rule's module. */ /*=====================================*/ newDisjunct->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex); /*============================================================*/ /* Attach the rule's last join to the defrule data structure. */ /*============================================================*/ lastJoin->ruleToActivate = newDisjunct; newDisjunct->lastJoin = lastJoin; /*=================================================*/ /* Determine the rule's logical join if it exists. */ /*=================================================*/ tempJoin = lastJoin; while (tempJoin != NULL) { if (tempJoin->depth == logicalJoin) { newDisjunct->logicalJoin = tempJoin; tempJoin->logicalJoin = TRUE; } tempJoin = tempJoin->lastLevel; } /*==================================================*/ /* Return the newly created defrule data structure. */ /*==================================================*/ return(newDisjunct); } /****************************************************************/ /* ReplaceExpressionVariables: Replaces all symbolic references */ /* to variables (local and global) found in an expression on */ /* the RHS of a rule with expressions containing function */ /* calls to retrieve the variable's value. Makes the final */ /* modifications necessary for handling the modify and */ /* duplicate commands. */ /****************************************************************/ static int ReplaceRHSVariable( void *theEnv, struct expr *list, void *VtheLHS) { struct lhsParseNode *theVariable; /*=======================================*/ /* Handle modify and duplicate commands. */ /*=======================================*/ #if DEFTEMPLATE_CONSTRUCT if (list->type == FCALL) { if (list->value == (void *) FindFunction(theEnv,"modify")) { if (UpdateModifyDuplicate(theEnv,list,"modify",VtheLHS) == FALSE) return(-1); } else if (list->value == (void *) FindFunction(theEnv,"duplicate")) { if (UpdateModifyDuplicate(theEnv,list,"duplicate",VtheLHS) == FALSE) return(-1); } return(0); } #endif if ((list->type != SF_VARIABLE) && (list->type != MF_VARIABLE)) { return(FALSE); } /*===============================================================*/ /* Check to see if the variable is bound on the LHS of the rule. */ /*===============================================================*/ theVariable = FindVariable((SYMBOL_HN *) list->value,(struct lhsParseNode *) VtheLHS); if (theVariable == NULL) return(FALSE); /*================================================*/ /* Replace the variable reference with a function */ /* call to retrieve the variable. */ /*================================================*/ if (theVariable->patternType != NULL) { (*theVariable->patternType->replaceGetJNValueFunction)(theEnv,list,theVariable); } else { return(FALSE); } /*=================================================================*/ /* Return TRUE to indicate the variable was successfully replaced. */ /*=================================================================*/ return(TRUE); } /*******************************************************/ /* ParseRuleRHS: Coordinates all the actions necessary */ /* for parsing the RHS of a rule. */ /*******************************************************/ static struct expr *ParseRuleRHS( void *theEnv, char *readSource) { struct expr *actions; struct token theToken; /*=========================================================*/ /* Process the actions on the right hand side of the rule. */ /*=========================================================*/ SavePPBuffer(theEnv,"\n "); SetIndentDepth(theEnv,3); actions = GroupActions(theEnv,readSource,&theToken,TRUE,NULL,FALSE); if (actions == NULL) return(NULL); /*=============================*/ /* Reformat the closing token. */ /*=============================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); /*======================================================*/ /* Check for the closing right parenthesis of the rule. */ /*======================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"defrule"); ReturnExpression(theEnv,actions); return(NULL); } /*========================*/ /* Return the rule's RHS. */ /*========================*/ return(actions); } /************************************************************/ /* RuleComplexity: Returns the complexity of a rule for use */ /* by the LEX and MEA conflict resolution strategies. */ /************************************************************/ static int RuleComplexity( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *thePattern, *tempPattern; int complexity = 0; while (theLHS != NULL) { complexity += 1; /* Add 1 for each pattern. */ complexity += ExpressionComplexity(theEnv,theLHS->networkTest); thePattern = theLHS->right; while (thePattern != NULL) { if (thePattern->multifieldSlot) { tempPattern = thePattern->bottom; while (tempPattern != NULL) { complexity += ExpressionComplexity(theEnv,tempPattern->networkTest); tempPattern = tempPattern->right; } } else { complexity += ExpressionComplexity(theEnv,thePattern->networkTest); } thePattern = thePattern->right; } theLHS = theLHS->bottom; } return(complexity); } /********************************************************************/ /* ExpressionComplexity: Determines the complexity of a expression. */ /********************************************************************/ static int ExpressionComplexity( void *theEnv, struct expr *exprPtr) { int complexity = 0; while (exprPtr != NULL) { if (exprPtr->type == FCALL) { /*=========================================*/ /* Logical combinations do not add to the */ /* complexity, but their arguments do. */ /*=========================================*/ if ((exprPtr->value == ExpressionData(theEnv)->PTR_AND) || (exprPtr->value == ExpressionData(theEnv)->PTR_NOT) || (exprPtr->value == ExpressionData(theEnv)->PTR_OR)) { complexity += ExpressionComplexity(theEnv,exprPtr->argList); } /*=========================================*/ /* else other function calls increase the */ /* complexity, but their arguments do not. */ /*=========================================*/ else { complexity++; } } else if ((EvaluationData(theEnv)->PrimitivesArray[exprPtr->type] != NULL) ? EvaluationData(theEnv)->PrimitivesArray[exprPtr->type]->addsToRuleComplexity : FALSE) { complexity++; } exprPtr = exprPtr->nextArg; } return(complexity); } /********************************************/ /* LogicalAnalysis: Analyzes the use of the */ /* logical CE within the LHS of a rule. */ /********************************************/ static int LogicalAnalysis( void *theEnv, struct lhsParseNode *patternList) { int firstLogical, logicalsFound = FALSE, logicalJoin = 0; int gap = FALSE; firstLogical = patternList->logical; /*===================================================*/ /* Loop through each pattern in the LHS of the rule. */ /*===================================================*/ for (; patternList != NULL; patternList = patternList->bottom) { /*=======================================*/ /* Skip anything that isn't a pattern CE */ /* or is embedded within a not/and CE. */ /*=======================================*/ if ((patternList->type != PATTERN_CE) || (patternList->endNandDepth != 1)) { continue; } /*=====================================================*/ /* If the pattern CE is not contained within a logical */ /* CE, then set the gap flag to TRUE indicating that */ /* any subsequent pattern CE found within a logical CE */ /* represents a gap between logical CEs which is an */ /* error. */ /*=====================================================*/ if (patternList->logical == FALSE) { gap = TRUE; continue; } /*=================================================*/ /* If a logical CE is encountered and the first CE */ /* of the rule isn't a logical CE, then indicate */ /* that the first CE must be a logical CE. */ /*=================================================*/ if (! firstLogical) { PrintErrorID(theEnv,"RULEPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Logical CEs must be placed first in a rule\n"); return(-1); } /*===================================================*/ /* If a break within the logical CEs was found and a */ /* new logical CE is encountered, then indicate that */ /* there can't be any gaps between logical CEs. */ /*===================================================*/ if (gap) { PrintErrorID(theEnv,"RULEPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Gaps may not exist between logical CEs\n"); return(-1); } /*===========================================*/ /* Increment the count of logical CEs found. */ /*===========================================*/ logicalJoin++; logicalsFound = TRUE; } /*============================================*/ /* If logical CEs were found, then return the */ /* join number where the logical information */ /* will be stored in the join network. */ /*============================================*/ if (logicalsFound) return(logicalJoin); /*=============================*/ /* Return zero indicating that */ /* no logical CE was found. */ /*=============================*/ return(0); } /*****************************************************************/ /* FindVariable: Searches for the last occurence of a variable */ /* in the LHS of a rule that is visible from the RHS of a rule. */ /* The last occurence of the variable on the LHS side of the */ /* rule will have the strictest constraints (because it will */ /* have been intersected with all of the other constraints for */ /* the variable on the LHS of the rule). The strictest */ /* constraints are useful for performing type checking on the */ /* RHS of the rule. */ /*****************************************************************/ globle struct lhsParseNode *FindVariable( SYMBOL_HN *name, struct lhsParseNode *theLHS) { struct lhsParseNode *theFields, *tmpFields = NULL; struct lhsParseNode *theReturnValue = NULL; /*==============================================*/ /* Loop through each CE in the LHS of the rule. */ /*==============================================*/ for (; theLHS != NULL; theLHS = theLHS->bottom) { /*==========================================*/ /* Don't bother searching for the variable */ /* in anything other than a pattern CE that */ /* is not contained within a not CE. */ /*==========================================*/ if ((theLHS->type != PATTERN_CE) || (theLHS->negated == TRUE) || (theLHS->beginNandDepth > 1)) { continue; } /*=====================================*/ /* Check the pattern address variable. */ /*=====================================*/ if (theLHS->value == (void *) name) { theReturnValue = theLHS; } /*============================================*/ /* Check for the variable inside the pattern. */ /*============================================*/ theFields = theLHS->right; while (theFields != NULL) { /*=================================================*/ /* Go one level deeper to check a multifield slot. */ /*=================================================*/ if (theFields->multifieldSlot) { tmpFields = theFields; theFields = theFields->bottom; } /*=================================*/ /* See if the field being examined */ /* is the variable being sought. */ /*=================================*/ if (theFields == NULL) { /* Do Nothing */ } else if (((theFields->type == SF_VARIABLE) || (theFields->type == MF_VARIABLE)) && (theFields->value == (void *) name)) { theReturnValue = theFields; } /*============================*/ /* Move on to the next field. */ /*============================*/ if (theFields == NULL) { theFields = tmpFields; tmpFields = NULL; } else if ((theFields->right == NULL) && (tmpFields != NULL)) { theFields = tmpFields; tmpFields = NULL; } theFields = theFields->right; } } /*=========================================================*/ /* Return a pointer to the LHS location where the variable */ /* was found (or a NULL pointer if it wasn't). */ /*=========================================================*/ return(theReturnValue); } /**********************************************************/ /* AddToDefruleList: Adds a defrule to the list of rules. */ /**********************************************************/ static void AddToDefruleList( struct defrule *rulePtr) { struct defrule *tempRule; struct defruleModule *theModuleItem; theModuleItem = (struct defruleModule *) rulePtr->header.whichModule; if (theModuleItem->header.lastItem == NULL) { theModuleItem->header.firstItem = (struct constructHeader *) rulePtr; } else { tempRule = (struct defrule *) theModuleItem->header.lastItem; while (tempRule != NULL) { tempRule->header.next = (struct constructHeader *) rulePtr; tempRule = tempRule->disjunct; } } theModuleItem->header.lastItem = (struct constructHeader *) rulePtr; } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._modulbsc.h0000400000175000017500000000012207422634611014713 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._network.h0000400000175000017500000000012207422634761014602 0ustar jfsjfsMac OS X  2 RTEXT???? clips-6.24/clipssrc/._cstrnbin.c0000400000175000017500000000075410253662516014734 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoLJ@LJ@. TTFSlFMPSRMWBBLclips-6.24/clipssrc/._commline.c0000400000175000017500000000075410441602065014705 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco;{i;{i,TTFL'FMPSRMWBBLclips-6.24/clipssrc/._cstrcbin.h0000400000175000017500000000012207422634617014720 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/genrcfun.c0000755000175000017500000006472710441143546014527 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Functions Internal Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #endif #include "argacces.h" #include "constrct.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "genrccom.h" #include "genrcexe.h" #include "memalloc.h" #include "prccode.h" #include "router.h" #define _GENRCFUN_SOURCE_ #include "genrcfun.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS static void DisplayGenericCore(void *,DEFGENERIC *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if ! RUN_TIME /*************************************************** NAME : ClearDefgenericsReady DESCRIPTION : Determines if it is safe to remove all defgenerics Assumes *all* constructs will be deleted - only checks to see if any methods are currently executing INPUTS : None RETURNS : TRUE if no methods are executing, FALSE otherwise SIDE EFFECTS : None NOTES : Used by (clear) and (bload) ***************************************************/ globle intBool ClearDefgenericsReady( void *theEnv) { return((DefgenericData(theEnv)->CurrentGeneric != NULL) ? FALSE : TRUE); } /***************************************************** 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)); } /*************************************************** NAME : FreeDefgenericModule DESCRIPTION : Removes a deffunction module and all associated deffunctions INPUTS : The deffunction module RETURNS : Nothing useful SIDE EFFECTS : Module and deffunctions deleted NOTES : None ***************************************************/ globle void FreeDefgenericModule( void *theEnv, void *theItem) { #if (! BLOAD_ONLY) FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefgenericData(theEnv)->DefgenericConstruct); #endif rtn_struct(theEnv,defgenericModule,theItem); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /************************************************************ NAME : ClearDefmethods DESCRIPTION : Deletes all defmethods - generic headers are left intact INPUTS : None RETURNS : TRUE if all methods deleted, FALSE otherwise SIDE EFFECTS : Defmethods deleted NOTES : Clearing generic functions is done in two stages 1) Delete all methods (to clear any references to other constructs) 2) Delete all generic headers This allows other constructs which mutually refer to generic functions to be cleared ************************************************************/ globle int ClearDefmethods( void *theEnv) { register DEFGENERIC *gfunc; int success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); while (gfunc != NULL) { if (RemoveAllExplicitMethods(theEnv,gfunc) == FALSE) success = FALSE; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc); } return(success); } /***************************************************************** NAME : RemoveAllExplicitMethods DESCRIPTION : Deletes all explicit defmethods - generic headers are left intact (as well as a method for an overloaded system function) INPUTS : None RETURNS : TRUE if all methods deleted, FALSE otherwise SIDE EFFECTS : Explicit defmethods deleted NOTES : None *****************************************************************/ globle int RemoveAllExplicitMethods( void *theEnv, DEFGENERIC *gfunc) { register unsigned i,j; unsigned systemMethodCount = 0; DEFMETHOD *narr; if (MethodsExecuting(gfunc) == FALSE) { for (i = 0 ; i < gfunc->mcnt ; i++) { if (gfunc->methods[i].system) systemMethodCount++; else DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[i]); } if (systemMethodCount != 0) { narr = (DEFMETHOD *) gm2(theEnv,(systemMethodCount * sizeof(DEFMETHOD))); i = 0; j = 0; while (i < gfunc->mcnt) { if (gfunc->methods[i].system) GenCopyMemory(DEFMETHOD,1,&narr[j++],&gfunc->methods[i]); i++; } rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); gfunc->mcnt = systemMethodCount; gfunc->methods = narr; } else { if (gfunc->mcnt != 0) rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); gfunc->mcnt = 0; gfunc->methods = NULL; } return(TRUE); } return(FALSE); } /************************************************** NAME : RemoveDefgeneric DESCRIPTION : Removes a generic function node from the generic list along with all its methods INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : List adjusted Nodes deallocated NOTES : Assumes generic is not in use!!! **************************************************/ globle void RemoveDefgeneric( void *theEnv, void *vgfunc) { DEFGENERIC *gfunc = (DEFGENERIC *) vgfunc; register unsigned i; for (i = 0 ; i < gfunc->mcnt ; i++) DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[i]); if (gfunc->mcnt != 0) rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); DecrementSymbolCount(theEnv,GetDefgenericNamePointer((void *) gfunc)); SetDefgenericPPForm((void *) gfunc,NULL); ClearUserDataList(theEnv,gfunc->header.usrData); rtn_struct(theEnv,defgeneric,gfunc); } /**************************************************************** NAME : ClearDefgenerics DESCRIPTION : Deletes all generic headers INPUTS : None RETURNS : TRUE if all methods deleted, FALSE otherwise SIDE EFFECTS : Generic headers deleted (and any implicit system function methods) NOTES : None ****************************************************************/ globle int ClearDefgenerics( void *theEnv) { register DEFGENERIC *gfunc,*gtmp; int success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); while (gfunc != NULL) { gtmp = gfunc; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc); if (RemoveAllExplicitMethods(theEnv,gtmp) == FALSE) { CantDeleteItemErrorMessage(theEnv,"generic function",EnvGetDefgenericName(theEnv,gtmp)); success = FALSE; } else { RemoveConstructFromModule(theEnv,(struct constructHeader *) gtmp); RemoveDefgeneric(theEnv,(void *) gtmp); } } return(success); } /******************************************************** NAME : MethodAlterError DESCRIPTION : Prints out an error message reflecting that a generic function's methods cannot be altered while any of them are executing INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ********************************************************/ globle void MethodAlterError( void *theEnv, DEFGENERIC *gfunc) { PrintErrorID(theEnv,"GENRCFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgeneric "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," cannot be modified while one of its methods is executing.\n"); } /*************************************************** NAME : DeleteMethodInfo DESCRIPTION : Deallocates all the data associated w/ a method but does not release the method structure itself INPUTS : 1) The generic function address 2) The method address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated NOTES : None ***************************************************/ globle void DeleteMethodInfo( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth) { register unsigned j,k; register RESTRICTION *rptr; SaveBusyCount(gfunc); ExpressionDeinstall(theEnv,meth->actions); ReturnPackedExpression(theEnv,meth->actions); ClearUserDataList(theEnv,meth->usrData); if (meth->ppForm != NULL) rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1))); for (j = 0 ; j < (unsigned) meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; for (k = 0 ; k < rptr->tcnt ; k++) #if OBJECT_SYSTEM DecrementDefclassBusyCount(theEnv,rptr->types[k]); #else DecrementIntegerCount(theEnv,(INTEGER_HN *) rptr->types[k]); #endif if (rptr->types != NULL) rm(theEnv,(void *) rptr->types,(sizeof(void *) * rptr->tcnt)); ExpressionDeinstall(theEnv,rptr->query); ReturnPackedExpression(theEnv,rptr->query); } if (meth->restrictions != NULL) rm(theEnv,(void *) meth->restrictions, (sizeof(RESTRICTION) * meth->restrictionCount)); RestoreBusyCount(gfunc); } /*************************************************** NAME : DestroyMethodInfo DESCRIPTION : Deallocates all the data associated w/ a method but does not release the method structure itself INPUTS : 1) The generic function address 2) The method address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle void DestroyMethodInfo( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth) { register int j; register RESTRICTION *rptr; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(gfunc) #endif ReturnPackedExpression(theEnv,meth->actions); ClearUserDataList(theEnv,meth->usrData); if (meth->ppForm != NULL) rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1))); for (j = 0 ; j < meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; if (rptr->types != NULL) rm(theEnv,(void *) rptr->types,(sizeof(void *) * rptr->tcnt)); ReturnPackedExpression(theEnv,rptr->query); } if (meth->restrictions != NULL) rm(theEnv,(void *) meth->restrictions, (sizeof(RESTRICTION) * meth->restrictionCount)); } /*************************************************** NAME : MethodsExecuting DESCRIPTION : Determines if any of the methods of a generic function are currently executing INPUTS : The generic function address RETURNS : TRUE if any methods are executing, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int MethodsExecuting( DEFGENERIC *gfunc) { register unsigned i; for (i = 0 ; i < gfunc->mcnt ; i++) if (gfunc->methods[i].busy > 0) return(TRUE); return(FALSE); } #endif #if ! OBJECT_SYSTEM /************************************************************** NAME : SubsumeType DESCRIPTION : Determines if the second type subsumes the first type (e.g. INTEGER is subsumed by NUMBER_TYPE_CODE) INPUTS : Two type codes RETURNS : TRUE if type 2 subsumes type 1, FALSE otherwise SIDE EFFECTS : None NOTES : Used only when COOL is not present **************************************************************/ globle intBool SubsumeType( int t1, int t2) { if ((t2 == OBJECT_TYPE_CODE) || (t2 == PRIMITIVE_TYPE_CODE)) return(TRUE); if ((t2 == NUMBER_TYPE_CODE) && ((t1 == INTEGER) || (t1 == FLOAT))) return(TRUE); if ((t2 == LEXEME_TYPE_CODE) && ((t1 == STRING) || (t1 == SYMBOL))) return(TRUE); if ((t2 == ADDRESS_TYPE_CODE) && ((t1 == EXTERNAL_ADDRESS) || (t1 == FACT_ADDRESS) || (t1 == INSTANCE_ADDRESS))) return(TRUE); if ((t2 == LEXEME_TYPE_CODE) && ((t1 == INSTANCE_NAME) || (t1 == INSTANCE_ADDRESS))) return(TRUE); return(FALSE); } #endif /***************************************************** NAME : FindMethodByIndex DESCRIPTION : Finds a generic function method of specified index INPUTS : 1) The generic function 2) The index RETURNS : The position of the method in the generic function's method array, -1 if not found SIDE EFFECTS : None NOTES : None *****************************************************/ globle int FindMethodByIndex( DEFGENERIC *gfunc, unsigned theIndex) { register unsigned i; for (i = 0 ; i < gfunc->mcnt ; i++) if (gfunc->methods[i].index == theIndex) return((int) i); return(-1); } #if DEBUGGING_FUNCTIONS /************************************************************* NAME : PreviewGeneric DESCRIPTION : Allows the user to see a printout of all the applicable methods for a particular generic function call INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments and evaluating query-functions to determine the set of applicable methods NOTES : H/L Syntax: (preview-generic ) *************************************************************/ globle void PreviewGeneric( void *theEnv) { DEFGENERIC *gfunc; DEFGENERIC *previousGeneric; int oldce; DATA_OBJECT temp; EvaluationData(theEnv)->EvaluationError = FALSE; if (EnvArgTypeCheck(theEnv,"preview-generic",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(theEnv,DOToString(temp)); if (gfunc == NULL) { PrintErrorID(theEnv,"GENRCFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find generic function "); EnvPrintRouter(theEnv,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,WERROR," in function preview-generic.\n"); return; } oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; PushProcParameters(theEnv,GetFirstArgument()->nextArg, CountArguments(GetFirstArgument()->nextArg), EnvGetDefgenericName(theEnv,(void *) gfunc),"generic function", UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; EvaluationData(theEnv)->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,oldce); return; } gfunc->busy++; DisplayGenericCore(theEnv,gfunc); gfunc->busy--; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; EvaluationData(theEnv)->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,oldce); } /****************************************************************** NAME : PrintMethod DESCRIPTION : Lists a brief description of methods for a method INPUTS : 1) Buffer for method info 2) Size of buffer (not including space for '\0') 3) The method address RETURNS : Nothing useful SIDE EFFECTS : None NOTES : A terminating newline is NOT included ******************************************************************/ #if IBM_TBC #pragma argsused #endif globle void PrintMethod( void *theEnv, char *buf, int buflen, DEFMETHOD *meth) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif register unsigned j,k; register RESTRICTION *rptr; char numbuf[15]; buf[0] = '\0'; if (meth->system) strncpy(buf,"SYS",(STD_SIZE) buflen); sprintf(numbuf,"%-2d ",meth->index); strncat(buf,numbuf,(STD_SIZE) buflen-3); for (j = 0 ; j < (unsigned) meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; if ((((int) j) == meth->restrictionCount-1) && (meth->maxRestrictions == -1)) { if ((rptr->tcnt == 0) && (rptr->query == NULL)) { strncat(buf,"$?",buflen-strlen(buf)); break; } strncat(buf,"($? ",buflen-strlen(buf)); } else strncat(buf,"(",buflen-strlen(buf)); for (k = 0 ; k < rptr->tcnt ; k++) { #if OBJECT_SYSTEM strncat(buf,EnvGetDefclassName(theEnv,rptr->types[k]),buflen-strlen(buf)); #else strncat(buf,TypeName(theEnv,ValueToInteger(rptr->types[k])),buflen-strlen(buf)); #endif if (((int) k) < (((int) rptr->tcnt) - 1)) strncat(buf," ",buflen-strlen(buf)); } if (rptr->query != NULL) { if (rptr->tcnt != 0) strncat(buf," ",buflen-strlen(buf)); strncat(buf,"",buflen-strlen(buf)); } strncat(buf,")",buflen-strlen(buf)); if (((int) j) != (((int) meth->restrictionCount)-1)) strncat(buf," ",buflen-strlen(buf)); } } #endif /*************************************************** NAME : CheckGenericExists DESCRIPTION : Finds the address of named generic function and prints out error message if not found INPUTS : 1) Calling function 2) Name of generic function RETURNS : Generic function address (NULL if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle DEFGENERIC *CheckGenericExists( void *theEnv, char *fname, char *gname) { DEFGENERIC *gfunc; gfunc = LookupDefgenericByMdlOrScope(theEnv,gname); if (gfunc == NULL) { PrintErrorID(theEnv,"GENRCFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find generic function "); EnvPrintRouter(theEnv,WERROR,gname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,fname); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } return(gfunc); } /*************************************************** NAME : CheckMethodExists DESCRIPTION : Finds the array index of the specified method and prints out error message if not found INPUTS : 1) Calling function 2) Generic function address 3) Index of method RETURNS : Method array index (-1 if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle int CheckMethodExists( void *theEnv, char *fname, DEFGENERIC *gfunc, int mi) { int fi; fi = FindMethodByIndex(gfunc,(unsigned) mi); if (fi == -1) { PrintErrorID(theEnv,"GENRCFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find method "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," #"); PrintLongInteger(theEnv,WERROR,(long) mi); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,fname); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } return(fi); } #if ! OBJECT_SYSTEM /******************************************************* NAME : TypeName DESCRIPTION : Given an integer type code, this function returns the string name of the type INPUTS : The type code RETURNS : The name-string of the type, or "" for unrecognized types SIDE EFFECTS : EvaluationError set and error message printed for unrecognized types NOTES : Used only when COOL is not present *******************************************************/ globle char *TypeName( void *theEnv, int tcode) { switch (tcode) { case INTEGER : return(INTEGER_TYPE_NAME); case FLOAT : return(FLOAT_TYPE_NAME); case SYMBOL : return(SYMBOL_TYPE_NAME); case STRING : return(STRING_TYPE_NAME); case MULTIFIELD : return(MULTIFIELD_TYPE_NAME); case EXTERNAL_ADDRESS : return(EXTERNAL_ADDRESS_TYPE_NAME); case FACT_ADDRESS : return(FACT_ADDRESS_TYPE_NAME); case INSTANCE_ADDRESS : return(INSTANCE_ADDRESS_TYPE_NAME); case INSTANCE_NAME : return(INSTANCE_NAME_TYPE_NAME); case OBJECT_TYPE_CODE : return(OBJECT_TYPE_NAME); case PRIMITIVE_TYPE_CODE : return(PRIMITIVE_TYPE_NAME); case NUMBER_TYPE_CODE : return(NUMBER_TYPE_NAME); case LEXEME_TYPE_CODE : return(LEXEME_TYPE_NAME); case ADDRESS_TYPE_CODE : return(ADDRESS_TYPE_NAME); case INSTANCE_TYPE_CODE : return(INSTANCE_TYPE_NAME); default : PrintErrorID(theEnv,"INSCOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Undefined type in function type.\n"); SetEvaluationError(theEnv,TRUE); return(""); } } #endif /****************************************************** NAME : PrintGenericName DESCRIPTION : Prints the name of a gneric function (including the module name if the generic is not in the current module) INPUTS : 1) The logical name of the output 2) The generic functions RETURNS : Nothing useful SIDE EFFECTS : Generic name printed NOTES : None ******************************************************/ globle void PrintGenericName( void *theEnv, char *logName, DEFGENERIC *gfunc) { if (gfunc->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) gfunc->header.whichModule->theModule)); EnvPrintRouter(theEnv,logName,"::"); } EnvPrintRouter(theEnv,logName,ValueToString((void *) gfunc->header.name)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS /********************************************************* NAME : DisplayGenericCore DESCRIPTION : Prints out a description of a core frame of applicable methods for a particular call of a generic function INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *********************************************************/ static void DisplayGenericCore( void *theEnv, DEFGENERIC *gfunc) { register unsigned i; char buf[256]; int rtn = FALSE; for (i = 0 ; i < gfunc->mcnt ; i++) { gfunc->methods[i].busy++; if (IsMethodApplicable(theEnv,&gfunc->methods[i])) { rtn = TRUE; EnvPrintRouter(theEnv,WDISPLAY,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WDISPLAY," #"); PrintMethod(theEnv,buf,255,&gfunc->methods[i]); EnvPrintRouter(theEnv,WDISPLAY,buf); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } gfunc->methods[i].busy--; } if (rtn == FALSE) { EnvPrintRouter(theEnv,WDISPLAY,"No applicable methods for "); EnvPrintRouter(theEnv,WDISPLAY,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WDISPLAY,".\n"); } } #endif #endif clips-6.24/clipssrc/multifun.c0000755000175000017500000014420610441602253014545 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* MULTIFIELD FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several multifield */ /* functions including first$, rest$, subseq$, delete$, */ /* delete-member$, replace-member$ */ /* replace$, insert$, explode$, implode$, nth$, member$, */ /* subsetp, progn$, str-implode, str-explode, subset, nth, */ /* mv-replace, member, mv-subseq, and mv-delete. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian Donnell */ /* Barry Cameron */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved ImplodeMultifield to multifld.c. */ /* */ /*************************************************************/ #define _MULTIFUN_SOURCE_ #include "setup.h" #if MULTIFIELD_FUNCTIONS || OBJECT_SYSTEM #include #define _STDIO_INCLUDED_ #include #include "argacces.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "multifld.h" #include "multifun.h" #include "prcdrpsr.h" #include "prcdrfun.h" #include "router.h" #if (! BLOAD_ONLY) && (! RUN_TIME) #include "scanner.h" #endif #include "utility.h" #if OBJECT_SYSTEM #include "object.h" #endif /**************/ /* STRUCTURES */ /**************/ typedef struct fieldVarStack { unsigned short type; void *value; long index; struct fieldVarStack *nxt; } FIELD_VAR_STACK; /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if MULTIFIELD_FUNCTIONS static intBool MVRangeCheck(long,long,long *,int); #if (! BLOAD_ONLY) && (! RUN_TIME) static struct expr *MultifieldPrognParser(void *,struct expr *,char *); static void ReplaceMvPrognFieldVars(void *,SYMBOL_HN *,struct expr *,int); #endif #endif static void MVRangeError(void *,long,long,unsigned long,char *); #endif /***************************************/ /* LOCAL INTERNAL VARIABLE DEFINITIONS */ /***************************************/ #if MULTIFIELD_FUNCTIONS #define MULTIFUN_DATA 10 struct multiFunctionData { FIELD_VAR_STACK *FieldVarStack; }; #define MultiFunctionData(theEnv) ((struct multiFunctionData *) GetEnvironmentData(theEnv,MULTIFUN_DATA)) /**********************************************/ /* MultifieldFunctionDefinitions: Initializes */ /* the multifield functions. */ /**********************************************/ globle void MultifieldFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,MULTIFUN_DATA,sizeof(struct multiFunctionData),NULL); #if ! RUN_TIME EnvDefineFunction2(theEnv,"first$", 'm', PTIEF FirstFunction, "FirstFunction", "11m"); EnvDefineFunction2(theEnv,"rest$", 'm', PTIEF RestFunction, "RestFunction", "11m"); EnvDefineFunction2(theEnv,"subseq$", 'm', PTIEF SubseqFunction, "SubseqFunction", "33im"); EnvDefineFunction2(theEnv,"delete-member$", 'm', PTIEF DeleteMemberFunction, "DeleteMemberFunction", "2*um"); EnvDefineFunction2(theEnv,"replace-member$", 'm', PTIEF ReplaceMemberFunction, "ReplaceMemberFunction","3*um"); EnvDefineFunction2(theEnv,"delete$", 'm', PTIEF DeleteFunction, "DeleteFunction", "33im"); EnvDefineFunction2(theEnv,"replace$", 'm', PTIEF ReplaceFunction, "ReplaceFunction","4**mii"); EnvDefineFunction2(theEnv,"insert$", 'm', PTIEF InsertFunction, "InsertFunction", "3**mi"); EnvDefineFunction2(theEnv,"explode$", 'm', PTIEF ExplodeFunction, "ExplodeFunction", "11s"); EnvDefineFunction2(theEnv,"implode$", 's', PTIEF ImplodeFunction, "ImplodeFunction", "11m"); EnvDefineFunction2(theEnv,"nth$", 'u', PTIEF NthFunction, "NthFunction", "22*im"); EnvDefineFunction2(theEnv,"member$", 'u', PTIEF MemberFunction, "MemberFunction", "22*um"); EnvDefineFunction2(theEnv,"subsetp", 'b', PTIEF SubsetpFunction, "SubsetpFunction", "22*mm"); EnvDefineFunction2(theEnv,"progn$", 'u', PTIEF MultifieldPrognFunction, "MultifieldPrognFunction", NULL); EnvDefineFunction2(theEnv,"str-implode", 's', PTIEF ImplodeFunction, "ImplodeFunction", "11m"); EnvDefineFunction2(theEnv,"str-explode", 'm', PTIEF ExplodeFunction, "ExplodeFunction", "11s"); EnvDefineFunction2(theEnv,"subset", 'b', PTIEF SubsetpFunction, "SubsetpFunction", "22*mm"); EnvDefineFunction2(theEnv,"nth", 'u', PTIEF NthFunction, "NthFunction", "22*im"); EnvDefineFunction2(theEnv,"mv-replace", 'm', PTIEF MVReplaceFunction, "MVReplaceFunction","33*im"); EnvDefineFunction2(theEnv,"member", 'u', PTIEF MemberFunction, "MemberFunction", "22*um"); EnvDefineFunction2(theEnv,"mv-subseq", 'm', PTIEF MVSubseqFunction, "MVSubseqFunction", "33*iim"); EnvDefineFunction2(theEnv,"mv-delete", 'm', PTIEF MVDeleteFunction,"MVDeleteFunction", "22*im"); #if ! BLOAD_ONLY AddFunctionParser(theEnv,"progn$",MultifieldPrognParser); #endif FuncSeqOvlFlags(theEnv,"progn$",FALSE,FALSE); EnvDefineFunction2(theEnv,"(get-progn$-field)", 'u', PTIEF GetMvPrognField, "GetMvPrognField", "00"); EnvDefineFunction2(theEnv,"(get-progn$-index)", 'l', PTIEF GetMvPrognIndex, "GetMvPrognIndex", "00"); #endif } /****************************************/ /* DeleteFunction: H/L access routine */ /* for the delete$ function. */ /****************************************/ globle void DeleteFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2, value3; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"delete$",1,MULTIFIELD,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"delete$",2,INTEGER,&value2) == FALSE) || (EnvArgTypeCheck(theEnv,"delete$",3,INTEGER,&value3) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=================================================*/ /* Delete the section out of the multifield value. */ /*=================================================*/ if (DeleteMultiValueField(theEnv,returnValue,&value1, DOToLong(value2),DOToLong(value3),"delete$") == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /******************************************/ /* MVDeleteFunction: H/L access routine */ /* for the mv-delete function. */ /******************************************/ globle void MVDeleteFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"mv-delete",1,INTEGER,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"mv-delete",2,MULTIFIELD,&value2) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=================================================*/ /* Delete the section out of the multifield value. */ /*=================================================*/ if (DeleteMultiValueField(theEnv,returnValue,&value2, DOToLong(value1),DOToLong(value1),"mv-delete") == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /*****************************************/ /* ReplaceFunction: H/L access routine */ /* for the replace$ function. */ /*****************************************/ globle void ReplaceFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2, value3, value4; EXPRESSION *fieldarg; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"replace$",1,MULTIFIELD,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"replace$",2,INTEGER,&value2) == FALSE) || (EnvArgTypeCheck(theEnv,"replace$",3,INTEGER,&value3) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*===============================*/ /* Create the replacement value. */ /*===============================*/ fieldarg = GetFirstArgument()->nextArg->nextArg->nextArg; if (fieldarg->nextArg != NULL) { StoreInMultifield(theEnv,&value4,fieldarg,TRUE); } else { EvaluateExpression(theEnv,fieldarg,&value4); } /*==============================================*/ /* Replace the section in the multifield value. */ /*==============================================*/ if (ReplaceMultiValueField(theEnv,returnValue,&value1,DOToInteger(value2), DOToInteger(value3),&value4,"replace$") == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /*******************************************/ /* MVReplaceFunction: H/L access routine */ /* for the mv-replace function. */ /*******************************************/ globle void MVReplaceFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2, value3; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"mv-replace",1,INTEGER,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"mv-replace",2,MULTIFIELD,&value2) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*===============================*/ /* Create the replacement value. */ /*===============================*/ EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&value3); /*==============================================*/ /* Replace the section in the multifield value. */ /*==============================================*/ if (ReplaceMultiValueField(theEnv,returnValue,&value2,DOToInteger(value1), DOToInteger(value1),&value3,"mv-replace") == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /**********************************************/ /* DeleteMemberFunction: H/L access routine */ /* for the delete-member$ function. */ /**********************************************/ globle void DeleteMemberFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT resultValue,*delVals,tmpVal; int i,argCnt; unsigned delSize; long j,k; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ argCnt = EnvArgCountCheck(theEnv,"delete-member$",AT_LEAST,2); if (argCnt == -1) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if (EnvArgTypeCheck(theEnv,"delete-member$",1,MULTIFIELD,&resultValue) == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*================================================= For every value specified, delete all occurrences of those values from the multifield ================================================= */ delSize = (sizeof(DATA_OBJECT) * (argCnt-1)); delVals = (DATA_OBJECT_PTR) gm2(theEnv,delSize); for (i = 2 ; i <= argCnt ; i++) { if (!EnvRtnUnknown(theEnv,i,&delVals[i-2])) { rm(theEnv,(void *) delVals,delSize); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } } while (FindDOsInSegment(delVals,argCnt-1,&resultValue,&j,&k,NULL,0)) { if (DeleteMultiValueField(theEnv,&tmpVal,&resultValue, j,k,"delete-member$") == FALSE) { rm(theEnv,(void *) delVals,delSize); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } GenCopyMemory(DATA_OBJECT,1,&resultValue,&tmpVal); } rm(theEnv,(void *) delVals,delSize); GenCopyMemory(DATA_OBJECT,1,returnValue,&resultValue); } /***********************************************/ /* ReplaceMemberFunction: H/L access routine */ /* for the replace-member$ function. */ /***********************************************/ globle void ReplaceMemberFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT resultValue,replVal,*delVals,tmpVal; int i,argCnt; unsigned delSize; long j,k,mink[2],*minkp; long replLen = 1L; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ argCnt = EnvArgCountCheck(theEnv,"replace-member$",AT_LEAST,3); if (argCnt == -1) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if (EnvArgTypeCheck(theEnv,"replace-member$",1,MULTIFIELD,&resultValue) == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } if (!EnvRtnUnknown(theEnv,2,&replVal)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } if (GetType(replVal) == MULTIFIELD) replLen = GetDOLength(replVal); /*===================================================== For the value (or values from multifield ) specified, replace all occurrences of those values with all values specified ===================================================== */ delSize = (sizeof(DATA_OBJECT) * (argCnt-2)); delVals = (DATA_OBJECT_PTR) gm2(theEnv,delSize); for (i = 3 ; i <= argCnt ; i++) { if (!EnvRtnUnknown(theEnv,i,&delVals[i-3])) { rm(theEnv,(void *) delVals,delSize); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } } minkp = NULL; while (FindDOsInSegment(delVals,argCnt-2,&resultValue,&j,&k,minkp,minkp ? 1 : 0)) { if (ReplaceMultiValueField(theEnv,&tmpVal,&resultValue,j,k, &replVal,"replace-member$") == FALSE) { rm(theEnv,(void *) delVals,delSize); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } GenCopyMemory(DATA_OBJECT,1,&resultValue,&tmpVal); mink[0] = 1L; mink[1] = j + replLen - 1L; minkp = mink; } rm(theEnv,(void *) delVals,delSize); GenCopyMemory(DATA_OBJECT,1,returnValue,&resultValue); } /****************************************/ /* InsertFunction: H/L access routine */ /* for the insert$ function. */ /****************************************/ globle void InsertFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value1, value2, value3; EXPRESSION *fieldarg; /*=======================================*/ /* Check for the correct argument types. */ /*=======================================*/ if ((EnvArgTypeCheck(theEnv,"insert$",1,MULTIFIELD,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"insert$",2,INTEGER,&value2) == FALSE)) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=============================*/ /* Create the insertion value. */ /*=============================*/ fieldarg = GetFirstArgument()->nextArg->nextArg; if (fieldarg->nextArg != NULL) StoreInMultifield(theEnv,&value3,fieldarg,TRUE); else EvaluateExpression(theEnv,fieldarg,&value3); /*===========================================*/ /* Insert the value in the multifield value. */ /*===========================================*/ if (InsertMultiValueField(theEnv,returnValue,&value1,DOToLong(value2), &value3,"insert$") == FALSE) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); } } /*****************************************/ /* ExplodeFunction: H/L access routine */ /* for the explode$ function. */ /*****************************************/ globle void ExplodeFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT value; struct multifield *theMultifield; unsigned long end; /*=====================================*/ /* Explode$ expects a single argument. */ /*=====================================*/ if (EnvArgCountCheck(theEnv,"explode$",EXACTLY,1) == -1) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*==================================*/ /* The argument should be a string. */ /*==================================*/ if (EnvArgTypeCheck(theEnv,"explode$",1,STRING,&value) == FALSE) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,returnValue); return; } /*=====================================*/ /* Convert the string to a multifield. */ /*=====================================*/ theMultifield = StringToMultifield(theEnv,DOToString(value)); if (theMultifield == NULL) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); end = 0; } else { end = GetMFLength(theMultifield); } /*========================*/ /* Return the multifield. */ /*========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,end); SetpValue(returnValue,(void *) theMultifield); return; } /*****************************************/ /* ImplodeFunction: H/L access routine */ /* for the implode$ function. */ /*****************************************/ globle void *ImplodeFunction( void *theEnv) { DATA_OBJECT value; /*=====================================*/ /* Implode$ expects a single argument. */ /*=====================================*/ if (EnvArgCountCheck(theEnv,"implode$",EXACTLY,1) == -1) { return(EnvAddSymbol(theEnv,"")); } /*======================================*/ /* The argument should be a multifield. */ /*======================================*/ if (EnvArgTypeCheck(theEnv,"implode$",1,MULTIFIELD,&value) == FALSE) { return(EnvAddSymbol(theEnv,"")); } /*====================*/ /* Return the string. */ /*====================*/ return(ImplodeMultifield(theEnv,&value)); } /****************************************/ /* SubseqFunction: H/L access routine */ /* for the subseq$ function. */ /****************************************/ globle void SubseqFunction( void *theEnv, DATA_OBJECT_PTR sub_value) { DATA_OBJECT value; struct multifield *theList; long offset, start, end, length; /* 6.04 Bug Fix */ /*===================================*/ /* Get the segment to be subdivided. */ /*===================================*/ if (EnvArgTypeCheck(theEnv,"subseq$",1,MULTIFIELD,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } theList = (struct multifield *) DOToPointer(value); offset = GetDOBegin(value); length = GetDOLength(value); /*=============================================*/ /* Get range arguments. If they are not within */ /* appropriate ranges, return a null segment. */ /*=============================================*/ if (EnvArgTypeCheck(theEnv,"subseq$",2,INTEGER,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } start = DOToInteger(value); if (EnvArgTypeCheck(theEnv,"subseq$",3,INTEGER,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } end = DOToInteger(value); if ((end < 1) || (end < start)) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } /*===================================================*/ /* Adjust lengths to conform to segment boundaries. */ /*===================================================*/ if (start > length) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } if (end > length) end = length; if (start < 1) start = 1; /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(sub_value,MULTIFIELD); SetpValue(sub_value,theList); SetpDOEnd(sub_value,offset + end - 1); SetpDOBegin(sub_value,offset + start - 1); } /******************************************/ /* MVSubseqFunction: H/L access routine */ /* for the mv-subseq function. */ /******************************************/ globle void MVSubseqFunction( void *theEnv, DATA_OBJECT_PTR sub_value) { DATA_OBJECT value; struct multifield *theList; long offset, start, end, length; /* 6.04 Bug Fix */ /*=============================================*/ /* Get range arguments. If they are not within */ /* appropriate ranges, return a null segment. */ /*=============================================*/ if (EnvArgTypeCheck(theEnv,"mv-subseq",1,INTEGER,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } start = DOToInteger(value); if (EnvArgTypeCheck(theEnv,"mv-subseq",2,INTEGER,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } end = DOToInteger(value); if ((end < 1) || (end < start)) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } /*===================================*/ /* Get the segment to be subdivided. */ /*===================================*/ if (EnvArgTypeCheck(theEnv,"mv-subseq",3,MULTIFIELD,&value) == FALSE) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } theList = (struct multifield *) DOToPointer(value); offset = GetDOBegin(value); /*===================================================*/ /* Adjust lengths to conform to segment boundaries. */ /*===================================================*/ length = GetDOLength(value); if (start > length) { EnvSetMultifieldErrorValue(theEnv,sub_value); return; } if (end > length) end = length; if (start < 1) start = 1; /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(sub_value,MULTIFIELD); SetpValue(sub_value,theList); SetpDOEnd(sub_value,offset + end - 1); SetpDOBegin(sub_value,offset + start - 1); } /***************************************/ /* FirstFunction: H/L access routine */ /* for the first$ function. */ /***************************************/ globle void FirstFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theValue; struct multifield *theList; /*===================================*/ /* Get the segment to be subdivided. */ /*===================================*/ if (EnvArgTypeCheck(theEnv,"first$",1,MULTIFIELD,&theValue) == FALSE) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } theList = (struct multifield *) DOToPointer(theValue); /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(returnValue,MULTIFIELD); SetpValue(returnValue,theList); if (GetDOEnd(theValue) >= GetDOBegin(theValue)) { SetpDOEnd(returnValue,GetDOBegin(theValue)); } else { SetpDOEnd(returnValue,GetDOEnd(theValue)); } SetpDOBegin(returnValue,GetDOBegin(theValue)); } /**************************************/ /* RestFunction: H/L access routine */ /* for the rest$ function. */ /**************************************/ globle void RestFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theValue; struct multifield *theList; /*===================================*/ /* Get the segment to be subdivided. */ /*===================================*/ if (EnvArgTypeCheck(theEnv,"rest$",1,MULTIFIELD,&theValue) == FALSE) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } theList = (struct multifield *) DOToPointer(theValue); /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(returnValue,MULTIFIELD); SetpValue(returnValue,theList); if (GetDOBegin(theValue) > GetDOEnd(theValue)) { SetpDOBegin(returnValue,GetDOBegin(theValue)); } else { SetpDOBegin(returnValue,GetDOBegin(theValue) + 1); } SetpDOEnd(returnValue,GetDOEnd(theValue)); } /*************************************/ /* NthFunction: H/L access routine */ /* for the nth$ function. */ /*************************************/ globle void NthFunction( void *theEnv, DATA_OBJECT_PTR nth_value) { DATA_OBJECT value1, value2; struct multifield *elm_ptr; long n; /* 6.04 Bug Fix */ if (EnvArgCountCheck(theEnv,"nth$",EXACTLY,2) == -1) { SetpType(nth_value,SYMBOL); SetpValue(nth_value,(void *) EnvAddSymbol(theEnv,"nil")); return; } if ((EnvArgTypeCheck(theEnv,"nth$",1,INTEGER,&value1) == FALSE) || (EnvArgTypeCheck(theEnv,"nth$",2,MULTIFIELD,&value2) == FALSE)) { SetpType(nth_value,SYMBOL); SetpValue(nth_value,(void *) EnvAddSymbol(theEnv,"nil")); return; } n = DOToLong(value1); /* 6.04 Bug Fix */ if ((n > GetDOLength(value2)) || (n < 1)) { SetpType(nth_value,SYMBOL); SetpValue(nth_value,(void *) EnvAddSymbol(theEnv,"nil")); return; } elm_ptr = (struct multifield *) GetValue(value2); SetpType(nth_value,GetMFType(elm_ptr,n + GetDOBegin(value2) - 1)); SetpValue(nth_value,GetMFValue(elm_ptr,n + GetDOBegin(value2) - 1)); } /* ------------------------------------------------------------------ * SubsetFunction: * This function compares two multi-field variables * to see if the first is a subset of the second. It * does not consider order. * * INPUTS: Two arguments via argument stack. First is the sublist * multi-field variable, the second is the list to be * compared to. Both should be of type MULTIFIELD. * * OUTPUTS: TRUE if the first list is a subset of the * second, else FALSE * * NOTES: This function is called from H/L with the subset * command. Repeated values in the sublist must also * be repeated in the main list. * ------------------------------------------------------------------ */ globle intBool SubsetpFunction( void *theEnv) { DATA_OBJECT item1, item2, tmpItem; long i,j,k; if (EnvArgCountCheck(theEnv,"subsetp",EXACTLY,2) == -1) return(FALSE); if (EnvArgTypeCheck(theEnv,"subsetp",1,MULTIFIELD,&item1) == FALSE) return(FALSE); if (EnvArgTypeCheck(theEnv,"subsetp",2,MULTIFIELD,&item2) == FALSE) return(FALSE); if (GetDOLength(item1) == 0) return(TRUE); if (GetDOLength(item2) == 0) return(FALSE); for (i = GetDOBegin(item1) ; i <= GetDOEnd(item1) ; i++) { SetType(tmpItem,GetMFType((struct multifield *) GetValue(item1),i)); SetValue(tmpItem,GetMFValue((struct multifield *) GetValue(item1),i)); if (! FindDOsInSegment(&tmpItem,1,&item2,&j,&k,NULL,0)) { return(FALSE); } } return(TRUE); } /****************************************/ /* MemberFunction: H/L access routine */ /* for the member$ function. */ /****************************************/ globle void MemberFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT item1, item2; long j,k; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgCountCheck(theEnv,"member$",EXACTLY,2) == -1) return; EnvRtnUnknown(theEnv,1,&item1); if (EnvArgTypeCheck(theEnv,"member$",2,MULTIFIELD,&item2) == FALSE) return; if (FindDOsInSegment(&item1,1,&item2,&j,&k,NULL,0)) { if (j == k) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,j); } else { result->type = MULTIFIELD; result->value = EnvCreateMultifield(theEnv,2); SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,EnvAddLong(theEnv,j)); SetMFType(result->value,2,INTEGER); SetMFValue(result->value,2,EnvAddLong(theEnv,k)); SetpDOBegin(result,1); SetpDOEnd(result,2); } } } /***************************************/ /* FindDOsInSegment: */ /***************************************/ /* 6.05 Bug Fix */ intBool FindDOsInSegment( DATA_OBJECT_PTR searchDOs, int scnt, DATA_OBJECT_PTR value, long *si, long *ei, long *excludes, int epaircnt) { long mul_length,slen,i,k; /* 6.04 Bug Fix */ int j; mul_length = GetpDOLength(value); for (i = 0 ; i < mul_length ; i++) { for (j = 0 ; j < scnt ; j++) { if (GetType(searchDOs[j]) == MULTIFIELD) { slen = GetDOLength(searchDOs[j]); if (MVRangeCheck(i+1L,i+slen,excludes,epaircnt)) { for (k = 0L ; (k < slen) && ((k + i) < mul_length) ; k++) if ((GetMFType(GetValue(searchDOs[j]),k+GetDOBegin(searchDOs[j])) != GetMFType(GetpValue(value),k+i+GetpDOBegin(value))) || (GetMFValue(GetValue(searchDOs[j]),k+GetDOBegin(searchDOs[j])) != GetMFValue(GetpValue(value),k+i+GetpDOBegin(value)))) break; if (k >= slen) { *si = i + 1L; *ei = i + slen; return(TRUE); } } } else if ((GetValue(searchDOs[j]) == GetMFValue(GetpValue(value),i + GetpDOBegin(value))) && (GetType(searchDOs[j]) == GetMFType(GetpValue(value),i + GetpDOBegin(value))) && MVRangeCheck(i+1L,i+1L,excludes,epaircnt)) { *si = *ei = i+1L; return(TRUE); } } } return(FALSE); } /******************************************************/ /* MVRangeCheck: */ /******************************************************/ static intBool MVRangeCheck( long si, long ei, long *elist, int epaircnt) { int i; if (!elist || !epaircnt) return(TRUE); for (i = 0 ; i < epaircnt ; i++) if (((si >= elist[i*2]) && (si <= elist[i*2+1])) || ((ei >= elist[i*2]) && (ei <= elist[i*2+1]))) return(FALSE); return(TRUE); } #if (! BLOAD_ONLY) && (! RUN_TIME) /******************************************************/ /* MultifieldPrognParser: Parses the progn$ function. */ /******************************************************/ static struct expr *MultifieldPrognParser( void *theEnv, struct expr *top, char *infile) { struct BindInfo *oldBindList,*newBindList,*prev; struct token tkn; struct expr *tmp; SYMBOL_HN *fieldVar = NULL; SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&tkn); /* ================================ Simple form: progn$ ... ================================ */ if (tkn.type != LPAREN) { top->argList = ParseAtomOrExpression(theEnv,infile,&tkn); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } } else { GetToken(theEnv,infile,&tkn); if (tkn.type != SF_VARIABLE) { if (tkn.type != SYMBOL) goto MvPrognParseError; top->argList = Function2Parse(theEnv,infile,ValueToString(tkn.value)); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } } /* ========================================= Complex form: progn$ ( ) ... ========================================= */ else { fieldVar = (SYMBOL_HN *) tkn.value; SavePPBuffer(theEnv," "); top->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } GetToken(theEnv,infile,&tkn); if (tkn.type != RPAREN) goto MvPrognParseError; PPBackup(theEnv); /* PPBackup(theEnv); */ SavePPBuffer(theEnv,tkn.printForm); SavePPBuffer(theEnv," "); } } if (CheckArgumentAgainstRestriction(theEnv,top->argList,(int) 'm')) goto MvPrognParseError; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); IncrementIndentDepth(theEnv,3); ExpressionData(theEnv)->BreakContext = TRUE; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; PPCRAndIndent(theEnv); top->argList->nextArg = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tkn.printForm); if (top->argList->nextArg == NULL) { SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(NULL); } tmp = top->argList->nextArg; top->argList->nextArg = tmp->argList; tmp->argList = NULL; ReturnExpression(theEnv,tmp); newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { if ((fieldVar == NULL) ? FALSE : (strcmp(ValueToString(newBindList->name),ValueToString(fieldVar)) == 0)) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"MULTIFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind field variable in function progn$.\n"); ReturnExpression(theEnv,top); return(NULL); } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) SetParsedBindNames(theEnv,oldBindList); else prev->next = oldBindList; if (fieldVar != NULL) ReplaceMvPrognFieldVars(theEnv,fieldVar,top->argList->nextArg,0); return(top); MvPrognParseError: SyntaxErrorMessage(theEnv,"progn$"); ReturnExpression(theEnv,top); return(NULL); } /**********************************************/ /* ReplaceMvPrognFieldVars: Replaces variable */ /* references found in the progn$ function. */ /**********************************************/ static void ReplaceMvPrognFieldVars( void *theEnv, SYMBOL_HN *fieldVar, struct expr *theExp, int depth) { size_t flen; flen = strlen(ValueToString(fieldVar)); while (theExp != NULL) { if ((theExp->type != SF_VARIABLE) ? FALSE : (strncmp(ValueToString(theExp->value),ValueToString(fieldVar), (STD_SIZE) flen) == 0)) { if (ValueToString(theExp->value)[flen] == '\0') { theExp->type = FCALL; theExp->value = (void *) FindFunction(theEnv,"(get-progn$-field)"); theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) depth)); } else if (strcmp(ValueToString(theExp->value) + flen,"-index") == 0) { theExp->type = FCALL; theExp->value = (void *) FindFunction(theEnv,"(get-progn$-index)"); theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) depth)); } } else if (theExp->argList != NULL) { if ((theExp->type == FCALL) && (theExp->value == (void *) FindFunction(theEnv,"progn$"))) ReplaceMvPrognFieldVars(theEnv,fieldVar,theExp->argList,depth+1); else ReplaceMvPrognFieldVars(theEnv,fieldVar,theExp->argList,depth); } theExp = theExp->nextArg; } } #endif /*****************************************/ /* MultifieldPrognFunction: H/L access */ /* routine for the progn$ function. */ /*****************************************/ globle void MultifieldPrognFunction( void *theEnv, DATA_OBJECT_PTR result) { EXPRESSION *theExp; DATA_OBJECT argval; long i, end; /* 6.04 Bug Fix */ FIELD_VAR_STACK *tmpField; tmpField = get_struct(theEnv,fieldVarStack); tmpField->type = SYMBOL; tmpField->value = EnvFalseSymbol(theEnv); tmpField->nxt = MultiFunctionData(theEnv)->FieldVarStack; MultiFunctionData(theEnv)->FieldVarStack = tmpField; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"progn$",1,MULTIFIELD,&argval) == FALSE) { MultiFunctionData(theEnv)->FieldVarStack = tmpField->nxt; rtn_struct(theEnv,fieldVarStack,tmpField); return; } ValueInstall(theEnv,&argval); end = GetDOEnd(argval); for (i = GetDOBegin(argval) ; i <= end ; i++) { tmpField->type = GetMFType(argval.value,i); tmpField->value = GetMFValue(argval.value,i); /* tmpField->index = i; */ tmpField->index = (i - GetDOBegin(argval)) + 1; for (theExp = GetFirstArgument()->nextArg ; theExp != NULL ; theExp = theExp->nextArg) { EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,theExp,result); EvaluationData(theEnv)->CurrentEvaluationDepth--; if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { PropagateReturnValue(theEnv,result); } PeriodicCleanup(theEnv,FALSE,TRUE); if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { ValueDeinstall(theEnv,&argval); ProcedureFunctionData(theEnv)->BreakFlag = FALSE; if (EvaluationData(theEnv)->HaltExecution) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); } MultiFunctionData(theEnv)->FieldVarStack = tmpField->nxt; rtn_struct(theEnv,fieldVarStack,tmpField); return; } } } ValueDeinstall(theEnv,&argval); ProcedureFunctionData(theEnv)->BreakFlag = FALSE; MultiFunctionData(theEnv)->FieldVarStack = tmpField->nxt; rtn_struct(theEnv,fieldVarStack,tmpField); } /***************************************************/ /* GetMvPrognField */ /***************************************************/ globle void GetMvPrognField( void *theEnv, DATA_OBJECT_PTR result) { int depth; FIELD_VAR_STACK *tmpField; depth = ValueToInteger(GetFirstArgument()->value); tmpField = MultiFunctionData(theEnv)->FieldVarStack; while (depth > 0) { tmpField = tmpField->nxt; depth--; } result->type = tmpField->type; result->value = tmpField->value; } /***************************************************/ /* GetMvPrognIndex */ /***************************************************/ globle long GetMvPrognIndex( void *theEnv) { int depth; FIELD_VAR_STACK *tmpField; depth = ValueToInteger(GetFirstArgument()->value); tmpField = MultiFunctionData(theEnv)->FieldVarStack; while (depth > 0) { tmpField = tmpField->nxt; depth--; } return(tmpField->index); } #endif #if OBJECT_SYSTEM || MULTIFIELD_FUNCTIONS /************************************************************************** NAME : ReplaceMultiValueField DESCRIPTION : Performs a replace on the src multi-field value storing the results in the dst multi-field value INPUTS : 1) The destination value buffer 2) The source value (can be NULL) 3) Beginning of index range 4) End of range 5) The new field value RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Allocates and sets a ephemeral segment (even if new number of fields is 0) Src value segment is not changed NOTES : index is NOT guaranteed to be valid src is guaranteed to be a multi-field variable or NULL **************************************************************************/ globle int ReplaceMultiValueField( void *theEnv, DATA_OBJECT *dst, DATA_OBJECT *src, long rb, long re, DATA_OBJECT *field, char *funcName) { long i,j,k; struct field *deptr; struct field *septr; long srclen,dstlen; srclen = ((src != NULL) ? (src->end - src->begin + 1) : 0); if ((re < rb) || (rb < 1) || (re < 1) || (rb > srclen) || (re > srclen)) { MVRangeError(theEnv,rb,re,(unsigned long) srclen,funcName); return(FALSE); } rb = src->begin + rb - 1; re = src->begin + re - 1; if (field->type == MULTIFIELD) dstlen = srclen + GetpDOLength(field) - (re-rb+1); else dstlen = srclen + 1 - (re-rb+1); dst->type = MULTIFIELD; dst->begin = 0; dst->value = EnvCreateMultifield(theEnv,(unsigned long) dstlen); SetpDOEnd(dst,dstlen); for (i = 0 , j = src->begin ; j < rb ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } if (field->type != MULTIFIELD) { deptr = &((struct multifield *) dst->value)->theFields[i++]; deptr->type = field->type; deptr->value = field->value; } else { for (k = field->begin ; k <= field->end ; k++ , i++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) field->value)->theFields[k]; deptr->type = septr->type; deptr->value = septr->value; } } while (j < re) j++; for (j++ ; i < dstlen ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } return(TRUE); } /************************************************************************** NAME : InsertMultiValueField DESCRIPTION : Performs an insert on the src multi-field value storing the results in the dst multi-field value INPUTS : 1) The destination value buffer 2) The source value (can be NULL) 3) The index for the change 4) The new field value RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Allocates and sets a ephemeral segment (even if new number of fields is 0) Src value segment is not changed NOTES : index is NOT guaranteed to be valid src is guaranteed to be a multi-field variable or NULL **************************************************************************/ globle int InsertMultiValueField( void *theEnv, DATA_OBJECT *dst, DATA_OBJECT *src, long theIndex, DATA_OBJECT *field, char *funcName) { register long i,j,k; register FIELD *deptr, *septr; unsigned long srclen,dstlen; srclen = (unsigned long) ((src != NULL) ? (src->end - src->begin + 1) : 0); if (theIndex < 1) { MVRangeError(theEnv,theIndex,theIndex,srclen+1,funcName); return(FALSE); } if (theIndex > (long) (srclen + 1)) theIndex = (long) (srclen + 1); dst->type = MULTIFIELD; dst->begin = 0; if (src == NULL) { if (field->type == MULTIFIELD) { DuplicateMultifield(theEnv,dst,field); AddToMultifieldList(theEnv,(struct multifield *) dst->value); } else { dst->value = EnvCreateMultifield(theEnv,0L); dst->end = 0; deptr = &((struct multifield *) dst->value)->theFields[0]; deptr->type = field->type; deptr->value = field->value; } return(TRUE); } dstlen = (field->type == MULTIFIELD) ? GetpDOLength(field) + srclen : srclen + 1; dst->value = EnvCreateMultifield(theEnv,dstlen); SetpDOEnd(dst,dstlen); theIndex--; for (i = 0 , j = src->begin ; i < theIndex ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } if (field->type != MULTIFIELD) { deptr = &((struct multifield *) dst->value)->theFields[theIndex]; deptr->type = field->type; deptr->value = field->value; i++; } else { for (k = field->begin ; k <= field->end ; k++ , i++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) field->value)->theFields[k]; deptr->type = septr->type; deptr->value = septr->value; } } for ( ; j <= src->end ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } return(TRUE); } /******************************************************* NAME : MVRangeError DESCRIPTION : Prints out an error messages for index out-of-range errors in multi-field access functions INPUTS : 1) The bad range start 2) The bad range end 3) The max end of the range (min is assumed to be 1) RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ******************************************************/ static void MVRangeError( void *theEnv, long brb, long bre, unsigned long max, char *funcName) { PrintErrorID(theEnv,"MULTIFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Multifield index "); if (brb == bre) PrintLongInteger(theEnv,WERROR,(long) brb); else { EnvPrintRouter(theEnv,WERROR,"range "); PrintLongInteger(theEnv,WERROR,(long) brb); EnvPrintRouter(theEnv,WERROR,".."); PrintLongInteger(theEnv,WERROR,(long) bre); } EnvPrintRouter(theEnv,WERROR," out of range 1.."); PrintLongInteger(theEnv,WERROR,(long) max); if (funcName != NULL) { EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,funcName); } EnvPrintRouter(theEnv,WERROR,".\n"); } /************************************************************************** NAME : DeleteMultiValueField DESCRIPTION : Performs a modify on the src multi-field value storing the results in the dst multi-field value INPUTS : 1) The destination value buffer 2) The source value (can be NULL) 3) The beginning index for deletion 4) The ending index for deletion RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Allocates and sets a ephemeral segment (even if new number of fields is 0) Src value segment is not changed NOTES : index is NOT guaranteed to be valid src is guaranteed to be a multi-field variable or NULL **************************************************************************/ globle int DeleteMultiValueField( void *theEnv, DATA_OBJECT *dst, DATA_OBJECT *src, long rb, long re, char *funcName) { register long i,j; register FIELD_PTR deptr,septr; unsigned long srclen, dstlen; srclen = (unsigned long) ((src != NULL) ? (src->end - src->begin + 1) : 0); if ((re < rb) || (rb < 1) || (re < 1) || (rb > ((long) srclen)) || (re > ((long) srclen))) { MVRangeError(theEnv,rb,re,srclen,funcName); return(FALSE); } dst->type = MULTIFIELD; dst->begin = 0; if (srclen == 0) { dst->value = EnvCreateMultifield(theEnv,0L); dst->end = -1; return(TRUE); } rb = src->begin + rb -1; re = src->begin + re -1; dstlen = srclen-(re-rb+1); SetpDOEnd(dst,dstlen); dst->value = EnvCreateMultifield(theEnv,dstlen); for (i = 0 , j = src->begin ; j < rb ; i++ , j++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } while (j < re) j++; for (j++ ; i <= dst->end ; j++ , i++) { deptr = &((struct multifield *) dst->value)->theFields[i]; septr = &((struct multifield *) src->value)->theFields[j]; deptr->type = septr->type; deptr->value = septr->value; } return(TRUE); } #endif clips-6.24/clipssrc/prcdrpsr.h0000755000175000017500000000462710441150556014554 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* PROCEDURAL FUNCTIONS PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_prcdrpsr #define _H_prcdrpsr #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _PRCDRPSR_SOURCE #define LOCALE #else #define LOCALE extern #endif struct BindInfo { struct symbolHashNode *name; CONSTRAINT_RECORD *constraints; struct BindInfo *next; }; #if (! RUN_TIME) LOCALE void ProceduralFunctionParsers(void *); LOCALE struct BindInfo *GetParsedBindNames(void *); LOCALE void SetParsedBindNames(void *,struct BindInfo *); LOCALE void ClearParsedBindNames(void *); LOCALE intBool ParsedBindNamesEmpty(void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int SearchParsedBindNames(void *,struct symbolHashNode *); LOCALE int CountParsedBindNames(void *); LOCALE void RemoveParsedBindName(void *,struct symbolHashNode *); LOCALE struct constraintRecord *FindBindConstraints(void *,struct symbolHashNode *); #endif #endif clips-6.24/clipssrc/._rulecmp.h0000400000175000017500000000012207422634623014555 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._classinf.h0000400000175000017500000000075410441130171014703 0ustar jfsjfsMac OS X  2 RTEXT????`aTTFH MonacoUkUklTTFSFMWBBMPSRclips-6.24/clipssrc/._genrcpsr.c0000400000175000017500000000075410441165573014735 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0z1TTF/B!*FMPSRMWBBLclips-6.24/clipssrc/parsefun.h0000755000175000017500000000317207422634603014537 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* PARSING FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several parsing related */ /* functions including... */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_parsefun #define _H_parsefun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _PARSEFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ParseFunctionDefinitions(void *); LOCALE void CheckSyntaxFunction(void *,DATA_OBJECT *); LOCALE int CheckSyntax(void *,char *,DATA_OBJECT_PTR); #endif clips-6.24/clipssrc/._msgfun.c0000400000175000017500000000452210441150070014370 0ustar jfsjfsMac OS X  2 R TEXTR*ch`anmsgfun.cntrol PanelTCmr.txt.docTEXTR*ch p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco\\:hnS #nGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/edstruct.c0000755000175000017500000020303307422634701014541 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ #include "setup.h" #if EMACS_EDITOR && ! RUN_TIME #define _EDSTRUCT_SOURCE_ #include "ed.h" #include /* ---------------------------- * Display management stuff * ---------------------------- */ typedef struct VIDEO { short v_flag; /* Flags */ char v_text[1]; /* Screen data. */ } VIDEO; #define VFCHG 0x0001 /* Changed. */ globle int mpresf = FALSE; /* TRUE if message in last line */ globle int sgarbf = TRUE; /* TRUE if screen is garbage */ static int vtrow = 0; /* Row location of SW cursor */ static int vtcol = 0; /* Column location of SW cursor */ static int ttrow = HUGE; /* Row location of HW cursor */ static int ttcol = HUGE; /* Column location of HW cursor */ static VIDEO **vscreen; /* Virtual screen. */ static VIDEO **pscreen; /* Physical screen. */ /* ---------------------------- * Line management stuff * ---------------------------- */ #define NBLOCK 16 /* Line block chunk size */ #define KBLOCK 256 /* Kill buffer block size */ static char *kbufp = NULL; /* Kill buffer data */ static int kused = 0; /* # of bytes used in KB */ static int ksize = 0; /* # of bytes allocated in KB */ static void int_to_ascii(char [],int,int); /* ========================================================================== * BUFFER MANAGEMENT FUNCTIONS * ========================================================================== */ /* * Some of the functions in this section are internal, and some are * actually attached to user keys. Like everyone else, they set hints * for the display system. */ /* * Attach a buffer to a window. The * values of dot and mark come from the buffer * if the use count is 0. Otherwise, they come * from some other window. */ #if IBM_TBC #pragma argsused #endif globle int usebuffer( void *theEnv, int f, int n) { register BUFFER *bp; register WINDOW *wp; register int s; char bufn[NBUFN]; char prompt[NBUFN + 15]; sprintf(prompt,"Use buffer [%s]: ",lastbufn); if ((s=mlreply(theEnv,prompt, bufn, NBUFN)) != TRUE) { if (( s == FALSE) && (strlen(lastbufn) != 0)) strcpy(bufn, lastbufn); else return (s); } if ((bp=bfind(theEnv,bufn, TRUE, 0)) == NULL) return (FALSE); strcpy(lastbufn, curbp->b_bname); /* Save current bufname */ if (--curbp->b_nwnd == 0) { /* Last use. */ curbp->b_dotp = curwp->w_dotp; curbp->b_doto = curwp->w_doto; curbp->b_markp = curwp->w_markp; curbp->b_marko = curwp->w_marko; } curbp = bp; /* Switch. */ curwp->w_bufp = bp; curwp->w_linep = bp->b_linep; /* For macros, ignored. */ curwp->w_flag |= WFMODE|WFFORCE|WFHARD; /* Quite nasty. */ if (bp->b_nwnd++ == 0) { /* First use. */ curwp->w_dotp = bp->b_dotp; curwp->w_doto = bp->b_doto; curwp->w_markp = bp->b_markp; curwp->w_marko = bp->b_marko; return (TRUE); } wp = wheadp; /* Look for old. */ while (wp != NULL) { if (wp!=curwp && wp->w_bufp==bp) { curwp->w_dotp = wp->w_dotp; curwp->w_doto = wp->w_doto; curwp->w_markp = wp->w_markp; curwp->w_marko = wp->w_marko; break; } wp = wp->w_wndp; } return (TRUE); } /* * Dispose of a buffer, by name. * Ask for the name. Look it up (don't get too * upset if it isn't there at all!). Get quite upset * if the buffer is being displayed. Clear the buffer (ask * if the buffer has been changed). Then free the header * line and the buffer header. Bound to "C-X K". */ #if IBM_TBC #pragma argsused #endif globle int killbuffer( void *theEnv, int f, int n) { register BUFFER *bp; register BUFFER *bp1; register BUFFER *bp2; register int s; char bufn[NBUFN]; if ((s=mlreply(theEnv,"Kill buffer: ", bufn, NBUFN)) != TRUE) return (s); if ((bp=bfind(theEnv,bufn, FALSE, 0)) == NULL) /* Easy if unknown. */ return (TRUE); if (bp->b_nwnd != 0) { /* Error if on screen. */ mlwrite("Buffer is being displayed"); return (FALSE); } if ((s=bclear(theEnv,bp)) != TRUE) /* Blow text away. */ return (s); genfree(theEnv,(void *) bp->b_linep,(unsigned) (sizeof(LINE) + bp->b_linep->l_size)); bp1 = NULL; /* Find the header. */ bp2 = bheadp; while (bp2 != bp) { bp1 = bp2; bp2 = bp2->b_bufp; } bp2 = bp2->b_bufp; /* Next one in chain. */ if (bp1 == NULL) /* Unlink it. */ bheadp = bp2; else bp1->b_bufp = bp2; genfree(theEnv,(void *) bp, (unsigned) sizeof(BUFFER)); /* Release buffer block */ mlwrite("Buffer Killed!"); return (TRUE); } /* * List all of the active * buffers. First update the special * buffer that holds the list. Next make * sure at least 1 window is displaying the * buffer list, splitting the screen if this * is what it takes. Lastly, repaint all of * the windows that are displaying the * list. Bound to "C-X C-B". */ #if IBM_TBC #pragma argsused #endif globle int listbuffers( void *theEnv, int f, int n) { register WINDOW *wp; register BUFFER *bp; register int s; if ((s=makelist(theEnv)) != TRUE) return (s); if (blistp->b_nwnd == 0) { /* Not on screen yet. */ if ((wp=wpopup(theEnv)) == NULL) return (FALSE); bp = wp->w_bufp; if (--bp->b_nwnd == 0) { bp->b_dotp = wp->w_dotp; bp->b_doto = wp->w_doto; bp->b_markp = wp->w_markp; bp->b_marko = wp->w_marko; } wp->w_bufp = blistp; ++blistp->b_nwnd; } wp = wheadp; while (wp != NULL) { if (wp->w_bufp == blistp) { wp->w_linep = lforw(blistp->b_linep); wp->w_dotp = lforw(blistp->b_linep); wp->w_doto = 0; wp->w_markp = NULL; wp->w_marko = 0; wp->w_flag |= WFMODE|WFHARD; } wp = wp->w_wndp; } return (TRUE); } /* * This routine rebuilds the * text in the special secret buffer * that holds the buffer list. It is called * by the list buffers command. Return TRUE * if everything works. Return FALSE if there * is an error (if there is no memory). */ globle int makelist( void *theEnv) { register char *cp1; register char *cp2; register int c; register BUFFER *bp; register LINE *lp; register int nbytes; register int s; char b[6+1]; char line[128]; blistp->b_flag &= ~BFCHG; /* Don't complain! */ if ((s=bclear(theEnv,blistp)) != TRUE) /* Blow old text away */ return (s); strcpy(blistp->b_fname, ""); if (addline(theEnv,blistp,"C Size Buffer File") == FALSE || addline(theEnv,blistp,"- ---- ------ ----") == FALSE) return (FALSE); bp = bheadp; /* For all buffers */ while (bp != NULL) { if ((bp->b_flag&BFTEMP) != 0) { /* Skip magic ones. */ bp = bp->b_bufp; continue; } cp1 = &line[0]; /* Start at left edge */ if ((bp->b_flag&BFCHG) != 0) /* "*" if changed */ *cp1++ = '*'; else *cp1++ = ' '; *cp1++ = ' '; /* Gap. */ nbytes = 0; /* Count bytes in buf. */ lp = lforw(bp->b_linep); while (lp != bp->b_linep) { nbytes += llength(lp)+1; lp = lforw(lp); } int_to_ascii(b, 6, nbytes); /* 6 digit buffer size. */ cp2 = &b[0]; while ((c = *cp2++) != 0) *cp1++ = (char) c; *cp1++ = ' '; /* Gap. */ cp2 = &bp->b_bname[0]; /* Buffer name */ while ((c = *cp2++) != 0) *cp1++ = (char) c; cp2 = &bp->b_fname[0]; /* File name */ if (*cp2 != 0) { while (cp1 < &line[1+1+6+1+NBUFN+1]) *cp1++ = ' '; while ((c = *cp2++) != 0) { if (cp1 < &line[128-1]) *cp1++ = (char) c; } } *cp1 = 0; /* Add to the buffer. */ if (addline(theEnv,blistp,line) == FALSE) return (FALSE); bp = bp->b_bufp; } return (TRUE); /* All done */ } /* * The argument "text" points to * a string. Append this line to the * buffer. Handcraft the EOL * on the end. Return TRUE if it worked and * FALSE if you ran out of room. */ globle int addline( void *theEnv, BUFFER *bufferp, char *text) { register LINE *lp; register int i; register int ntext; ntext = strlen(text); if ((lp=lalloc(theEnv,ntext)) == NULL) return (FALSE); for (i=0; ib_linep->l_bp->l_fp = lp; /* Hook onto the end */ lp->l_bp = bufferp->b_linep->l_bp; bufferp->b_linep->l_bp = lp; lp->l_fp = bufferp->b_linep; if (bufferp->b_dotp == bufferp->b_linep) /* If "." is at the end */ bufferp->b_dotp = lp; /* move it to new line */ return (TRUE); } /* * Look through the list of * buffers. Return TRUE if there * are any changed buffers. Buffers * that hold magic internal stuff are * not considered; who cares if the * list of buffer names is hacked. * Return FALSE if no buffers * have been changed. */ globle int anycb() { register BUFFER *bp; bp = bheadp; while (bp != NULL) { if ((bp->b_flag&BFTEMP)==0 && (bp->b_flag&BFCHG)!=0) return (TRUE); bp = bp->b_bufp; } return (FALSE); } /* * Find a buffer, by name. Return a pointer * to the BUFFER structure associated with it. If * the named buffer is found, but is a TEMP buffer (like * the buffer list) conplain. If the buffer is not found * and the "cflag" is TRUE, create it. The "bflag" is * the settings for the flags in in buffer. */ globle BUFFER *bfind( void *theEnv, char *bname, int cflag, int bflag) { register BUFFER *bp; register LINE *lp; bp = bheadp; while (bp != NULL) { if (strcmp(bname, bp->b_bname) == 0) { if ((bp->b_flag&BFTEMP) != 0) { mlwrite("Cannot select builtin buffer"); return (NULL); } return (bp); } bp = bp->b_bufp; } if (cflag != FALSE) { if ((bp=(BUFFER *)genalloc(theEnv,(unsigned) sizeof(BUFFER))) == NULL) return (NULL); if ((lp=lalloc(theEnv,0)) == NULL) { genfree(theEnv,(void *) bp,(unsigned) sizeof(BUFFER)); return (NULL); } bp->b_bufp = bheadp; bheadp = bp; bp->b_dotp = lp; bp->b_doto = 0; bp->b_markp = NULL; bp->b_marko = 0; bp->b_flag = (char) bflag; bp->b_nwnd = 0; bp->b_linep = lp; strcpy(bp->b_fname, ""); strcpy(bp->b_bname, bname); lp->l_fp = lp; lp->l_bp = lp; } return (bp); } /* * This routine blows away all of the text * in a buffer. If the buffer is marked as changed * then we ask if it is ok to blow it away; this is * to save the user the grief of losing text. The * window chain is nearly always wrong if this gets * called; the caller must arrange for the updates * that are required. Return TRUE if everything * looks good. */ globle int bclear( void *theEnv, BUFFER *bp) { register LINE *lp; register int s; if ((bp->b_flag&BFTEMP) == 0 /* Not scratch buffer. */ && (bp->b_flag&BFCHG) != 0 /* Something changed */ && (s=mlyesno(theEnv,"Discard changes")) != TRUE) return (s); bp->b_flag &= ~BFCHG; /* Not changed */ while ((lp=lforw(bp->b_linep)) != bp->b_linep) lfree(theEnv,lp); bp->b_dotp = bp->b_linep; /* Fix "." */ bp->b_doto = 0; bp->b_markp = NULL; /* Invalidate "mark" */ bp->b_marko = 0; return (TRUE); } /* ========================================================================== * LINE MANAGEMENT FUNCTIONS * ========================================================================== */ /* * The functions in this section are a general set of line management utilities. * They are the only routines that touch the text. They also touch the buffer * and window structures, to make sure that the necessary updating gets done. * There are routines in this section that handle the kill buffer too. It isn't * here for any good reason. * * Note that this code only updates the dot and mark values in the window list. * Since all the code acts on the current window, the buffer that we are * editing must be being displayed, which means that "b_nwnd" is non zero, * which means that the dot and mark values in the buffer headers are nonsense. */ /* * This routine allocates a block of memory large enough to hold a LINE * containing "used" characters. The block is always rounded up a bit. Return * a pointer to the new block, or NULL if there isn't any memory left. Print a * message in the message line if no space. */ globle LINE *lalloc( void *theEnv, int used) { register LINE *lp; register int size; size = (used+NBLOCK-1) & ~(NBLOCK-1); if (size == 0) /* Assume that an empty */ size = NBLOCK; /* line is for type-in. */ lp = (LINE *) genalloc(theEnv,(unsigned) sizeof(LINE)+size); lp->l_size = size; lp->l_used = used; return (lp); } /* * Delete line "lp". Fix all of the links that might point at it (they are * moved to offset 0 of the next line. Unlink the line from whatever buffer it * might be in. Release the memory. The buffers are updated too; the magic * conditions described in the above comments don't hold here. */ globle void lfree( void *theEnv, LINE *lp) { register BUFFER *bp; register WINDOW *wp; wp = wheadp; while (wp != NULL) { if (wp->w_linep == lp) wp->w_linep = lp->l_fp; if (wp->w_dotp == lp) { wp->w_dotp = lp->l_fp; wp->w_doto = 0; } if (wp->w_markp == lp) { wp->w_markp = lp->l_fp; wp->w_marko = 0; } wp = wp->w_wndp; } bp = bheadp; while (bp != NULL) { if (bp->b_nwnd == 0) { if (bp->b_dotp == lp) { bp->b_dotp = lp->l_fp; bp->b_doto = 0; } if (bp->b_markp == lp) { bp->b_markp = lp->l_fp; bp->b_marko = 0; } } bp = bp->b_bufp; } lp->l_bp->l_fp = lp->l_fp; lp->l_fp->l_bp = lp->l_bp; genfree(theEnv,(void *) lp, (unsigned) (sizeof(LINE) + lp->l_size)); } /* * This routine gets called when a character is changed in place in the current * buffer. It updates all of the required flags in the buffer and window * system. The flag used is passed as an argument; if the buffer is being * displayed in more than 1 window we change EDIT t HARD. Set MODE if the * mode line needs to be updated (the "*" has to be set). */ globle void lchange( int flag) { register WINDOW *wp; if (curbp->b_nwnd != 1) /* Ensure hard. */ flag = WFHARD; if ((curbp->b_flag&BFCHG) == 0) { /* First change, so */ flag |= WFMODE; /* update mode lines. */ curbp->b_flag |= BFCHG; } wp = wheadp; while (wp != NULL) { if (wp->w_bufp == curbp) wp->w_flag |= flag; wp = wp->w_wndp; } } /* * Insert "n" copies of the character "c" at the current location of dot. In * the easy case all that happens is the text is stored in the line. In the * hard case, the line has to be reallocated. When the window list is updated, * take special care; I screwed it up once. You always update dot in the * current window. You update mark, and a dot in another window, if it is * greater than the place where you did the insert. Return TRUE if all is * well, and FALSE on errors. */ globle int linsert( void *theEnv, int n, int c) { register char *cp1; register char *cp2; register LINE *lp1; register LINE *lp2; register LINE *lp3; register int doto; register int i; register WINDOW *wp; lchange(WFEDIT); lp1 = curwp->w_dotp; /* Current line */ if (lp1 == curbp->b_linep) { /* At the end: special */ if (curwp->w_doto != 0) { mlwrite("bug: linsert"); return (FALSE); } if ((lp2=lalloc(theEnv,n)) == NULL) /* Allocate new line */ return (FALSE); lp3 = lp1->l_bp; /* Previous line */ lp3->l_fp = lp2; /* Link in */ lp2->l_fp = lp1; lp1->l_bp = lp2; lp2->l_bp = lp3; for (i=0; il_text[i] = (char) c; curwp->w_dotp = lp2; curwp->w_doto = n; return (TRUE); } doto = curwp->w_doto; /* Save for later. */ if (lp1->l_used+n > lp1->l_size) { /* Hard: reallocate */ if ((lp2=lalloc(theEnv,lp1->l_used+n)) == NULL) return (FALSE); cp1 = &lp1->l_text[0]; cp2 = &lp2->l_text[0]; while (cp1 != &lp1->l_text[doto]) *cp2++ = *cp1++; cp2 += n; while (cp1 != &lp1->l_text[lp1->l_used]) *cp2++ = *cp1++; lp1->l_bp->l_fp = lp2; lp2->l_fp = lp1->l_fp; lp1->l_fp->l_bp = lp2; lp2->l_bp = lp1->l_bp; genfree(theEnv,(void *) lp1, (unsigned) (sizeof(LINE) + lp1->l_size)); } else { /* Easy: in place */ lp2 = lp1; /* Pretend new line */ lp2->l_used += n; cp2 = &lp1->l_text[lp1->l_used]; cp1 = cp2-n; while (cp1 != &lp1->l_text[doto]) *--cp2 = *--cp1; } for (i=0; il_text[doto+i] = (char) c; wp = wheadp; /* Update windows */ while (wp != NULL) { if (wp->w_linep == lp1) wp->w_linep = lp2; if (wp->w_dotp == lp1) { wp->w_dotp = lp2; if (wp==curwp || wp->w_doto>doto) wp->w_doto += n; } if (wp->w_markp == lp1) { wp->w_markp = lp2; if (wp->w_marko > doto) wp->w_marko += n; } wp = wp->w_wndp; } return (TRUE); } /* * Insert a newline into the buffer at the current location of dot in the * current window. The funny ass-backwards way it does things is not a botch; * it just makes the last line in the file not a special case. Return TRUE if * everything works out and FALSE on error (memory allocation failure). The * update of dot and mark is a bit easier then in the above case, because the * split forces more updating. */ globle int lnewline( void *theEnv) { register char *cp1; register char *cp2; register LINE *lp1; register LINE *lp2; register int doto; register WINDOW *wp; lchange(WFHARD); lp1 = curwp->w_dotp; /* Get the address and */ doto = curwp->w_doto; /* offset of "." */ if ((lp2=lalloc(theEnv,doto)) == NULL) /* New first half line */ return (FALSE); cp1 = &lp1->l_text[0]; /* Shuffle text around */ cp2 = &lp2->l_text[0]; while (cp1 != &lp1->l_text[doto]) *cp2++ = *cp1++; cp2 = &lp1->l_text[0]; while (cp1 != &lp1->l_text[lp1->l_used]) *cp2++ = *cp1++; lp1->l_used -= doto; lp2->l_bp = lp1->l_bp; lp1->l_bp = lp2; lp2->l_bp->l_fp = lp2; lp2->l_fp = lp1; wp = wheadp; /* Windows */ while (wp != NULL) { if (wp->w_linep == lp1) wp->w_linep = lp2; if (wp->w_dotp == lp1) { if (wp->w_doto < doto) wp->w_dotp = lp2; else wp->w_doto -= doto; } if (wp->w_markp == lp1) { if (wp->w_marko < doto) wp->w_markp = lp2; else wp->w_marko -= doto; } wp = wp->w_wndp; } return (TRUE); } /* * This function deletes "n" bytes, starting at dot. It understands how do deal * with end of lines, etc. It returns TRUE if all of the characters were * deleted, and FALSE if they were not (because dot ran into the end of the * buffer. The "kflag" is TRUE if the text should be put in the kill buffer. */ globle int ldelete( void *theEnv, long n, int kflag) { register char *cp1; register char *cp2; register LINE *dotp; register int doto; register int chunk; register WINDOW *wp; while (n != 0) { dotp = curwp->w_dotp; doto = curwp->w_doto; if (dotp == curbp->b_linep) /* Hit end of buffer. */ return (FALSE); chunk = dotp->l_used-doto; /* Size of chunk. */ if (chunk > (int) n) chunk = (int) n; if (chunk == 0) { /* End of line, merge. */ lchange(WFHARD); if (ldelnewline(theEnv) == FALSE || (kflag!=FALSE && kinsert(theEnv,'\n')==FALSE)) return (FALSE); --n; continue; } lchange(WFEDIT); cp1 = &dotp->l_text[doto]; /* Scrunch text. */ cp2 = cp1 + chunk; if (kflag != FALSE) { /* Kill? */ while (cp1 != cp2) { if (kinsert(theEnv,*cp1) == FALSE) return (FALSE); ++cp1; } cp1 = &dotp->l_text[doto]; } while (cp2 != &dotp->l_text[dotp->l_used]) *cp1++ = *cp2++; dotp->l_used -= chunk; wp = wheadp; /* Fix windows */ while (wp != NULL) { if (wp->w_dotp==dotp && wp->w_doto>=doto) { wp->w_doto -= chunk; if (wp->w_doto < doto) wp->w_doto = doto; } if (wp->w_markp==dotp && wp->w_marko>=doto) { wp->w_marko -= chunk; if (wp->w_marko < doto) wp->w_marko = doto; } wp = wp->w_wndp; } n -= chunk; } return (TRUE); } /* * Delete a newline. Join the current line with the next line. If the next line * is the magic header line always return TRUE; merging the last line with the * header line can be thought of as always being a successful operation, even * if nothing is done, and this makes the kill buffer work "right". Easy cases * can be done by shuffling data around. Hard cases require that lines be moved * about in memory. Return FALSE on error and TRUE if all looks ok. Called by * "ldelete" only. */ globle int ldelnewline( void *theEnv) { register char *cp1; register char *cp2; register LINE *lp1; register LINE *lp2; register LINE *lp3; register WINDOW *wp; lp1 = curwp->w_dotp; lp2 = lp1->l_fp; if (lp2 == curbp->b_linep) { /* At the buffer end. */ if (lp1->l_used == 0) /* Blank line. */ lfree(theEnv,lp1); return (TRUE); } if (lp2->l_used <= lp1->l_size-lp1->l_used) { cp1 = &lp1->l_text[lp1->l_used]; cp2 = &lp2->l_text[0]; while (cp2 != &lp2->l_text[lp2->l_used]) *cp1++ = *cp2++; wp = wheadp; while (wp != NULL) { if (wp->w_linep == lp2) wp->w_linep = lp1; if (wp->w_dotp == lp2) { wp->w_dotp = lp1; wp->w_doto += lp1->l_used; } if (wp->w_markp == lp2) { wp->w_markp = lp1; wp->w_marko += lp1->l_used; } wp = wp->w_wndp; } lp1->l_used += lp2->l_used; lp1->l_fp = lp2->l_fp; lp2->l_fp->l_bp = lp1; genfree(theEnv,(void *) lp2, (unsigned) (sizeof(LINE) + lp2->l_size)); return (TRUE); } if ((lp3=lalloc(theEnv,lp1->l_used+lp2->l_used)) == NULL) return (FALSE); cp1 = &lp1->l_text[0]; cp2 = &lp3->l_text[0]; while (cp1 != &lp1->l_text[lp1->l_used]) *cp2++ = *cp1++; cp1 = &lp2->l_text[0]; while (cp1 != &lp2->l_text[lp2->l_used]) *cp2++ = *cp1++; lp1->l_bp->l_fp = lp3; lp3->l_fp = lp2->l_fp; lp2->l_fp->l_bp = lp3; lp3->l_bp = lp1->l_bp; wp = wheadp; while (wp != NULL) { if (wp->w_linep==lp1 || wp->w_linep==lp2) wp->w_linep = lp3; if (wp->w_dotp == lp1) wp->w_dotp = lp3; else if (wp->w_dotp == lp2) { wp->w_dotp = lp3; wp->w_doto += lp1->l_used; } if (wp->w_markp == lp1) wp->w_markp = lp3; else if (wp->w_markp == lp2) { wp->w_markp = lp3; wp->w_marko += lp1->l_used; } wp = wp->w_wndp; } genfree(theEnv,(void *) lp1, (unsigned) (sizeof(LINE) + lp1->l_size)); genfree(theEnv,(void *) lp2, (unsigned) (sizeof(LINE) + lp2->l_size)); return (TRUE); } /* * Delete all of the text saved in the kill buffer. Called by commands when a * new kill context is being created. The kill buffer array is released, just * in case the buffer has grown to immense size. No errors. */ globle void kdelete( void *theEnv) { if (kbufp != NULL) { genfree(theEnv,(void *) kbufp, (unsigned) ksize); kbufp = NULL; kused = 0; ksize = 0; } } /* * Insert a character to the kill buffer, enlarging the buffer if there isn't * any room. Always grow the buffer in chunks, on the assumption that if you * put something in the kill buffer you are going to put more stuff there too * later. Return TRUE if all is well, and FALSE on errors. */ globle int kinsert( void *theEnv, int c) { #if IBM_MSC || IBM_TBC || IBM_ICB char far *nbufp; #else register char *nbufp; #endif register int i; if (kused == ksize) { if ((nbufp= (char *) genalloc(theEnv,(unsigned) ksize+KBLOCK)) == NULL) return (FALSE); for (i=0; i= kused) return (-1); else return (kbufp[n] & 0xFF); } /* ========================================================================== * WINDOW MANAGEMENT FUNCTIONS * ========================================================================== */ /* * Again, some of these functions are internal, and some are * attached to keys that the user actually types. */ /* * Reposition dot in the current window to line "n". If the argument is * positive, it is that line. If it is negative it is that line from the * bottom. If it is 0 the window is centered (this is what the standard * redisplay code does). With no argument it defaults to 1. Bound to M-!. * Because of the default, it works like in Gosling. */ #if IBM_TBC #pragma argsused #endif globle int reposition( void *theEnv, int f, int n) { curwp->w_force = (char) n; curwp->w_flag |= WFFORCE; return (TRUE); } /* * Refresh the screen. With no argument, it just does the refresh. With an * argument it recenters "." in the current window. Bound to "C-L". */ #if IBM_TBC #pragma argsused #endif globle int EditorRefresh( void *theEnv, int f, int n) { if (f == FALSE) sgarbf = TRUE; else { curwp->w_force = 0; /* Center dot. */ curwp->w_flag |= WFFORCE; } return (TRUE); } /* * The command make the next window (next => down the screen) the current * window. There are no real errors, although the command does nothing if * there is only 1 window on the screen. Bound to "C-X C-N". */ #if IBM_TBC #pragma argsused #endif globle int nextwind( void *theEnv, int f, int n) { register WINDOW *wp; if ((wp = curwp->w_wndp) == NULL) wp = wheadp; curwp = wp; curbp = wp->w_bufp; return (TRUE); } /* * This command makes the previous window (previous => up the screen) the * current window. There arn't any errors, although the command does not do a * lot if there is 1 window. */ #if IBM_TBC #pragma argsused #endif globle int prevwind( void *theEnv, int f, int n) { register WINDOW *wp1; register WINDOW *wp2; wp1 = wheadp; wp2 = curwp; if (wp1 == wp2) wp2 = NULL; while (wp1->w_wndp != wp2) wp1 = wp1->w_wndp; curwp = wp1; curbp = wp1->w_bufp; return (TRUE); } /* * This command moves the current window down by "arg" lines. Recompute the * top line in the window. The move up and move down code is almost completely * the same; most of the work has to do with reframing the window, and picking * a new dot. We share the code by having "move down" just be an interface to * "move up". Magic. Bound to "C-X C-N". */ globle int mvdnwind( void *theEnv, int f, int n) { return (mvupwind(theEnv,f, -n)); } /* * Move the current window up by "arg" lines. Recompute the new top line of * the window. Look to see if "." is still on the screen. If it is, you win. * If it isn't, then move "." to center it in the new framing of the window * (this command does not really move "."; it moves the frame). Bound to * "C-X C-P". */ #if IBM_TBC #pragma argsused #endif globle int mvupwind( void *theEnv, int f, int n) { register LINE *lp; register int i; lp = curwp->w_linep; if (n < 0) { while (n++ && lp!=curbp->b_linep) lp = lforw(lp); } else { while (n-- && lback(lp)!=curbp->b_linep) lp = lback(lp); } curwp->w_linep = lp; curwp->w_flag |= WFHARD; /* Mode line is OK. */ for (i = 0; i < curwp->w_ntrows; ++i) { if (lp == curwp->w_dotp) return (TRUE); if (lp == curbp->b_linep) break; lp = lforw(lp); } lp = curwp->w_linep; i = curwp->w_ntrows/2; while (i-- && lp != curbp->b_linep) lp = lforw(lp); curwp->w_dotp = lp; curwp->w_doto = 0; return (TRUE); } /* * This command makes the current window the only window on the screen. Bound * to "C-X 1". Try to set the framing so that "." does not have to move on the * display. Some care has to be taken to keep the values of dot and mark in * the buffer structures right if the distruction of a window makes a buffer * become undisplayed. */ #if IBM_TBC #pragma argsused #endif globle int onlywind( void *theEnv, int f, int n) { register WINDOW *wp; register LINE *lp; register int i; while (wheadp != curwp) { wp = wheadp; wheadp = wp->w_wndp; if (--wp->w_bufp->b_nwnd == 0) { wp->w_bufp->b_dotp = wp->w_dotp; wp->w_bufp->b_doto = wp->w_doto; wp->w_bufp->b_markp = wp->w_markp; wp->w_bufp->b_marko = wp->w_marko; } genfree(theEnv,(void *) wp, (unsigned) sizeof(WINDOW)); } while (curwp->w_wndp != NULL) { wp = curwp->w_wndp; curwp->w_wndp = wp->w_wndp; if (--wp->w_bufp->b_nwnd == 0) { wp->w_bufp->b_dotp = wp->w_dotp; wp->w_bufp->b_doto = wp->w_doto; wp->w_bufp->b_markp = wp->w_markp; wp->w_bufp->b_marko = wp->w_marko; } genfree(theEnv,(void *) wp, (unsigned) sizeof(WINDOW)); } lp = curwp->w_linep; i = curwp->w_toprow; while (i!=0 && lback(lp)!=curbp->b_linep) { --i; lp = lback(lp); } curwp->w_toprow = 0; curwp->w_ntrows = (char) (term.t_nrow-1); curwp->w_linep = lp; curwp->w_flag |= WFMODE|WFHARD; return (TRUE); } /* * Split the current window. A window smaller than 3 lines cannot be split. * The only other error that is possible is a "malloc" failure allocating the * structure for the new window. Bound to "C-X 2". */ #if IBM_TBC #pragma argsused #endif globle int splitwind( void *theEnv, int f, int n) { register WINDOW *wp; register LINE *lp; register int ntru; register int ntrl; register int ntrd; register WINDOW *wp1; register WINDOW *wp2; if (curwp->w_ntrows < 3) { mlwrite("Cannot split a %d line window", curwp->w_ntrows); return (FALSE); } if ((wp = (WINDOW *) genalloc(theEnv,(unsigned) sizeof(WINDOW))) == NULL) { mlwrite("Cannot allocate WINDOW block"); return (FALSE); } ++curbp->b_nwnd; /* Displayed twice. */ wp->w_bufp = curbp; wp->w_dotp = curwp->w_dotp; wp->w_doto = curwp->w_doto; wp->w_markp = curwp->w_markp; wp->w_marko = curwp->w_marko; wp->w_flag = 0; wp->w_force = 0; ntru = (curwp->w_ntrows-1) / 2; /* Upper size */ ntrl = (curwp->w_ntrows-1) - ntru; /* Lower size */ lp = curwp->w_linep; ntrd = 0; while (lp != curwp->w_dotp) { ++ntrd; lp = lforw(lp); } lp = curwp->w_linep; if (ntrd <= ntru) { /* Old is upper window. */ if (ntrd == ntru) /* Hit mode line. */ lp = lforw(lp); curwp->w_ntrows = (char) ntru; wp->w_wndp = curwp->w_wndp; curwp->w_wndp = wp; wp->w_toprow = curwp->w_toprow+ntru+1; wp->w_ntrows = (char) ntrl; } else { /* Old is lower window */ wp1 = NULL; wp2 = wheadp; while (wp2 != curwp) { wp1 = wp2; wp2 = wp2->w_wndp; } if (wp1 == NULL) wheadp = wp; else wp1->w_wndp = wp; wp->w_wndp = curwp; wp->w_toprow = curwp->w_toprow; wp->w_ntrows = (char) ntru; ++ntru; /* Mode line. */ curwp->w_toprow += (char) ntru; curwp->w_ntrows = (char) ntrl; while (ntru--) lp = lforw(lp); } curwp->w_linep = lp; /* Adjust the top lines */ wp->w_linep = lp; /* if necessary. */ curwp->w_flag |= WFMODE|WFHARD; wp->w_flag |= WFMODE|WFHARD; return (TRUE); } /* * Enlarge the current window. Find the window that loses space. Make sure it * is big enough. If so, hack the window descriptions, and ask redisplay to do * all the hard work. You don't just set "force reframe" because dot would * move. Bound to "C-X Z". */ globle int enlargewind( void *theEnv, int f, int n) { register WINDOW *adjwp; register LINE *lp; register int i; if (n < 0) return (shrinkwind(theEnv,f, -n)); if (wheadp->w_wndp == NULL) { mlwrite("Only one window"); return (FALSE); } if ((adjwp=curwp->w_wndp) == NULL) { adjwp = wheadp; while (adjwp->w_wndp != curwp) adjwp = adjwp->w_wndp; } if (adjwp->w_ntrows <= (char) n) { mlwrite("Impossible change"); return (FALSE); } if (curwp->w_wndp == adjwp) { /* Shrink below. */ lp = adjwp->w_linep; for (i=0; iw_bufp->b_linep; ++i) lp = lforw(lp); adjwp->w_linep = lp; adjwp->w_toprow += (char) n; } else { /* Shrink above. */ lp = curwp->w_linep; for (i=0; ib_linep; ++i) lp = lback(lp); curwp->w_linep = lp; curwp->w_toprow -= (char) n; } curwp->w_ntrows += (char) n; adjwp->w_ntrows -= (char) n; curwp->w_flag |= WFMODE|WFHARD; adjwp->w_flag |= WFMODE|WFHARD; return (TRUE); } /* * Shrink the current window. Find the window that gains space. Hack at the * window descriptions. Ask the redisplay to do all the hard work. Bound to * "C-X C-Z". */ globle int shrinkwind( void *theEnv, int f, int n) { register WINDOW *adjwp; register LINE *lp; register int i; if (n < 0) return (enlargewind(theEnv,f, -n)); if (wheadp->w_wndp == NULL) { mlwrite("Only one window"); return (FALSE); } if ((adjwp=curwp->w_wndp) == NULL) { adjwp = wheadp; while (adjwp->w_wndp != curwp) adjwp = adjwp->w_wndp; } if (curwp->w_ntrows <= (char) n) { mlwrite("Impossible change"); return (FALSE); } if (curwp->w_wndp == adjwp) { /* Grow below. */ lp = adjwp->w_linep; for (i=0; iw_bufp->b_linep; ++i) lp = lback(lp); adjwp->w_linep = lp; adjwp->w_toprow -= (char) n; } else { /* Grow above. */ lp = curwp->w_linep; for (i=0; ib_linep; ++i) lp = lforw(lp); curwp->w_linep = lp; curwp->w_toprow += (char) n; } curwp->w_ntrows -= (char) n; adjwp->w_ntrows += (char) n; curwp->w_flag |= WFMODE|WFHARD; adjwp->w_flag |= WFMODE|WFHARD; return (TRUE); } /* * Pick a window for a pop-up. Split the screen if there is only one window. * Pick the uppermost window that isn't the current window. An LRU algorithm * might be better. Return a pointer, or NULL on error. */ globle WINDOW *wpopup( void *theEnv) { register WINDOW *wp; if (wheadp->w_wndp == NULL /* Only 1 window */ && splitwind(theEnv,FALSE, 0) == FALSE) /* and it won't split */ return (NULL); wp = wheadp; /* Find window to use */ while (wp!=NULL && wp==curwp) wp = wp->w_wndp; return (wp); } /* ========================================================================== * DISPLAY MANAGEMENT FUNCTIONS * ========================================================================== */ /* * The functions in this section handle redisplay. There are two halves, the * ones that update the virtual display screen, and the ones that make the * physical display screen the same as the virtual display screen. These * functions use hints that are left in the windows by the commands. * * REVISION HISTORY: * * ? Steve Wilhite, 1-Dec-85 * - massive cleanup on code. */ #define WFDEBUG 0 /* Window flag debug. */ /* * Initialize the data structures used by the display code. The edge vectors * used to access the screens are set up. The operating system's terminal I/O * channel is set up. All the other things get initialized at compile time. * The original window has "WFCHG" set, so that it will get completely * redrawn on the first call to "update". */ globle void vtinit( void *theEnv) { register int i; register VIDEO *vp; (*term.t_open)(); vscreen = (VIDEO **) genalloc(theEnv,(unsigned) term.t_nrow*sizeof(VIDEO *)); if (vscreen == NULL) exit(1); pscreen = (VIDEO **) genalloc(theEnv,(unsigned) term.t_nrow*sizeof(VIDEO *)); if (pscreen == NULL) exit(1); for (i = 0; i < term.t_nrow; ++i) { vp = (VIDEO *) genalloc(theEnv,(unsigned) sizeof(VIDEO)+term.t_ncol); if (vp == NULL) exit(1); vscreen[i] = vp; vp = (VIDEO *) genalloc(theEnv,(unsigned) sizeof(VIDEO)+term.t_ncol); if (vp == NULL) exit(1); pscreen[i] = vp; } } /* * Clean up the virtual terminal system, in anticipation for a return to the * operating system. Move down to the last line and clear it out (the next * system prompt will be written in the line). Shut down the channel to the * terminal. */ globle void vttidy() { movecursor(term.t_nrow, 0); (*term.t_eeol)(); (*term.t_close)(); } /* * Set the virtual cursor to the specified row and column on the virtual * screen. There is no checking for nonsense values; this might be a good * idea during the early stages. */ globle void vtmove( int row, int col) { vtrow = row; vtcol = col; } /* * Write a character to the virtual screen. The virtual row and column are * updated. If the line is too long put a "$" in the last column. This routine * only puts printing characters into the virtual terminal buffers. Only * column overflow is checked. */ globle void vtputc( int c) { register VIDEO *vp; vp = vscreen[vtrow]; if (vtcol >= term.t_ncol) vp->v_text[term.t_ncol - 1] = '$'; else if (c == '\t') { do { vtputc(' '); } while ((vtcol&0x07) != 0); } else if (c < 0x20 || c == 0x7F) { vtputc('^'); vtputc(c ^ 0x40); } else vp->v_text[vtcol++] = (char) c; } /* * Erase from the end of the software cursor to the end of the line on which * the software cursor is located. */ globle void vteeol() { register VIDEO *vp; vp = vscreen[vtrow]; while (vtcol < term.t_ncol) vp->v_text[vtcol++] = ' '; } /* * Make sure that the display is right. This is a three part process. First, * scan through all of the windows looking for dirty ones. Check the framing, * and refresh the screen. Second, make sure that "currow" and "curcol" are * correct for the current window. Third, make the virtual and physical * screens the same. */ globle void update() { register LINE *lp; register WINDOW *wp; register VIDEO *vp1; register VIDEO *vp2; register int i; register int j; register int c; wp = wheadp; while (wp != NULL) { /* Look at any window with update flags set on. */ if (wp->w_flag != 0) { /* If not force reframe, check the framing. */ if ((wp->w_flag & WFFORCE) == 0) { lp = wp->w_linep; for (i = 0; i < wp->w_ntrows; ++i) { if (lp == wp->w_dotp) goto out; if (lp == wp->w_bufp->b_linep) break; lp = lforw(lp); } } /* Not acceptable, better compute a new value for the line at the * top of the window. Then set the "WFHARD" flag to force full * redraw. */ i = wp->w_force; if (i > 0) { --i; if (i >= wp->w_ntrows) i = wp->w_ntrows-1; } else if (i < 0) { i += wp->w_ntrows; if (i < 0) i = 0; } else i = wp->w_ntrows/2; lp = wp->w_dotp; while (i != 0 && lback(lp) != wp->w_bufp->b_linep) { --i; lp = lback(lp); } wp->w_linep = lp; wp->w_flag |= WFHARD; /* Force full. */ out: /* Try to use reduced update. Mode line update has its own special * flag. The fast update is used if the only thing to do is within * the line editing. */ lp = wp->w_linep; i = wp->w_toprow; if ((wp->w_flag & ~WFMODE) == WFEDIT) { while (lp != wp->w_dotp) { ++i; lp = lforw(lp); } vscreen[i]->v_flag |= VFCHG; vtmove(i, 0); for (j = 0; j < llength(lp); ++j) vtputc(lgetc(lp, j)); vteeol(); } else if ((wp->w_flag & (WFEDIT | WFHARD)) != 0) { while (i < wp->w_toprow+wp->w_ntrows) { vscreen[i]->v_flag |= VFCHG; vtmove(i, 0); if (lp != wp->w_bufp->b_linep) { for (j = 0; j < llength(lp); ++j) vtputc(lgetc(lp, j)); lp = lforw(lp); } vteeol(); ++i; } } #if ~WFDEBUG if ((wp->w_flag&WFMODE) != 0) modeline(wp); wp->w_flag = 0; wp->w_force = 0; #endif } #if WFDEBUG modeline(wp); wp->w_flag = 0; wp->w_force = 0; #endif wp = wp->w_wndp; } /* Always recompute the row and column number of the hardware cursor. This * is the only update for simple moves. */ lp = curwp->w_linep; currow = curwp->w_toprow; while (lp != curwp->w_dotp) { ++currow; lp = lforw(lp); } curcol = 0; i = 0; while (i < curwp->w_doto) { c = lgetc(lp, i++); if (c == '\t') curcol |= 0x07; else if (c < 0x20 || c == 0x7F) ++curcol; ++curcol; } /*sprintf(prompt,"Currow: %d curcol: %d w_toprow: %d", currow, getccol(FALSE), curwp->w_toprow); mlwrite(prompt);*/ if (curcol >= term.t_ncol) /* Long line. */ curcol = term.t_ncol-1; /* Special hacking if the screen is garbage. Clear the hardware screen, * and update your copy to agree with it. Set all the virtual screen * change bits, to force a full update. */ if (sgarbf != FALSE) { for (i = 0; i < term.t_nrow; ++i) { vscreen[i]->v_flag |= VFCHG; vp1 = pscreen[i]; for (j = 0; j < term.t_ncol; ++j) vp1->v_text[j] = ' '; } movecursor(0, 0); /* Erase the screen. */ (*term.t_eeop)(); sgarbf = FALSE; /* Erase-page clears */ mpresf = FALSE; /* the message area. */ } /* Make sure that the physical and virtual displays agree. Unlike before, * the "updateline" code is only called with a line that has been updated * for sure. */ for (i = 0; i < term.t_nrow; ++i) { vp1 = vscreen[i]; if ((vp1->v_flag&VFCHG) != 0) { vp1->v_flag &= ~VFCHG; vp2 = pscreen[i]; updateline(i, &vp1->v_text[0], &vp2->v_text[0]); } } /* Finally, update the hardware cursor and flush out buffers. */ movecursor(currow, curcol); (*term.t_flush)(); } /* * Update a single line. This does not know how to use insert or delete * character sequences; we are using VT52 functionality. Update the physical * row and column variables. It does try an exploit erase to end of line. The * RAINBOW version of this routine uses fast video. */ globle void updateline( int row, char vline[], char pline[]) { register char *cp1; register char *cp2; register char *cp3; register char *cp4; register char *cp5; register int nbflag; cp1 = &vline[0]; /* Compute left match. */ cp2 = &pline[0]; while (cp1!=&vline[term.t_ncol] && cp1[0]==cp2[0]) { ++cp1; ++cp2; } /* This can still happen, even though we only call this routine on changed * lines. A hard update is always done when a line splits, a massive * change is done, or a buffer is displayed twice. This optimizes out most * of the excess updating. A lot of computes are used, but these tend to * be hard operations that do a lot of update, so I don't really care. */ if (cp1 == &vline[term.t_ncol]) /* All equal. */ return; nbflag = FALSE; cp3 = &vline[term.t_ncol]; /* Compute right match. */ cp4 = &pline[term.t_ncol]; while (cp3[-1] == cp4[-1]) { --cp3; --cp4; if (cp3[0] != ' ') /* Note if any nonblank */ nbflag = TRUE; /* in right match. */ } cp5 = cp3; if (nbflag == FALSE) /* Erase to EOL ? */ { while (cp5!=cp1 && cp5[-1]==' ') --cp5; if (cp3-cp5 <= 3) /* Use only if erase is */ cp5 = cp3; /* fewer characters. */ } movecursor(row, (int) (cp1-&vline[0])); /* Go to start of line. */ while (cp1 != cp5) /* Ordinary. */ { (*term.t_putchar)(*cp1); ++ttcol; *cp2++ = *cp1++; } if (cp5 != cp3) /* Erase. */ { (*term.t_eeol)(); while (cp1 != cp3) *cp2++ = *cp1++; } } /* * Redisplay the mode line for the window pointed to by the "wp". This is the * only routine that has any idea of how the modeline is formatted. You can * change the modeline format by hacking at this routine. Called by "update" * any time there is a dirty window. */ globle void modeline( WINDOW *wp) { register char *cp; register int c; register int n; register BUFFER *bp; n = wp->w_toprow+wp->w_ntrows; /* Location. */ vscreen[n]->v_flag |= VFCHG; /* Redraw next time. */ vtmove(n, 0); /* Seek to right line. */ vtputc('-'); bp = wp->w_bufp; if ((bp->b_flag&BFCHG) != 0) /* "*" if changed. */ vtputc('*'); else vtputc('-'); n = 2; cp = " MicroEMACS -- "; while ((c = *cp++) != 0) { vtputc(c); ++n; } cp = &bp->b_bname[0]; while ((c = *cp++) != 0) { vtputc(c); ++n; } vtputc(' '); ++n; if (bp->b_fname[0] != 0) /* File name. */ { cp = "-- File: "; while ((c = *cp++) != 0) { vtputc(c); ++n; } cp = &bp->b_fname[0]; while ((c = *cp++) != 0) { vtputc(c); ++n; } vtputc(' '); ++n; } #if WFDEBUG vtputc('-'); vtputc((wp->w_flag&WFMODE)!=0 ? 'M' : '-'); vtputc((wp->w_flag&WFHARD)!=0 ? 'H' : '-'); vtputc((wp->w_flag&WFEDIT)!=0 ? 'E' : '-'); vtputc((wp->w_flag&WFMOVE)!=0 ? 'V' : '-'); vtputc((wp->w_flag&WFFORCE)!=0 ? 'F' : '-'); n += 6; #endif while (n < term.t_ncol) /* Pad to full width. */ { vtputc('-'); ++n; } } /* * Send a command to the terminal to move the hardware cursor to row "row" * and column "col". The row and column arguments are origin 0. Optimize out * random calls. Update "ttrow" and "ttcol". */ globle void movecursor( int row, int col) { if (row!=ttrow || col!=ttcol) { ttrow = row; ttcol = col; (*term.t_move)(row, col); } } /* * Erase the message line. This is a special routine because the message line * is not considered to be part of the virtual screen. It always works * immediately; the terminal buffer is flushed via a call to the flusher. */ globle void mlerase() { movecursor(term.t_nrow, 0); (*term.t_eeol)(); (*term.t_flush)(); mpresf = FALSE; } /* * Ask a yes or no question in the message line. Return either TRUE, FALSE, or * ABORT. The ABORT status is returned if the user bumps out of the question * with a ^G. Used any time a confirmation is required. */ globle int mlyesno( void *theEnv, char *prompt) { register int s; char buf[64]; for (;;) { strcpy(buf, prompt); strcat(buf, " [y/n]? "); s = mlreply(theEnv,buf, buf, sizeof(buf)); if (s == ABORT) return (ABORT); if (s != FALSE) { if (buf[0]=='y' || buf[0]=='Y') return (TRUE); if (buf[0]=='n' || buf[0]=='N') return (FALSE); } } } /* * Write a prompt into the message line, then read back a response. Keep * track of the physical position of the cursor. If we are in a keyboard * macro throw the prompt away, and return the remembered response. This * lets macros run at full speed. The reply is always terminated by a * carriage return. Handle erase, kill, and abort keys. */ globle int mlreply( void *theEnv, char *prompt, char *buf, int nbuf) { register int cpos; register int i; register int c; cpos = 0; if (kbdmop != NULL) { while ((c = *kbdmop++) != '\0') buf[cpos++] = (char) c; buf[cpos] = 0; if (buf[0] == 0) return (FALSE); return (TRUE); } mlwrite(prompt); for (;;) { c = (*term.t_getchar)(); switch (c) { case 0x0D: /* Return, end of line */ buf[cpos++] = 0; if (kbdmip != NULL) { if (kbdmip+cpos > &kbdm[NKBDM-3]) { ctrlg(theEnv,FALSE, 0); (*term.t_flush)(); return (ABORT); } for (i=0; i= 10) { /* Conditional digits. */ buf[--width] = (char) (num%10) + '0'; num /= 10; } buf[--width] = (char) num + '0'; /* Always 1 digit. */ while (width != 0) /* Pad with blanks. */ buf[--width] = ' '; } #endif clips-6.24/clipssrc/edbasic.c0000755000175000017500000014531507675425251014316 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* */ /*******************************************************/ #include "setup.h" #if EMACS_EDITOR && ! RUN_TIME #define _EDBASIC_SOURCE_ #include "ed.h" /* ----------------------- * Terminal setup stuff * ----------------------- */ #if VAX_VMS #include #include #include #include #include #include #define NIBUF 128 /* Input buffer size */ #define NOBUF 1024 /* MM says big buffers win! */ #define EFN 0 /* Event flag */ #define ESC '\033' #define TERM '~' static char obuf[NOBUF]; /* Output buffer */ static int nobuf; /* # of bytes in above */ static char ibuf[NIBUF]; /* Input buffer */ static int nibuf; /* # of bytes in above */ static int ibufi; /* Read index */ static int oldmode[3]; /* Old TTY mode bits */ static int newmode[3]; /* New TTY mode bits */ static short iochan; /* TTY I/O channel */ #endif #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC #include #endif #if UNIX_7 || UNIX_V #include #include /* for stty/gtty functions */ static struct sgttyb ostate; /* saved tty state */ static struct sgttyb nstate; /* values for editor mode */ #endif /* ======================================================================= * CURSOR MOVEMENT FUNCTIONS * ======================================================================= */ /* * The routines in this section move the cursor around on the screen. They * compute a new value for the cursor, then adjust ".". The display code * always updates the cursor location, so only moves between lines, or * functions that adjust the top line in the window and invalidate the * framing, are hard. */ /* * Move the cursor to the * beginning of the current line. * Trivial. */ #if IBM_TBC #pragma argsused #endif globle int gotobol( void *theEnv, int f, int n) { curwp->w_doto = 0; return (TRUE); } /* * Move the cursor backwards by "n" characters. If "n" is less than zero call * "forwchar" to actually do the move. Otherwise compute the new cursor * location. Error if you try and move out of the buffer. Set the flag if the * line pointer for dot changes. */ globle int backchar( void *theEnv, int f, int n) { register LINE *lp; if (n < 0) return (forwchar(theEnv,f, -n)); while (n--) { if (curwp->w_doto == 0) { if ((lp=lback(curwp->w_dotp)) == curbp->b_linep) { return (FALSE); } curwp->w_dotp = lp; curwp->w_doto = llength(lp); curwp->w_flag |= WFMOVE; } else { curwp->w_doto--; } } return (TRUE); } /* * Move the cursor to the end of the current line. Trivial. No errors. */ #if IBM_TBC #pragma argsused #endif globle int gotoeol( void *theEnv, int f, int n) { curwp->w_doto = llength(curwp->w_dotp); return (TRUE); } /* * Move the cursor forwwards by "n" characters. If "n" is less than zero call * "backchar" to actually do the move. Otherwise compute the new cursor * location, and move ".". Error if you try and move off the end of the * buffer. Set the flag if the line pointer for dot changes. */ globle int forwchar( void *theEnv, int f, int n) { if (n < 0) return (backchar(theEnv,f, -n)); while (n--) { if (curwp->w_doto == llength(curwp->w_dotp)) { if (curwp->w_dotp == curbp->b_linep) return (FALSE); curwp->w_dotp = lforw(curwp->w_dotp); curwp->w_doto = 0; curwp->w_flag |= WFMOVE; } else curwp->w_doto++; } return (TRUE); } /* * Goto the beginning of the buffer. Massive adjustment of dot. This is * considered to be hard motion; it really isn't if the original value of dot * is the same as the new value of dot. Normally bound to "M-<". */ #if IBM_TBC #pragma argsused #endif globle int gotobob( void *theEnv, int f, int n) { curwp->w_dotp = lforw(curbp->b_linep); curwp->w_doto = 0; curwp->w_flag |= WFHARD; return (TRUE); } /* * Move to the end of the buffer. Dot is always put at the end of the file * (ZJ). The standard screen code does most of the hard parts of update. * Bound to "M->". */ #if IBM_TBC #pragma argsused #endif globle int gotoeob( void *theEnv, int f, int n) { curwp->w_dotp = curbp->b_linep; curwp->w_doto = 0; curwp->w_flag |= WFHARD; return (TRUE); } /* * Move forward by full lines. If the number of lines to move is less than * zero, call the backward line function to actually do it. The last command * controls how the goal column is set. Bound to "C-N". No errors are * possible. */ globle int forwline( void *theEnv, int f, int n) { register LINE *dlp; if (n < 0) return (backline(theEnv,f, -n)); if ((lastflag&CFCPCN) == 0) /* Reset goal if last */ curgoal = curcol; /* not C-P or C-N */ thisflag |= CFCPCN; dlp = curwp->w_dotp; while (n-- && dlp!=curbp->b_linep) dlp = lforw(dlp); curwp->w_dotp = dlp; curwp->w_doto = getgoal(dlp); curwp->w_flag |= WFMOVE; return (TRUE); } /* * This function is like "forwline", but goes backwards. The scheme is exactly * the same. Check for arguments that are less than zero and call your * alternate. Figure out the new line and call "movedot" to perform the * motion. No errors are possible. Bound to "C-P". */ globle int backline( void *theEnv, int f, int n) { register LINE *dlp; if (n < 0) return (forwline(theEnv,f, -n)); if ((lastflag&CFCPCN) == 0) /* Reset goal if the */ curgoal = curcol; /* last isn't C-P, C-N */ thisflag |= CFCPCN; dlp = curwp->w_dotp; while (n-- && lback(dlp)!=curbp->b_linep) dlp = lback(dlp); curwp->w_dotp = dlp; curwp->w_doto = getgoal(dlp); curwp->w_flag |= WFMOVE; return (TRUE); } /* * This routine, given a pointer to a LINE, and the current cursor goal * column, return the best choice for the offset. The offset is returned. * Used by "C-N" and "C-P". */ globle int getgoal( LINE *dlp) { register int c; register int col; register int newcol; register int dbo; col = 0; dbo = 0; while (dbo != llength(dlp)) { c = lgetc(dlp, dbo); newcol = col; if (c == '\t') newcol |= 0x07; else if (c<0x20 || c==0x7F) ++newcol; ++newcol; if (newcol > curgoal) break; col = newcol; ++dbo; } return (dbo); } /* * Scroll forward by a specified number of lines, or by a full page if no * argument. Bound to "C-V". The "2" in the arithmetic on the window size is * the overlap; this value is the default overlap value in ITS EMACS. Because * this zaps the top line in the display window, we have to do a hard update. */ globle int forwpage( void *theEnv, int f, int n) { register LINE *lp; if (f == FALSE) { n = curwp->w_ntrows - 2; /* Default scroll. */ if (n <= 0) /* Forget the overlap */ n = 1; /* if tiny window. */ } else if (n < 0) return (backpage(theEnv,f, -n)); #if CVMVAS else /* Convert from pages */ n *= curwp->w_ntrows; /* to lines. */ #endif lp = curwp->w_linep; while (n-- && lp!=curbp->b_linep) lp = lforw(lp); curwp->w_linep = lp; curwp->w_dotp = lp; curwp->w_doto = 0; curwp->w_flag |= WFHARD; return (TRUE); } /* * This command is like "forwpage", but it goes backwards. The "2", like * above, is the overlap between the two windows. The value is from the ITS * EMACS manual. Bound to "M-V". We do a hard update for exactly the same * reason. */ globle int backpage( void *theEnv, int f, int n) { register LINE *lp; if (f == FALSE) { n = curwp->w_ntrows - 2; /* Default scroll. */ if (n <= 0) /* Don't blow up if the */ n = 1; /* window is tiny. */ } else if (n < 0) return (forwpage(theEnv,f, -n)); #if CVMVAS else /* Convert from pages */ n *= curwp->w_ntrows; /* to lines. */ #endif lp = curwp->w_linep; while (n-- && lback(lp)!=curbp->b_linep) lp = lback(lp); curwp->w_linep = lp; curwp->w_dotp = lp; curwp->w_doto = 0; curwp->w_flag |= WFHARD; return (TRUE); } /* * Set the mark in the current window to the value of "." in the window. No * errors are possible. Bound to "M-.". */ #if IBM_TBC #pragma argsused #endif globle int setmark( void *theEnv, int f, int n) { curwp->w_markp = curwp->w_dotp; curwp->w_marko = curwp->w_doto; mlwrite("[Mark set]"); return (TRUE); } /* * Swap the values of "." and "mark" in the current window. This is pretty * easy, bacause all of the hard work gets done by the standard routine * that moves the mark about. The only possible error is "no mark". Bound to * "C-X C-X". */ #if IBM_TBC #pragma argsused #endif globle int swapmark( void *theEnv, int f, int n) { register LINE *odotp; register int odoto; if (curwp->w_markp == NULL) { mlwrite("No mark in this window"); return (FALSE); } odotp = curwp->w_dotp; odoto = curwp->w_doto; curwp->w_dotp = curwp->w_markp; curwp->w_doto = curwp->w_marko; curwp->w_markp = odotp; curwp->w_marko = odoto; curwp->w_flag |= WFMOVE; return (TRUE); } /* ======================================================================= * WORD FUNCTIONS * ======================================================================= */ /* * The routines in this section implement commands that work word at a time. * There are all sorts of word mode commands. */ /* Word wrap on n-spaces. Back-over whatever precedes the point on the current * line and stop on the first word-break or the beginning of the line. If we * reach the beginning of the line, jump back to the end of the word and start * a new line. Otherwise, break the line at the word-break, eat it, and jump * back to the end of the word. * NOTE: This function may leaving trailing blanks. * Returns TRUE on success, FALSE on errors. */ #if IBM_TBC #pragma argsused #endif globle int wrapword( void *theEnv) { register int cnt, oldp; oldp = (int) curwp->w_dotp; cnt = -1; do { cnt++; if (! backchar(theEnv,0, 1)) return(FALSE); } while (! inword()); if (! backword(theEnv,0, 1)) return(FALSE); if (oldp == (int) (curwp->w_dotp && curwp->w_doto)) { if (! backdel(theEnv,0, 1)) return(FALSE); if (! newline(theEnv,0, 1)) return(FALSE); } return(forwword(theEnv,0, 1) && forwchar(theEnv,0, cnt)); } /* * Move the cursor backward by "n" words. All of the details of motion are * performed by the "backchar" and "forwchar" routines. Error if you try to * move beyond the buffers. */ #if IBM_TBC #pragma argsused #endif globle int backword( void *theEnv, int f, int n) { if (n < 0) return (forwword(theEnv,f, -n)); if (backchar(theEnv,FALSE, 1) == FALSE) return (FALSE); while (n--) { while (inword() == FALSE) { if (backchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } while (inword() != FALSE) { if (backchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } } return (forwchar(theEnv,FALSE, 1)); } /* * Move the cursor forward by the specified number of words. All of the motion * is done by "forwchar". Error if you try and move beyond the buffer's end. */ #if IBM_TBC #pragma argsused #endif globle int forwword( void *theEnv, int f, int n) { if (n < 0) return (backword(theEnv,f, -n)); while (n--) { while (inword() == FALSE) { if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } while (inword() != FALSE) { if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } } return (TRUE); } /* * Move the cursor forward by the specified number of words. As you move, * convert any characters to upper case. Error if you try and move beyond the * end of the buffer. Bound to "M-U". */ #if IBM_TBC #pragma argsused #endif globle int upperword( void *theEnv, int f, int n) { register int c; if (n < 0) return (FALSE); while (n--) { while (inword() == FALSE) { if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } while (inword() != FALSE) { c = lgetc(curwp->w_dotp, curwp->w_doto); if (c>='a' && c<='z') { c -= 'a'-'A'; lputc(curwp->w_dotp, curwp->w_doto, c); lchange(WFHARD); } if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } } return (TRUE); } /* * Move the cursor forward by the specified number of words. As you move * convert characters to lower case. Error if you try and move over the end of * the buffer. Bound to "M-L". */ #if IBM_TBC #pragma argsused #endif globle int lowerword( void *theEnv, int f, int n) { register int c; if (n < 0) return (FALSE); while (n--) { while (inword() == FALSE) { if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } while (inword() != FALSE) { c = lgetc(curwp->w_dotp, curwp->w_doto); if (c>='A' && c<='Z') { c += 'a'-'A'; lputc(curwp->w_dotp, curwp->w_doto, c); lchange(WFHARD); } if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } } return (TRUE); } /* * Move the cursor forward by the specified number of words. As you move * convert the first character of the word to upper case, and subsequent * characters to lower case. Error if you try and move past the end of the * buffer. Bound to "M-C". */ #if IBM_TBC #pragma argsused #endif globle int capword( void *theEnv, int f, int n) { register int c; if (n < 0) return (FALSE); while (n--) { while (inword() == FALSE) { if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } if (inword() != FALSE) { c = lgetc(curwp->w_dotp, curwp->w_doto); if (c>='a' && c<='z') { c -= 'a'-'A'; lputc(curwp->w_dotp, curwp->w_doto, c); lchange(WFHARD); } if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); while (inword() != FALSE) { c = lgetc(curwp->w_dotp, curwp->w_doto); if (c>='A' && c<='Z') { c += 'a'-'A'; lputc(curwp->w_dotp, curwp->w_doto, c); lchange(WFHARD); } if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); } } } return (TRUE); } /* * Kill forward by "n" words. Remember the location of dot. Move forward by * the right number of words. Put dot back where it was and issue the kill * command for the right number of characters. Bound to "M-D". */ #if IBM_TBC #pragma argsused #endif globle int delfword( void *theEnv, int f, int n) { register int size; register LINE *dotp; register int doto; if (n < 0) return (FALSE); if ((lastflag&CFKILL) == 0) /* Clear kill buffer if */ kdelete(theEnv); /* last wasn't a kill. */ thisflag |= CFKILL; dotp = curwp->w_dotp; doto = curwp->w_doto; size = 0; while (n--) { while (inword() == FALSE) { if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); ++size; } while (inword() != FALSE) { if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); ++size; } } curwp->w_dotp = dotp; curwp->w_doto = doto; return (ldelete(theEnv,(long) size, TRUE)); } /* * Kill backwards by "n" words. Move backwards by the desired number of words, * counting the characters. When dot is finally moved to its resting place, * fire off the kill command. Bound to "M-Rubout" and to "M-Backspace". */ #if IBM_TBC #pragma argsused #endif globle int delbword( void *theEnv, int f, int n) { register int size; if (n < 0) return (FALSE); if (backchar(theEnv,FALSE, 1) == FALSE) return (FALSE); if ((lastflag&CFKILL) == 0) /* Clear kill buffer if */ kdelete(theEnv); /* last wasn't a kill. */ thisflag |= CFKILL; size = 0; while (n--) { while (inword() == FALSE) { if (backchar(theEnv,FALSE, 1) == FALSE) return (FALSE); ++size; } while (inword() != FALSE) { if (backchar(theEnv,FALSE, 1) == FALSE) return (FALSE); ++size; } } if (forwchar(theEnv,FALSE, 1) == FALSE) return (FALSE); return (ldelete(theEnv,(long) size, TRUE)); } /* * Return TRUE if the character at dot is a character that is considered * part of a word. The word character list is hard coded. Should be setable. */ globle int inword() { register int c; if (curwp->w_doto == llength(curwp->w_dotp)) return (FALSE); c = lgetc(curwp->w_dotp, curwp->w_doto); if (c>='a' && c<='z') return (TRUE); if (c>='A' && c<='Z') return (TRUE); if (c>='0' && c<='9') return (TRUE); if (c=='$') /* For identifiers */ return (TRUE); return (FALSE); } /* ======================================================================= * REGION FUNCTIONS * ======================================================================= */ /* * The routines in this section deal with the region, that magic space * between "." and mark. Some functions are commands. Some functions are * just for internal use. */ /* * Kill the region. Ask "getregion" * to figure out the bounds of the region. * Move "." to the start, and kill the characters. * Bound to "C-W". */ #if IBM_TBC #pragma argsused #endif globle int killregion( void *theEnv, int f, int n) { register int s; REGION region; if ((s=getregion(®ion)) != TRUE) { return (s); } if ((lastflag&CFKILL) == 0) /* This is a kill type */ { kdelete(theEnv); } /* command, so do magic */ thisflag |= CFKILL; /* kill buffer stuff. */ curwp->w_dotp = region.r_linep; curwp->w_doto = region.r_offset; return (ldelete(theEnv,region.r_size, TRUE)); } /* * Copy all of the characters in the * region to the kill buffer. Don't move dot * at all. This is a bit like a kill region followed * by a yank. Bound to "M-W". */ #if IBM_TBC #pragma argsused #endif globle int copyregion( void *theEnv, int f, int n) { register LINE *linep; register int loffs; register int s; REGION region; if ((s=getregion(®ion)) != TRUE) return (s); if ((lastflag&CFKILL) == 0) /* Kill type command. */ kdelete(theEnv); thisflag |= CFKILL; linep = region.r_linep; /* Current line. */ loffs = region.r_offset; /* Current offset. */ while (region.r_size--) { if (loffs == llength(linep)) { /* End of line. */ if ((s=kinsert(theEnv,'\n')) != TRUE) return (s); linep = lforw(linep); loffs = 0; } else { /* Middle of line. */ if ((s=kinsert(theEnv,lgetc(linep, loffs))) != TRUE) return (s); ++loffs; } } mlwrite("Region copied to buffer"); return (TRUE); } /* * Lower case region. Zap all of the upper * case characters in the region to lower case. Use * the region code to set the limits. Scan the buffer, * doing the changes. Call "lchange" to ensure that * redisplay is done in all buffers. Bound to * "C-X C-L". */ #if IBM_TBC #pragma argsused #endif globle int lowerregion( void *theEnv, int f, int n) { register LINE *linep; register int loffs; register int c; register int s; REGION region; if ((s=getregion(®ion)) != TRUE) return (s); lchange(WFHARD); linep = region.r_linep; loffs = region.r_offset; while (region.r_size--) { if (loffs == llength(linep)) { linep = lforw(linep); loffs = 0; } else { c = lgetc(linep, loffs); if (c>='A' && c<='Z') lputc(linep, loffs, c+'a'-'A'); ++loffs; } } return (TRUE); } /* * Upper case region. Zap all of the lower * case characters in the region to upper case. Use * the region code to set the limits. Scan the buffer, * doing the changes. Call "lchange" to ensure that * redisplay is done in all buffers. Bound to * "C-X C-L". */ #if IBM_TBC #pragma argsused #endif globle int upperregion( void *theEnv, int f, int n) { register LINE *linep; register int loffs; register int c; register int s; REGION region; if ((s=getregion(®ion)) != TRUE) return (s); lchange(WFHARD); linep = region.r_linep; loffs = region.r_offset; while (region.r_size--) { if (loffs == llength(linep)) { linep = lforw(linep); loffs = 0; } else { c = lgetc(linep, loffs); if (c>='a' && c<='z') lputc(linep, loffs, c-'a'+'A'); ++loffs; } } return (TRUE); } /* * This routine figures out the * bounds of the region in the current window, and * fills in the fields of the "REGION" structure pointed * to by "rp". Because the dot and mark are usually very * close together, we scan outward from dot looking for * mark. This should save time. Return a standard code. * Callers of this routine should be prepared to get * an "ABORT" status; we might make this have the * conform thing later. */ globle int getregion( REGION *rp) { register LINE *flp; register LINE *blp; long fsize; long bsize; if (curwp->w_markp == NULL) { mlwrite("No mark set in this window"); return (FALSE); } if (curwp->w_dotp == curwp->w_markp) { rp->r_linep = curwp->w_dotp; if (curwp->w_doto < curwp->w_marko) { rp->r_offset = curwp->w_doto; rp->r_size = (long) (curwp->w_marko-curwp->w_doto); } else { rp->r_offset = curwp->w_marko; rp->r_size = (long) (curwp->w_doto-curwp->w_marko); } return (TRUE); } blp = curwp->w_dotp; bsize = (long) curwp->w_doto; flp = curwp->w_dotp; fsize = (long) (llength(flp)-curwp->w_doto+1); while (flp!=curbp->b_linep || lback(blp)!=curbp->b_linep) { if (flp != curbp->b_linep) { flp = lforw(flp); if (flp == curwp->w_markp) { rp->r_linep = curwp->w_dotp; rp->r_offset = curwp->w_doto; rp->r_size = fsize+curwp->w_marko; return (TRUE); } fsize += llength(flp)+1; } if (lback(blp) != curbp->b_linep) { blp = lback(blp); bsize += llength(blp)+1; if (blp == curwp->w_markp) { rp->r_linep = blp; rp->r_offset = curwp->w_marko; rp->r_size = bsize - curwp->w_marko; return (TRUE); } } } mlwrite("Bug: lost mark"); return (FALSE); } /* ======================================================================= * HIGH LEVEL FILE I/O COMMANDS * ======================================================================= */ /* * Read a file into the current * buffer. This is really easy; all you do it * find the name of the file, and call the standard * "read a file into the current buffer" code. * Bound to "C-X C-R". * * Changed calling code to "C-X C-V" to be * more like the Zmacs editor on Symbolics. CJC 7/28/86 */ #if IBM_TBC #pragma argsused #endif globle int fileread( void *theEnv, int f, int n) { register int s; char fname[NFILEN]; if ((s=mlreply(theEnv,"Visit file: ", fname, NFILEN)) != TRUE) { return (s); } return (readin(theEnv,fname)); } /* * Select a file for editing. * Look around to see if you can find the * fine in another buffer; if you can find it * just switch to the buffer. If you cannot find * the file, create a new buffer, read in the * text, and switch to the new buffer. * Bound to C-X C-V. * * Changed calling code to "C-X C-F" (Find File) to be * more like the Zmacs editor on Symbolics. CJC 7/28/86 */ #if IBM_TBC #pragma argsused #endif globle int filevisit( void *theEnv, int f, int n) { register int s; char fname[NFILEN]; if ((s=mlreply(theEnv,"Find file: ", fname, NFILEN)) != TRUE) return (s); filevisit_guts(theEnv,fname); return(TRUE); } globle int filevisit_guts( void *theEnv, char fname[]) { register BUFFER *bp; register WINDOW *wp; register LINE *lp; register int i; register int s; char bname[NBUFN]; for (bp=bheadp; bp!=NULL; bp=bp->b_bufp) { if ((bp->b_flag&BFTEMP)==0 && strcmp(bp->b_fname, fname)==0) { if (--curbp->b_nwnd == 0) { curbp->b_dotp = curwp->w_dotp; curbp->b_doto = curwp->w_doto; curbp->b_markp = curwp->w_markp; curbp->b_marko = curwp->w_marko; } curbp = bp; curwp->w_bufp = bp; if (bp->b_nwnd++ == 0) { curwp->w_dotp = bp->b_dotp; curwp->w_doto = bp->b_doto; curwp->w_markp = bp->b_markp; curwp->w_marko = bp->b_marko; } else { wp = wheadp; while (wp != NULL) { if (wp!=curwp && wp->w_bufp==bp) { curwp->w_dotp = wp->w_dotp; curwp->w_doto = wp->w_doto; curwp->w_markp = wp->w_markp; curwp->w_marko = wp->w_marko; break; } wp = wp->w_wndp; } } lp = curwp->w_dotp; i = curwp->w_ntrows/2; while (i-- && lback(lp)!=curbp->b_linep) lp = lback(lp); curwp->w_linep = lp; curwp->w_flag |= WFMODE|WFHARD; mlwrite("[Old buffer]"); return (TRUE); } } makename(bname, fname); /* New buffer name. */ while ((bp=bfind(theEnv,bname, FALSE, 0)) != NULL) { s = mlreply(theEnv,"Buffer name: ", bname, NBUFN); if (s == ABORT) /* ^G to just quit */ return (s); if (s == FALSE) { /* CR to clobber it */ makename(bname, fname); break; } } if (bp==NULL && (bp=bfind(theEnv,bname, TRUE, 0))==NULL) { mlwrite("Cannot create buffer"); return (FALSE); } if (--curbp->b_nwnd == 0) { /* Undisplay. */ curbp->b_dotp = curwp->w_dotp; curbp->b_doto = curwp->w_doto; curbp->b_markp = curwp->w_markp; curbp->b_marko = curwp->w_marko; } strcpy(lastbufn, curbp->b_bname); /* Set last buufer name */ curbp = bp; /* Switch to it. */ curwp->w_bufp = bp; curbp->b_nwnd++; return (readin(theEnv,fname)); /* Read it in. */ } /* * Read file "fname" into the current * buffer, blowing away any text found there. Called * by both the read and visit commands. Return the final * status of the read. Also called by the mainline, * to read in a file specified on the command line as * an argument. */ globle int readin( void *theEnv, char fname[]) { register LINE *lp1; register LINE *lp2; register int i; register WINDOW *wp; register BUFFER *bp; register int s; register int nbytes; register int nline; char line[NLINE]; bp = curbp; /* Cheap. */ if ((s=bclear(theEnv,bp)) != TRUE) /* Might be old. */ return (s); bp->b_flag &= ~(BFTEMP|BFCHG); strcpy(bp->b_fname, fname); if ((s=ffropen(fname)) == FIOERR) /* Hard file open. */ goto out; if (s == FIOFNF) { /* File not found. */ mlwrite("[New file]"); goto out; } mlwrite("[Reading file]"); nline = 0; while ((s=ffgetline(line, NLINE)) == FIOSUC) { nbytes = strlen(line); if ((lp1=lalloc(theEnv,nbytes)) == NULL) { s = FIOERR; /* Keep message on the */ break; /* display. */ } lp2 = lback(curbp->b_linep); lp2->l_fp = lp1; lp1->l_fp = curbp->b_linep; lp1->l_bp = lp2; curbp->b_linep->l_bp = lp1; for (i=0; iw_wndp) { if (wp->w_bufp == curbp) { wp->w_linep = lforw(curbp->b_linep); wp->w_dotp = lforw(curbp->b_linep); wp->w_doto = 0; wp->w_markp = NULL; wp->w_marko = 0; wp->w_flag |= WFMODE|WFHARD; } } if (s == FIOERR) /* False if error. */ return (FALSE); return (TRUE); } /* * Take a file name, and from it * fabricate a buffer name. This routine knows * about the syntax of file names on the target system. * I suppose that this information could be put in * a better place than a line of code. */ globle int makename( char bname[], char fname[]) { register char *cp1; register char *cp2; cp1 = &fname[0]; while (*cp1 != 0) ++cp1; #if VAX_VMS while (cp1!=&fname[0] && cp1[-1]!=':' && cp1[-1]!=']') --cp1; #endif #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC while (cp1!=&fname[0] && cp1[-1]!=':' && cp1[-1]!='\\') --cp1; #endif #if UNIX_7 || UNIX_V while (cp1!=&fname[0] && cp1[-1]!='/') --cp1; #endif cp2 = &bname[0]; while (cp2!=&bname[NBUFN-1] && *cp1!=0 && *cp1!=';') *cp2++ = *cp1++; *cp2 = 0; return(TRUE); } /* * Ask for a file name, and write the * contents of the current buffer to that file. * Update the remembered file name and clear the * buffer changed flag. This handling of file names * is different from the earlier versions, and * is more compatable with Gosling EMACS than * with ITS EMACS. Bound to "C-X C-W". * * Modified to allow current file name as default. CJC 7/28/86 */ #if IBM_TBC #pragma argsused #endif globle int filewrite( void *theEnv, int f, int n) { register WINDOW *wp; register int s; char fname[NFILEN]; char prompt[NFILEN + 15]; sprintf(prompt,"Write file [%s]: ",curbp->b_fname); if ((s=mlreply(theEnv,prompt, fname, NFILEN)) != TRUE) { if (s == FALSE) strcpy(fname, curbp->b_fname); else return (s); } if ((s=writeout(fname)) == TRUE) { strcpy(curbp->b_fname, fname); curbp->b_flag &= ~BFCHG; wp = wheadp; /* Update mode lines. */ while (wp != NULL) { if (wp->w_bufp == curbp) wp->w_flag |= WFMODE; wp = wp->w_wndp; } } return (s); } /* * Save the contents of the current * buffer in its associatd file. Do nothing * if nothing has changed (this may be a bug, not a * feature). Error if there is no remembered file * name for the buffer. Bound to "C-X C-S". May * get called by "C-Z". */ #if IBM_TBC #pragma argsused #endif globle int filesave( void *theEnv, int f, int n) { register WINDOW *wp; register int s; if ((curbp->b_flag&BFCHG) == 0) /* Return, no changes. */ return (TRUE); if (curbp->b_fname[0] == 0) { /* Must have a name. */ mlwrite("No file name"); return (FALSE); } if ((s=writeout(curbp->b_fname)) == TRUE) { curbp->b_flag &= ~BFCHG; wp = wheadp; /* Update mode lines. */ while (wp != NULL) { if (wp->w_bufp == curbp) wp->w_flag |= WFMODE; wp = wp->w_wndp; } } return (s); } /* * This function performs the details of file * writing. Uses the file management routines in the * "fileio.c" package. The number of lines written is * displayed. Sadly, it looks inside a LINE; provide * a macro for this. Most of the grief is error * checking of some sort. */ globle int writeout( char *fn) { register int s; register LINE *lp; register int nline; if ((s=ffwopen(fn)) != FIOSUC) /* Open writes message. */ return (FALSE); lp = lforw(curbp->b_linep); /* First line. */ nline = 0; /* Number of lines. */ while (lp != curbp->b_linep) { if ((s=ffputline(&lp->l_text[0], llength(lp))) != FIOSUC) break; ++nline; lp = lforw(lp); } if (s == FIOSUC) { /* No write error. */ s = ffclose(); if (s == FIOSUC) { /* No close error. */ if (nline == 1) mlwrite("[Wrote 1 line]"); else mlwrite("[Wrote %d lines]", nline); } } else /* Ignore close error */ ffclose(); /* if a write error. */ if (s != FIOSUC) /* Some sort of error. */ return (FALSE); return (TRUE); } /* * The command allows the user * to modify the file name associated with * the current buffer. It is like the "f" command * in UNIX "ed". The operation is simple; just zap * the name in the BUFFER structure, and mark the windows * as needing an update. You can type a blank line at the * prompt if you wish. * * Bound to "C-X C-R" for Rename buffer! * Changed 7/28/86 by CJC. */ #if IBM_TBC #pragma argsused #endif globle int filename( void *theEnv, int f, int n) { register WINDOW *wp; register int s; char fname[NFILEN]; if ((s=mlreply(theEnv,"Name: ", fname, NFILEN)) == ABORT) return (s); if (s == FALSE) strcpy(curbp->b_fname, ""); else strcpy(curbp->b_fname, fname); wp = wheadp; /* Update mode lines. */ while (wp != NULL) { if (wp->w_bufp == curbp) wp->w_flag |= WFMODE; wp = wp->w_wndp; } return (TRUE); } /* ======================================================================= * Low level File I/O commands * ======================================================================= */ static FILE *ffp; /* File pointer, all functions. */ /* * The routines in this section do the low level read and write of ASCII * files from the disk. All of the knowledge about files is here. A better * message writing scheme should be used. */ /* * Open a file for reading. */ globle int ffropen( char *fn) { if ((ffp=fopen(fn, "r")) == NULL) return (FIOFNF); return (FIOSUC); } /* * Open a file for writing. Return TRUE if all is well, and FALSE on error * (cannot create). */ globle int ffwopen( char *fn) { #if VAX_VMS register int fd; if ((fd=creat(fn, 0666, "rfm=var", "rat=cr")) < 0 || (ffp=fdopen(fd, "w")) == NULL) { #else if ((ffp=fopen(fn, "w")) == NULL) { #endif mlwrite("Cannot open file for writing"); return (FIOERR); } return (FIOSUC); } /* * Close a file. Should look at the status in all systems. */ globle int ffclose() { #if UNIX_7 || UNIX_V if (fclose(ffp) != FALSE) { mlwrite("Error closing file"); return(FIOERR); } #else fclose(ffp); #endif return (FIOSUC); } /* * Write a line to the already opened file. The "buf" points to the buffer, * and the "nbuf" is its length, less the free newline. Return the status. * Check only at the newline. */ globle int ffputline( char buf[], int nbuf) { register int i; for (i = 0; i < nbuf; ++i) fputc(buf[i]&0xFF, ffp); fputc('\n', ffp); if (ferror(ffp)) { mlwrite("Write I/O error"); return (FIOERR); } return (FIOSUC); } /* * Read a line from a file, and store the bytes in the supplied buffer. The * "nbuf" is the length of the buffer. Complain about long lines and lines * at the end of the file that don't have a newline present. Check for I/O * errors too. Return status. */ globle int ffgetline( char buf[], int nbuf) { register int c; register int i; i = 0; while ((c = fgetc(ffp)) != EOF && c != '\n') { if (i >= nbuf-1) { mlwrite("File has long line"); return (FIOERR); } buf[i++] = (char) c; } if (c == EOF) { if (ferror(ffp)) { mlwrite("File read error"); return (FIOERR); } if (i != 0) { mlwrite("File has funny line at EOF"); return (FIOERR); } return (FIOEOF); } buf[i] = 0; return (FIOSUC); } /* ======================================================================= * LOW LEVEL TERMINAL I/O COMMANDS * ======================================================================= */ /* * The functions in this section negotiate with the operating system for * characters, and write characters in a barely buffered fashion on the * display. All operating systems. */ /* * This function is called once to set up the terminal device streams. * On VMS, it translates SYS$INPUT until it finds the terminal, then assigns * a channel to it and sets it raw. */ globle void ttopen() { #if VAX_VMS struct dsc$descriptor idsc; struct dsc$descriptor odsc; char oname[40]; int iosb[2]; int status; odsc.dsc$a_pointer = "SYS$INPUT"; odsc.dsc$w_length = strlen(odsc.dsc$a_pointer); odsc.dsc$b_dtype = DSC$K_DTYPE_T; odsc.dsc$b_class = DSC$K_CLASS_S; idsc.dsc$b_dtype = DSC$K_DTYPE_T; idsc.dsc$b_class = DSC$K_CLASS_S; do { idsc.dsc$a_pointer = odsc.dsc$a_pointer; idsc.dsc$w_length = odsc.dsc$w_length; odsc.dsc$a_pointer = &oname[0]; odsc.dsc$w_length = sizeof(oname); status = LIB$SYS_TRNLOG(&idsc, &odsc.dsc$w_length, &odsc); if (status!=SS$_NORMAL && status!=SS$_NOTRAN) exit(status); if (oname[0] == 0x1B) { odsc.dsc$a_pointer += 4; odsc.dsc$w_length -= 4; } } while (status == SS$_NORMAL); status = SYS$ASSIGN(&odsc, &iochan, 0, 0); if (status != SS$_NORMAL) exit(status); status = SYS$QIOW(EFN, iochan, IO$_SENSEMODE, iosb, 0, 0, oldmode, sizeof(oldmode), 0, 0, 0, 0); if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL) exit(status); newmode[0] = oldmode[0]; newmode[1] = oldmode[1] | TT$M_PASSALL | TT$M_NOECHO; newmode[1] &= ~(TT$M_TTSYNC|TT$M_HOSTSYNC); newmode[2] = oldmode[2] | TT2$M_PASTHRU; status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0, newmode, sizeof(newmode), 0, 0, 0, 0); if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL) exit(status); #endif #if UNIX_7 || UNIX_V ioctl(1,TIOCGETP,&ostate); ioctl(1,TIOCGETP,&nstate); /* gtty(1, &ostate); */ /* save old state */ /* gtty(1, &nstate); */ /* get base of new state */ nstate.sg_flags |= RAW; nstate.sg_flags &= ~(ECHO|CRMOD); /* no echo for now... */ /* stty(1, &nstate); */ /* set mode */ ioctl(1,TIOCSETP,&nstate); #endif } /* * This function gets called just before we go back home to the command * interpreter. On VMS it puts the terminal back in a reasonable state. */ globle void ttclose() { #if VAX_VMS int status; int iosb[1]; ttflush(); status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0, oldmode, sizeof(oldmode), 0, 0, 0, 0); if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL) exit(status); status = SYS$DASSGN(iochan); if (status != SS$_NORMAL) exit(status); #endif #if UNIX_7 || UNIX_V /* stty(1, &ostate); */ ioctl(1,TIOCSETP,&ostate); #endif #if IBM_ZTC || IBM_SC disp_close(); #endif } /* * Write a character to the display. On VMS, terminal output is buffered, and * we just put the characters in the big array, after checking for overflow. * Ditto on MS-DOS (use the very very raw console output routine). */ #if IBM_TBC #pragma argsused #endif globle void ttputc( int c) { #if VAX_VMS if (nobuf >= NOBUF) ttflush(); obuf[nobuf++] = c; #endif #if UNIX_7 || UNIX_V fputc(c, stdout); #endif } /* * Flush terminal buffer. Does real work where the terminal output is buffered * up. A no-operation on systems where byte at a time terminal I/O is done. */ globle void ttflush() { #if VAX_VMS int status; int iosb[2]; status = SS$_NORMAL; if (nobuf != 0) { status = SYS$QIOW(EFN, iochan, IO$_WRITELBLK|IO$M_NOFORMAT, iosb, 0, 0, obuf, nobuf, 0, 0, 0, 0); if (status == SS$_NORMAL) status = iosb[0] & 0xFFFF; nobuf = 0; } #endif #if UNIX_7 || UNIX_V fflush(stdout); #endif } /* * Read a character from the terminal, performing no editing and doing no echo * at all. More complex in VMS that almost anyplace else, which figures. */ globle int ttgetc() { #if VAX_VMS int status; int iosb[2]; long term[2]; /*Terminator block for I/O*/ while (ibufi >= nibuf) { ibufi = 0; term[0] = 0; term[1] = 0; status = SYS$QIOW(EFN, iochan, IO$_READLBLK|IO$M_TIMED|IO$M_NOFILTR|IO$M_PURGE, iosb, 0, 0, ibuf, NIBUF, 0, term, 0, 0); if (status != SS$_NORMAL) exit(status); status = iosb[0] & 0xFFFF; if (status!=SS$_NORMAL && status!=SS$_TIMEOUT) exit(status); nibuf = (iosb[0]>>16) + (iosb[1]>>16); if (nibuf == 0) { status = SYS$QIOW(EFN, iochan,IO$_READLBLK| IO$M_NOFILTR|IO$M_PURGE, iosb, 0, 0, ibuf, 1, 0, term, 0, 0); if (status != SS$_NORMAL) exit(status); status = (iosb[0]&0xFFFF); if (status != SS$_NORMAL) exit(status); nibuf = (iosb[0]>>16) + (iosb[1]>>16); } } if (ibuf[ibufi] == ESC) { status = SYS$QIOW(EFN,iochan,IO$_READLBLK|IO$M_NOFILTR|IO$M_TIMED, iosb,0,0,ibuf+1,4,0,term,0,0); nibuf = (iosb[0]>>16) + (iosb[1]>>16) + 1; if ((status == SS$_NORMAL) && (nibuf > 1)) return(parse_esc_seq()); if ((status != SS$_NORMAL) && (status != SS$_TIMEOUT)) exit(status); } return (ibuf[ibufi++] & 0xFF); /* Allow multinational */ #endif #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC return (fgetc(stdin)); /* NOTE: This won't really work */ #endif /* See file EDTERM.C for good code */ #if UNIX_7 || UNIX_V return(fgetc(stdin)); #endif } #if VAX_VMS /********************************/ /*PARSES ESCAPE SEQUENCES */ /********************************/ globle int parse_esc_seq() { int index, num; index = ibufi + 1; if ((ibuf[index] != '[') && (ibuf[index] != 'O')) { if ((ibuf[index] >= 'a') && (ibuf[index] <= 'z')) ibuf[index] = ibuf[index] - ('a' - 'A'); if ((ibuf[index] >= '\000') && (ibuf[index] <= '\037')) ibuf[index] = COTL | ibuf[index]; ibufi = nibuf + 1; return (META | ibuf[index]); } if (ibuf[index] == '[') index++; ibufi = nibuf + 1; switch (ibuf[index]) { case 'A' : return(COTL | 'P'); break; case 'B' : return(COTL | 'N'); break; case 'C' : return(COTL | 'F'); break; case 'D' : return(COTL | 'B'); break; case '1' : case '2' : case '3' : case '4' : case '5' : case '6' : if (ibuf[index + 1] != TERM) num = (ibuf[index] - 48)*10 + (ibuf[++index] -48); else num = ibuf[index] - 48; switch (num) { case 1 : return(COTL | 'S'); break; case 2 : return(COTL | 'Y'); break; case 3 : return(COTL | 'W'); break; case 4 : return(COTL | '@'); break; case 5 : return(META | 'V'); break; case 6 : return(COTL | 'V'); break; default : return BADKEY; } break; default : return BADKEY; } return(TRUE); } #endif #endif clips-6.24/clipssrc/classpsr.c0000755000175000017500000010246010441130212014517 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CLASS PARSER MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Parsing Routines for Defclass Construct */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "classcom.h" #include "classfun.h" #include "clsltpsr.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "inherpsr.h" #include "memalloc.h" #include "modulpsr.h" #include "modulutl.h" #include "msgpsr.h" #include "router.h" #include "scanner.h" #define _CLASSPSR_SOURCE_ #include "classpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define ROLE_RLN "role" #define ABSTRACT_RLN "abstract" #define CONCRETE_RLN "concrete" #define HANDLER_DECL "message-handler" #define SLOT_RLN "slot" #define SGL_SLOT_RLN "single-slot" #define MLT_SLOT_RLN "multislot" #define DIRECT 0 #define INHERIT 1 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool ValidClassName(void *,char *,DEFCLASS **); static intBool ParseSimpleQualifier(void *,char *,char *,char *,char *,intBool *,intBool *); static intBool ReadUntilClosingParen(void *,char *,struct token *); static void AddClass(void *,DEFCLASS *); static void BuildSubclassLinks(void *,DEFCLASS *); static void FormInstanceTemplate(void *,DEFCLASS *); static void FormSlotNameMap(void *,DEFCLASS *); static TEMP_SLOT_LINK *MergeSlots(void *,TEMP_SLOT_LINK *,DEFCLASS *,unsigned *,int); static void PackSlots(void *,DEFCLASS *,TEMP_SLOT_LINK *); #if DEFMODULE_CONSTRUCT static void CreateClassScopeMap(void *,DEFCLASS *); #endif static void CreatePublicSlotMessageHandlers(void *,DEFCLASS *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************************************** NAME : ParseDefclass DESCRIPTION : (defclass ...) is a construct (as opposed to a function), thus no variables may be used. This means classes may only be STATICALLY defined (like rules). INPUTS : The logical name of the router for the parser input RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Inserts valid class definition into Class Table. NOTES : H/L Syntax : (defclass [] (is-a +) *) :== (slot *) | (role abstract|concrete) | (pattern-match reactive|non-reactive) These are for documentation only: (message-handler []) :== (default ) | (default-dynamic ) | (storage shared|local) | (access read-only|read-write|initialize-only) | (propagation no-inherit|inherit) | (source composite|exclusive) (pattern-match reactive|non-reactive) (visibility public|private) (override-message ) (type ...) | (cardinality ...) | (allowed-symbols ...) | (allowed-strings ...) | (allowed-numbers ...) | (allowed-integers ...) | (allowed-floats ...) | (allowed-values ...) | (allowed-instance-names ...) | (allowed-classes ...) | (range ...) ::= ?NONE | ?VARIABLE | * ***************************************************************************************/ globle int ParseDefclass( void *theEnv, char *readSource) { SYMBOL_HN *cname; DEFCLASS *cls; PACKED_CLASS_LINKS *sclasses,*preclist; TEMP_SLOT_LINK *slots = NULL; int roleSpecified = FALSE, abstract = FALSE, parseError; #if DEFRULE_CONSTRUCT int patternMatchSpecified = FALSE, reactive = TRUE; #endif SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defclass "); #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defclass"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defclass", EnvFindDefclass,NULL,"#",TRUE, TRUE,TRUE); if (cname == NULL) return(TRUE); if (ValidClassName(theEnv,ValueToString(cname),&cls) == FALSE) return(TRUE); sclasses = ParseSuperclasses(theEnv,readSource,cname); if (sclasses == NULL) return(TRUE); preclist = FindPrecedenceList(theEnv,cls,sclasses); if (preclist == NULL) { DeletePackedClassLinks(theEnv,sclasses,TRUE); return(TRUE); } parseError = FALSE; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,"("); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),ROLE_RLN) == 0) { if (ParseSimpleQualifier(theEnv,readSource,ROLE_RLN,CONCRETE_RLN,ABSTRACT_RLN, &roleSpecified,&abstract) == FALSE) { parseError = TRUE; break; } } #if DEFRULE_CONSTRUCT else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MATCH_RLN) == 0) { if (ParseSimpleQualifier(theEnv,readSource,MATCH_RLN,NONREACTIVE_RLN,REACTIVE_RLN, &patternMatchSpecified,&reactive) == FALSE) { parseError = TRUE; break; } } #endif else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,FALSE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SGL_SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,TRUE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MLT_SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,TRUE,TRUE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),HANDLER_DECL) == 0) { if (ReadUntilClosingParen(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken) == FALSE) { parseError = TRUE; break; } } else { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if ((GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) || (parseError == TRUE)) { DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(TRUE); } SavePPBuffer(theEnv,"\n"); /* ========================================================================= The abstract/reactive qualities of a class are inherited if not specified ========================================================================= */ if (roleSpecified == FALSE) { if (preclist->classArray[1]->system && /* Change to cause */ (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* default role of */ { abstract = FALSE; } /* classes to be concrete. */ else { abstract = preclist->classArray[1]->abstract; } } #if DEFRULE_CONSTRUCT if (patternMatchSpecified == FALSE) { if ((preclist->classArray[1]->system) && /* Change to cause */ (! abstract) && /* default pattern-match */ (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* of classes to be */ { reactive = TRUE; } /* reactive. */ else { reactive = preclist->classArray[1]->reactive; } } /* ================================================================ An abstract class cannot have direct instances, thus it makes no sense for it to be reactive since it will have no objects to respond to pattern-matching ================================================================ */ if (abstract && reactive) { PrintErrorID(theEnv,"CLASSPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"An abstract class cannot be reactive.\n"); DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(TRUE); } #endif /* ======================================================= If we're only checking syntax, don't add the successfully parsed defclass to the KB. ======================================================= */ if (ConstructData(theEnv)->CheckSyntaxMode) { DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(FALSE); } cls = NewClass(theEnv,cname); cls->abstract = abstract; #if DEFRULE_CONSTRUCT cls->reactive = reactive; #endif cls->directSuperclasses.classCount = sclasses->classCount; cls->directSuperclasses.classArray = sclasses->classArray; /* ======================================================= This is a hack to let functions which need to iterate over a class AND its superclasses to conveniently do so The real precedence list starts in position 1 ======================================================= */ preclist->classArray[0] = cls; cls->allSuperclasses.classCount = preclist->classCount; cls->allSuperclasses.classArray = preclist->classArray; rtn_struct(theEnv,packedClassLinks,sclasses); rtn_struct(theEnv,packedClassLinks,preclist); /* ================================= Shove slots into contiguous array ================================= */ if (slots != NULL) PackSlots(theEnv,cls,slots); AddClass(theEnv,cls); return(FALSE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : ValidClassName DESCRIPTION : Determines if a new class of the given name can be defined in the current module INPUTS : 1) The new class name 2) Buffer to hold class address RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Error message printed if not OK NOTES : GetConstructNameAndComment() (called before this function) ensures that the defclass name does not conflict with one from another module ***********************************************************/ static intBool ValidClassName( void *theEnv, char *theClassName, DEFCLASS **theDefclass) { *theDefclass = (DEFCLASS *) EnvFindDefclass(theEnv,theClassName); if (*theDefclass != NULL) { /* =================================== System classes (which are visible in all modules) cannot be redefined =================================== */ if ((*theDefclass)->system) { PrintErrorID(theEnv,"CLASSPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot redefine a predefined system class.\n"); return(FALSE); } /* =============================================== A class in the current module can only be redefined if it is not in use, e.g., instances, generic function method restrictions, etc. =============================================== */ if ((EnvIsDefclassDeletable(theEnv,(void *) *theDefclass) == FALSE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { PrintErrorID(theEnv,"CLASSPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) *theDefclass)); EnvPrintRouter(theEnv,WERROR," class cannot be redefined while\n"); EnvPrintRouter(theEnv,WERROR," outstanding references to it still exist.\n"); return(FALSE); } } return(TRUE); } /*************************************************************** NAME : ParseSimpleQualifier DESCRIPTION : Parses abstract/concrete role and pattern-matching reactivity for class INPUTS : 1) The input logical name 2) The name of the qualifier being parsed 3) The qualifier value indicating that the qualifier should be false 4) The qualifier value indicating that the qualifier should be TRUE 5) A pointer to a bitmap indicating if the qualifier has already been parsed 6) A buffer to store the value of the qualifier RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Bitmap and qualifier buffers set Messages printed on errors NOTES : None ***************************************************************/ static intBool ParseSimpleQualifier( void *theEnv, char *readSource, char *classQualifier, char *clearRelation, char *setRelation, intBool *alreadyTestedFlag, intBool *binaryFlag) { if (*alreadyTestedFlag) { PrintErrorID(theEnv,"CLASSPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Class "); EnvPrintRouter(theEnv,WERROR,classQualifier); EnvPrintRouter(theEnv,WERROR," already declared.\n"); return(FALSE); } SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) goto ParseSimpleQualifierError; if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),setRelation) == 0) *binaryFlag = TRUE; else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),clearRelation) == 0) *binaryFlag = FALSE; else goto ParseSimpleQualifierError; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) goto ParseSimpleQualifierError; *alreadyTestedFlag = TRUE; return(TRUE); ParseSimpleQualifierError: SyntaxErrorMessage(theEnv,"defclass"); return(FALSE); } /*************************************************** NAME : ReadUntilClosingParen DESCRIPTION : Skips over tokens until a ')' is encountered. INPUTS : 1) The logical input source 2) A buffer for scanned tokens RETURNS : TRUE if ')' read, FALSE otherwise SIDE EFFECTS : Tokens read NOTES : Expects first token after opening paren has already been scanned ***************************************************/ static intBool ReadUntilClosingParen( void *theEnv, char *readSource, struct token *inputToken) { int cnt = 1,lparen_read = FALSE; do { if (lparen_read == FALSE) SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,inputToken); if (inputToken->type == STOP) { SyntaxErrorMessage(theEnv,"message-handler declaration"); return(FALSE); } else if (inputToken->type == LPAREN) { lparen_read = TRUE; cnt++; } else if (inputToken->type == RPAREN) { cnt--; if (lparen_read == FALSE) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } lparen_read = FALSE; } else lparen_read = FALSE; } while (cnt > 0); return(TRUE); } /***************************************************************************** NAME : AddClass DESCRIPTION : Determines the precedence list of the new class. If it is valid, the routine checks to see if the class already exists. If it does not, all the subclass links are made from the class's direct superclasses, and the class is inserted in the hash table. If it does, all sublclasses are deleted. An error will occur if any instances of the class (direct or indirect) exist. If all checks out, the old definition is replaced by the new. INPUTS : The new class description RETURNS : Nothing useful SIDE EFFECTS : The class is deleted if there is an error. NOTES : No change in the class graph state will occur if there were any errors. Assumes class is not busy!!! *****************************************************************************/ static void AddClass( void *theEnv, DEFCLASS *cls) { DEFCLASS *ctmp; #if DEBUGGING_FUNCTIONS int oldTraceInstances = FALSE, oldTraceSlots = FALSE; #endif /* =============================================== If class does not already exist, insert and form progeny links with all direct superclasses =============================================== */ cls->hashTableIndex = HashClass(GetDefclassNamePointer((void *) cls)); ctmp = (DEFCLASS *) EnvFindDefclass(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); if (ctmp != NULL) { #if DEBUGGING_FUNCTIONS oldTraceInstances = ctmp->traceInstances; oldTraceSlots = ctmp->traceSlots; #endif DeleteClassUAG(theEnv,ctmp); } PutClassInTable(theEnv,cls); BuildSubclassLinks(theEnv,cls); InstallClass(theEnv,cls,TRUE); AddConstructToModule((struct constructHeader *) cls); FormInstanceTemplate(theEnv,cls); FormSlotNameMap(theEnv,cls); AssignClassID(theEnv,cls); #if DEBUGGING_FUNCTIONS if (cls->abstract) { cls->traceInstances = FALSE; cls->traceSlots = FALSE; } else { if (oldTraceInstances) cls->traceInstances = TRUE; if (oldTraceSlots) cls->traceSlots = TRUE; } #endif #if DEBUGGING_FUNCTIONS if (EnvGetConserveMemory(theEnv) == FALSE) SetDefclassPPForm((void *) cls,CopyPPBuffer(theEnv)); #endif #if DEFMODULE_CONSTRUCT /* ========================================= Create a bitmap indicating whether this class is in scope or not for every module ========================================= */ CreateClassScopeMap(theEnv,cls); #endif /* ============================================== Define get- and put- handlers for public slots ============================================== */ CreatePublicSlotMessageHandlers(theEnv,cls); } /******************************************************* NAME : BuildSubclassLinks DESCRIPTION : Follows the list of superclasses for a class and puts the class in each of the superclasses' subclass list. INPUTS : The address of the class RETURNS : Nothing useful SIDE EFFECTS : The subclass lists for every superclass are modified. NOTES : Assumes the superclass list is formed. *******************************************************/ static void BuildSubclassLinks( void *theEnv, DEFCLASS *cls) { register unsigned i; for (i = 0 ; i < cls->directSuperclasses.classCount ; i++) AddClassLink(theEnv,&cls->directSuperclasses.classArray[i]->directSubclasses,cls,-1); } /********************************************************** NAME : FormInstanceTemplate DESCRIPTION : Forms a contiguous array of instance slots for use in creating instances later Also used in determining instance slot indices a priori during handler defns INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Contiguous array of instance slots formed NOTES : None **********************************************************/ static void FormInstanceTemplate( void *theEnv, DEFCLASS *cls) { TEMP_SLOT_LINK *islots = NULL,*stmp; unsigned scnt = 0; register unsigned i; /* ======================== Get direct class's slots ======================== */ islots = MergeSlots(theEnv,islots,cls,&scnt,DIRECT); /* =================================================================== Get all inherited slots - a more specific slot takes precedence over more general, i.e. the first class in the precedence list with a particular slot gets to specify its default value =================================================================== */ for (i = 1 ; i < cls->allSuperclasses.classCount ; i++) islots = MergeSlots(theEnv,islots,cls->allSuperclasses.classArray[i],&scnt,INHERIT); /* =================================================== Allocate a contiguous array to store all the slots. =================================================== */ cls->instanceSlotCount = scnt; cls->localInstanceSlotCount = 0; if (scnt > 0) cls->instanceTemplate = (SLOT_DESC **) gm2(theEnv,(scnt * sizeof(SLOT_DESC *))); for (i = 0 ; i < scnt ; i++) { stmp = islots; islots = islots->nxt; cls->instanceTemplate[i] = stmp->desc; if (stmp->desc->shared == 0) cls->localInstanceSlotCount++; rtn_struct(theEnv,tempSlotLink,stmp); } } /********************************************************** NAME : FormSlotNameMap DESCRIPTION : Forms a mapping of the slot name ids into the instance template. Given the slot name id, this map provides a much faster lookup of a slot. The id is stored statically in object patterns and can be looked up via a hash table at runtime as well. INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Contiguous array of integers formed The position in the array corresponding to a slot name id holds an the index into the instance template array holding the slot The max slot name id for the class is also stored to make deletion of the slots easier NOTES : Assumes the instance template has already been formed **********************************************************/ static void FormSlotNameMap( void *theEnv, DEFCLASS *cls) { register unsigned i; cls->maxSlotNameID = 0; cls->slotNameMap = NULL; if (cls->instanceSlotCount == 0) return; for (i = 0 ; i < cls->instanceSlotCount ; i++) if (cls->instanceTemplate[i]->slotName->id > cls->maxSlotNameID) cls->maxSlotNameID = cls->instanceTemplate[i]->slotName->id; cls->slotNameMap = (unsigned *) gm2(theEnv,(sizeof(unsigned) * (cls->maxSlotNameID + 1))); for (i = 0 ; i <= cls->maxSlotNameID ; i++) cls->slotNameMap[i] = 0; for (i = 0 ; i < cls->instanceSlotCount ; i++) cls->slotNameMap[cls->instanceTemplate[i]->slotName->id] = i + 1; } /******************************************************************** NAME : MergeSlots DESCRIPTION : Adds non-duplicate slots to list and increments slot count for the class instance template INPUTS : 1) The old slot list 2) The address of class containing new slots 3) Caller's buffer for # of slots 4) A flag indicating whether the new list of slots is from the direct parent-class or not. RETURNS : The address of the new expanded list, or NULL for an empty list SIDE EFFECTS : The list is expanded Caller's slot count is adjusted. NOTES : Lists are assumed to contain no duplicates *******************************************************************/ static TEMP_SLOT_LINK *MergeSlots( void *theEnv, TEMP_SLOT_LINK *old, DEFCLASS *cls, unsigned *scnt, int src) { TEMP_SLOT_LINK *cur,*tmp; register int i; SLOT_DESC *newSlot; /* ====================================== Process the slots in reverse order since we are pushing them onto a stack ====================================== */ for (i = (int) (cls->slotCount - 1) ; i >= 0 ; i--) { newSlot = &cls->slots[i]; /* ========================================== A class can prevent it slots from being propagated to all but its direct instances ========================================== */ if ((newSlot->noInherit == 0) ? TRUE : (src == DIRECT)) { cur = old; while ((cur != NULL) ? (newSlot->slotName != cur->desc->slotName) : FALSE) cur = cur->nxt; if (cur == NULL) { tmp = get_struct(theEnv,tempSlotLink); tmp->desc = newSlot; tmp->nxt = old; old = tmp; (*scnt)++; } } } return(old); } /*********************************************************************** NAME : PackSlots DESCRIPTION : Groups class-slots into a contiguous array "slots" field points to array "slotCount" field set INPUTS : 1) The class 2) The list of slots RETURNS : Nothing useful SIDE EFFECTS : Temporary list deallocated, contiguous array allocated, and nxt pointers linked Class pointer set for slots NOTES : Assumes class->slotCount == 0 && class->slots == NULL ***********************************************************************/ static void PackSlots( void *theEnv, DEFCLASS *cls, TEMP_SLOT_LINK *slots) { TEMP_SLOT_LINK *stmp,*sprv; register unsigned i; stmp = slots; while (stmp != NULL) { stmp->desc->cls = cls; cls->slotCount++; stmp = stmp->nxt; } cls->slots = (SLOT_DESC *) gm2(theEnv,(sizeof(SLOT_DESC) * cls->slotCount)); stmp = slots; for (i = 0 ; i < cls->slotCount ; i++) { sprv = stmp; stmp = stmp->nxt; GenCopyMemory(SLOT_DESC,1,&(cls->slots[i]),sprv->desc); cls->slots[i].sharedValue.desc = &(cls->slots[i]); cls->slots[i].sharedValue.value = NULL; rtn_struct(theEnv,slotDescriptor,sprv->desc); rtn_struct(theEnv,tempSlotLink,sprv); } } #if DEFMODULE_CONSTRUCT /******************************************************** NAME : CreateClassScopeMap DESCRIPTION : Creates a bitmap where each bit position corresponds to a module id. If the bit is set, the class is in scope for that module, otherwise it is not. INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Scope bitmap created and attached NOTES : Uses FindImportedConstruct() ********************************************************/ static void CreateClassScopeMap( void *theEnv, DEFCLASS *theDefclass) { unsigned scopeMapSize; char *scopeMap; char *className; struct defmodule *matchModule, *theModule; int moduleID,count; className = ValueToString(theDefclass->header.name); matchModule = theDefclass->header.whichModule->theModule; scopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1)); scopeMap = (char *) gm2(theEnv,scopeMapSize); ClearBitString((void *) scopeMap,scopeMapSize); SaveCurrentModule(theEnv); for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL) ; theModule != NULL ; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleID = (int) theModule->bsaveID; if (FindImportedConstruct(theEnv,"defclass",matchModule, className,&count,TRUE,NULL) != NULL) SetBitMap(scopeMap,moduleID); } RestoreCurrentModule(theEnv); theDefclass->scopeMap = (BITMAP_HN *) AddBitMap(theEnv,scopeMap,scopeMapSize); IncrementBitMapCount(theDefclass->scopeMap); rm(theEnv,(void *) scopeMap,scopeMapSize); } #endif /***************************************************************************** NAME : CreatePublicSlotMessageHandlers DESCRIPTION : Creates a get- and put- handler for every public slot in a class. The syntax of the message-handlers created are: (defmessage-handler get- primary () ?self:) For single-field slots: (defmessage-handler put- primary (?value) (bind ?self: ?value)) For multifield slots: (defmessage-handler put- primary ($?value) (bind ?self: ?value)) INPUTS : The defclass RETURNS : Nothing useful SIDE EFFECTS : Message-handlers created NOTES : None ******************************************************************************/ static void CreatePublicSlotMessageHandlers( void *theEnv, DEFCLASS *theDefclass) { register unsigned i; register SLOT_DESC *sd; for (i = 0 ; i < theDefclass->slotCount ; i++) { sd = &theDefclass->slots[i]; CreateGetAndPutHandlers(theEnv,sd); } for (i = 0 ; i < theDefclass->handlerCount ; i++) theDefclass->handlers[i].system = TRUE; } #endif clips-6.24/clipssrc/._bmathfun.c0000400000175000017500000000075410441127746014716 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco8#8#TTFHFMWBBMPSRclips-6.24/clipssrc/._ruledef.h0000400000175000017500000000075410441151105014527 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0mc0mcFclips-6.24/clipssrc/._classini.h0000400000175000017500000000012207422634623014713 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._dffctdef.c0000400000175000017500000000075410441602126014645 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0mc0mcllTTFL(FMPSRMWBBLclips-6.24/clipssrc/dffnxcmp.h0000755000175000017500000000317307422634652014526 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Deffunction Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_dffnxcmp #define _H_dffnxcmp #if DEFFUNCTION_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include "dffnxfun.h" #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupDeffunctionCompiler(void *); LOCALE void PrintDeffunctionReference(void *,FILE *,DEFFUNCTION *,int,int); LOCALE void DeffunctionCModuleReference(void *,FILE *,int,int,int); #endif #endif clips-6.24/clipssrc/._extnfunc.h0000400000175000017500000000075410441132060014732 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco00`TTFS FMWBBMPSRclips-6.24/clipssrc/._symbol.c0000400000175000017500000000075410441164077014415 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco,#~,#~8TTF/B#FMPSRMWBBLclips-6.24/clipssrc/._cstrnchk.h0000400000175000017500000000075410441602117014724 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco0'0'cTTFL(VFMPSRMWBBLclips-6.24/clipssrc/._dffnxexe.h0000400000175000017500000000012207422635002014705 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/genrccom.c0000755000175000017500000017264310441602214014502 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Functions Interface Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT #include #if DEFRULE_CONSTRUCT #include "network.h" #endif #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "genrcbin.h" #endif #if CONSTRUCT_COMPILER #include "genrccmp.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) #include "constrct.h" #include "genrcpsr.h" #endif #if OBJECT_SYSTEM #include "classcom.h" #include "inscom.h" #endif #if DEBUGGING_FUNCTIONS #include "watch.h" #endif #include "argacces.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "extnfunc.h" #include "genrcexe.h" #include "memalloc.h" #include "modulpsr.h" #include "multifld.h" #include "router.h" #define _GENRCCOM_SOURCE_ #include "genrccom.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PrintGenericCall(void *,char *,void *); static intBool EvaluateGenericCall(void *,void *,DATA_OBJECT *); static void DecrementGenericBusyCount(void *,void *); static void IncrementGenericBusyCount(void *,void *); static void DeallocateDefgenericData(void *); #if ! RUN_TIME static void DestroyDefgenericAction(void *,struct constructHeader *,void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) static void SaveDefgenerics(void *,void *,char *); static void SaveDefmethods(void *,void *,char *); static void SaveDefmethodsForDefgeneric(void *,struct constructHeader *,void *); static void RemoveDefgenericMethod(void *,DEFGENERIC *,int); #endif #if DEBUGGING_FUNCTIONS static long ListMethodsForGeneric(void *,char *,DEFGENERIC *); static unsigned DefgenericWatchAccess(void *,int,unsigned,EXPRESSION *); static unsigned DefgenericWatchPrint(void *,char *,int,EXPRESSION *); static unsigned DefmethodWatchAccess(void *,int,unsigned,EXPRESSION *); static unsigned DefmethodWatchPrint(void *,char *,int,EXPRESSION *); static unsigned DefmethodWatchSupport(void *,char *,char *,unsigned, void (*)(void *,char *,void *,unsigned), void (*)(void *,unsigned,void *,unsigned), EXPRESSION *); static void PrintMethodWatchFlag(void *,char *,void *,unsigned); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupGenericFunctions DESCRIPTION : Initializes all generic function data structures, constructs and functions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Generic function H/L functions set up NOTES : None ***********************************************************/ globle void SetupGenericFunctions( void *theEnv) { ENTITY_RECORD genericEntityRecord = { "GCALL", GCALL,0,0,1, PrintGenericCall,PrintGenericCall, NULL,EvaluateGenericCall,NULL, DecrementGenericBusyCount,IncrementGenericBusyCount, NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFGENERIC_DATA,sizeof(struct defgenericData),DeallocateDefgenericData); memcpy(&DefgenericData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&DefgenericData(theEnv)->GenericEntityRecord,GCALL); DefgenericData(theEnv)->DefgenericModuleIndex = RegisterModuleItem(theEnv,"defgeneric", #if (! RUN_TIME) AllocateDefgenericModule,FreeDefgenericModule, #else NULL,NULL, #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefgenericModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefgenericCModuleReference, #else NULL, #endif EnvFindDefgeneric); DefgenericData(theEnv)->DefgenericConstruct = AddConstruct(theEnv,"defgeneric","defgenerics", #if (! BLOAD_ONLY) && (! RUN_TIME) ParseDefgeneric, #else NULL, #endif EnvFindDefgeneric, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefgeneric, SetNextConstruct,EnvIsDefgenericDeletable, EnvUndefgeneric, #if (! BLOAD_ONLY) && (! RUN_TIME) RemoveDefgeneric #else NULL #endif ); #if ! RUN_TIME AddClearReadyFunction(theEnv,"defgeneric",ClearDefgenericsReady,0); #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE SetupGenericsBload(theEnv); #endif #if CONSTRUCT_COMPILER SetupGenericsCompiler(theEnv); #endif #if ! BLOAD_ONLY #if DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"defgeneric",SYMBOL); #endif AddConstruct(theEnv,"defmethod","defmethods",ParseDefmethod, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL); /* ================================================================ Make sure defmethods are cleared last, for other constructs may be using them and need to be cleared first Need to be cleared in two stages so that mutually dependent constructs (like classes) can be cleared ================================================================ */ AddSaveFunction(theEnv,"defgeneric",SaveDefgenerics,1000); AddSaveFunction(theEnv,"defmethod",SaveDefmethods,-1000); EnvDefineFunction2(theEnv,"undefgeneric",'v',PTIEF UndefgenericCommand,"UndefgenericCommand","11w"); EnvDefineFunction2(theEnv,"undefmethod",'v',PTIEF UndefmethodCommand,"UndefmethodCommand","22*wg"); #endif EnvDefineFunction2(theEnv,"call-next-method",'u',PTIEF CallNextMethod,"CallNextMethod","00"); FuncSeqOvlFlags(theEnv,"call-next-method",TRUE,FALSE); EnvDefineFunction2(theEnv,"call-specific-method",'u',PTIEF CallSpecificMethod, "CallSpecificMethod","2**wi"); FuncSeqOvlFlags(theEnv,"call-specific-method",TRUE,FALSE); EnvDefineFunction2(theEnv,"override-next-method",'u',PTIEF OverrideNextMethod, "OverrideNextMethod",NULL); FuncSeqOvlFlags(theEnv,"override-next-method",TRUE,FALSE); EnvDefineFunction2(theEnv,"next-methodp",'b',PTIEF NextMethodP,"NextMethodP","00"); FuncSeqOvlFlags(theEnv,"next-methodp",TRUE,FALSE); EnvDefineFunction2(theEnv,"(gnrc-current-arg)",'u',PTIEF GetGenericCurrentArgument, "GetGenericCurrentArgument",NULL); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"ppdefgeneric",'v',PTIEF PPDefgenericCommand,"PPDefgenericCommand","11w"); EnvDefineFunction2(theEnv,"list-defgenerics",'v',PTIEF ListDefgenericsCommand,"ListDefgenericsCommand","01"); EnvDefineFunction2(theEnv,"ppdefmethod",'v',PTIEF PPDefmethodCommand,"PPDefmethodCommand","22*wi"); EnvDefineFunction2(theEnv,"list-defmethods",'v',PTIEF ListDefmethodsCommand,"ListDefmethodsCommand","01w"); EnvDefineFunction2(theEnv,"preview-generic",'v',PTIEF PreviewGeneric,"PreviewGeneric","1**w"); #endif EnvDefineFunction2(theEnv,"get-defgeneric-list",'m',PTIEF GetDefgenericListFunction, "GetDefgenericListFunction","01"); EnvDefineFunction2(theEnv,"get-defmethod-list",'m',PTIEF GetDefmethodListCommand, "GetDefmethodListCommand","01w"); EnvDefineFunction2(theEnv,"get-method-restrictions",'m',PTIEF GetMethodRestrictionsCommand, "GetMethodRestrictionsCommand","22iw"); EnvDefineFunction2(theEnv,"defgeneric-module",'w',PTIEF GetDefgenericModuleCommand, "GetDefgenericModuleCommand","11w"); #if OBJECT_SYSTEM EnvDefineFunction2(theEnv,"type",'u',PTIEF ClassCommand,"ClassCommand","11u"); #else EnvDefineFunction2(theEnv,"type",'u',PTIEF TypeCommand,"TypeCommand","11u"); #endif #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"generic-functions",0,&DefgenericData(theEnv)->WatchGenerics,34, DefgenericWatchAccess,DefgenericWatchPrint); AddWatchItem(theEnv,"methods",0,&DefgenericData(theEnv)->WatchMethods,33, DefmethodWatchAccess,DefmethodWatchPrint); #endif } /*****************************************************/ /* DeallocateDefgenericData: Deallocates environment */ /* data for the defgeneric construct. */ /*****************************************************/ static void DeallocateDefgenericData( void *theEnv) { #if ! RUN_TIME struct defgenericModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDefgenericAction,DefgenericData(theEnv)->DefgenericModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct defgenericModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefgenericData(theEnv)->DefgenericModuleIndex); rtn_struct(theEnv,defgenericModule,theModuleItem); } #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /****************************************************/ /* DestroyDefgenericAction: Action used to remove */ /* defgenerics as a result of DestroyEnvironment. */ /****************************************************/ #if IBM_TBC #pragma argsused #endif static void DestroyDefgenericAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct defgeneric *theDefgeneric = (struct defgeneric *) theConstruct; unsigned i; if (theDefgeneric == NULL) return; for (i = 0 ; i < theDefgeneric->mcnt ; i++) { DestroyMethodInfo(theEnv,theDefgeneric,&theDefgeneric->methods[i]); } if (theDefgeneric->mcnt != 0) rm(theEnv,(void *) theDefgeneric->methods,(sizeof(DEFMETHOD) * theDefgeneric->mcnt)); DestroyConstructHeader(theEnv,&theDefgeneric->header); rtn_struct(theEnv,defgeneric,theDefgeneric); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv,theConstruct) #endif #endif } #endif /*************************************************** NAME : EnvFindDefgeneric DESCRIPTION : Searches for a generic INPUTS : The name of the generic (possibly including a module name) RETURNS : Pointer to the generic if found, otherwise NULL SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDefgeneric( void *theEnv, char *genericModuleAndName) { return(FindNamedConstruct(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct)); } /*************************************************** NAME : LookupDefgenericByMdlOrScope DESCRIPTION : Finds a defgeneric anywhere (if module is specified) or in current or imported modules INPUTS : The defgeneric name RETURNS : The defgeneric (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : None ***************************************************/ globle DEFGENERIC *LookupDefgenericByMdlOrScope( void *theEnv, char *defgenericName) { return((DEFGENERIC *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,TRUE)); } /*************************************************** NAME : LookupDefgenericInScope DESCRIPTION : Finds a defgeneric in current or imported modules (module specifier is not allowed) INPUTS : The defgeneric name RETURNS : The defgeneric (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : None ***************************************************/ globle DEFGENERIC *LookupDefgenericInScope( void *theEnv, char *defgenericName) { return((DEFGENERIC *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,FALSE)); } /*********************************************************** NAME : EnvGetNextDefgeneric DESCRIPTION : Finds first or next generic function INPUTS : The address of the current generic function RETURNS : The address of the next generic function (NULL if none) SIDE EFFECTS : None NOTES : If ptr == NULL, the first generic function is returned. ***********************************************************/ globle void *EnvGetNextDefgeneric( void *theEnv, void *ptr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DefgenericData(theEnv)->DefgenericModuleIndex)); } /*********************************************************** NAME : EnvGetNextDefmethod DESCRIPTION : Find the next method for a generic function INPUTS : 1) The generic function address 2) The index of the current method RETURNS : The index of the next method (0 if none) SIDE EFFECTS : None NOTES : If index == 0, the index of the first method is returned ***********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetNextDefmethod( void *theEnv, void *ptr, unsigned theIndex) { DEFGENERIC *gfunc; int mi; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) ptr; if (theIndex == 0) { if (gfunc->methods != NULL) return(gfunc->methods[0].index); return(0); } mi = FindMethodByIndex(gfunc,theIndex); if ((mi+1) == (int) gfunc->mcnt) return(0); return(gfunc->methods[mi+1].index); } /***************************************************** NAME : GetDefmethodPointer DESCRIPTION : Returns a pointer to a method INPUTS : 1) Pointer to a defgeneric 2) Array index of method in generic's method array (+1) RETURNS : Pointer to the method. SIDE EFFECTS : None NOTES : None *****************************************************/ globle DEFMETHOD *GetDefmethodPointer( void *ptr, unsigned theIndex) { return(&((DEFGENERIC *) ptr)->methods[theIndex-1]); } /*************************************************** NAME : EnvIsDefgenericDeletable DESCRIPTION : Determines if a generic function can be deleted INPUTS : Address of the generic function RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDefgenericDeletable( void *theEnv, void *ptr) { if (! ConstructsDeletable(theEnv)) { return FALSE; } return ((((DEFGENERIC *) ptr)->busy == 0) ? TRUE : FALSE); } /*************************************************** NAME : EnvIsDefmethodDeletable DESCRIPTION : Determines if a generic function method can be deleted INPUTS : 1) Address of the generic function 2) Index of the method RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDefmethodDeletable( void *theEnv, void *ptr, unsigned theIndex) { if (! ConstructsDeletable(theEnv)) { return FALSE; } if (((DEFGENERIC *) ptr)->methods[FindMethodByIndex((DEFGENERIC *) ptr,theIndex)].system) return(FALSE); #if (! BLOAD_ONLY) && (! RUN_TIME) return((MethodsExecuting((DEFGENERIC *) ptr) == FALSE) ? TRUE : FALSE); #else return FALSE; #endif } /********************************************************** NAME : UndefgenericCommand DESCRIPTION : Deletes all methods for a generic function INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : methods deallocated NOTES : H/L Syntax: (undefgeneric | *) **********************************************************/ globle void UndefgenericCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefgeneric",DefgenericData(theEnv)->DefgenericConstruct); } /**************************************************************** NAME : GetDefgenericModuleCommand DESCRIPTION : Determines to which module a defgeneric belongs INPUTS : None RETURNS : The symbolic name of the module SIDE EFFECTS : None NOTES : H/L Syntax: (defgeneric-module ) ****************************************************************/ globle void *GetDefgenericModuleCommand( void *theEnv) { return(GetConstructModuleCommand(theEnv,"defgeneric-module",DefgenericData(theEnv)->DefgenericConstruct)); } /************************************************************** NAME : UndefmethodCommand DESCRIPTION : Deletes one method for a generic function INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : methods deallocated NOTES : H/L Syntax: (undefmethod | *) **************************************************************/ globle void UndefmethodCommand( void *theEnv) { DATA_OBJECT temp; DEFGENERIC *gfunc; unsigned mi; if (EnvArgTypeCheck(theEnv,"undefmethod",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(theEnv,DOToString(temp)); if ((gfunc == NULL) ? (strcmp(DOToString(temp),"*") != 0) : FALSE) { PrintErrorID(theEnv,"GENRCCOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No such generic function "); EnvPrintRouter(theEnv,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,WERROR," in function undefmethod.\n"); return; } EnvRtnUnknown(theEnv,2,&temp); if (temp.type == SYMBOL) { if (strcmp(DOToString(temp),"*") != 0) { PrintErrorID(theEnv,"GENRCCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n"); return; } mi = 0; } else if (temp.type == INTEGER) { mi = (unsigned) DOToInteger(temp); if (mi == 0) { PrintErrorID(theEnv,"GENRCCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n"); return; } } else { PrintErrorID(theEnv,"GENRCCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n"); return; } EnvUndefmethod(theEnv,(void *) gfunc,mi); } /************************************************************** NAME : EnvUndefgeneric DESCRIPTION : Deletes all methods for a generic function INPUTS : The generic-function address (NULL for all) RETURNS : TRUE if generic successfully deleted, FALSE otherwise SIDE EFFECTS : methods deallocated NOTES : None **************************************************************/ globle intBool EnvUndefgeneric( void *theEnv, void *vptr) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vptr) #endif #if RUN_TIME || BLOAD_ONLY return(FALSE); #else DEFGENERIC *gfunc; int success = TRUE; gfunc = (DEFGENERIC *) vptr; if (gfunc == NULL) { if (ClearDefmethods(theEnv) == FALSE) success = FALSE; if (ClearDefgenerics(theEnv) == FALSE) success = FALSE; return(success); } if (EnvIsDefgenericDeletable(theEnv,vptr) == FALSE) return(FALSE); RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr); RemoveDefgeneric(theEnv,gfunc); return(TRUE); #endif } /************************************************************** NAME : EnvUndefmethod DESCRIPTION : Deletes one method for a generic function INPUTS : 1) Address of generic function (can be NULL) 2) Method index (0 for all) RETURNS : TRUE if method deleted successfully, FALSE otherwise SIDE EFFECTS : methods deallocated NOTES : None **************************************************************/ globle intBool EnvUndefmethod( void *theEnv, void *vptr, unsigned mi) { DEFGENERIC *gfunc; #if RUN_TIME || BLOAD_ONLY gfunc = (DEFGENERIC *) vptr; PrintErrorID(theEnv,"PRNTUTIL",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete method "); if (gfunc != NULL) { PrintGenericName(theEnv,WERROR,gfunc); EnvPrintRouter(theEnv,WERROR," #"); PrintLongInteger(theEnv,WERROR,(long) mi); } else EnvPrintRouter(theEnv,WERROR,"*"); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); #else int nmi; gfunc = (DEFGENERIC *) vptr; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) { PrintErrorID(theEnv,"PRNTUTIL",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete method "); if (gfunc != NULL) { EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," #"); PrintLongInteger(theEnv,WERROR,(long) mi); } else EnvPrintRouter(theEnv,WERROR,"*"); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); } #endif if (gfunc == NULL) { if (mi != 0) { PrintErrorID(theEnv,"GENRCCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Incomplete method specification for deletion.\n"); return(FALSE); } return(ClearDefmethods(theEnv)); } if (MethodsExecuting(gfunc)) { MethodAlterError(theEnv,gfunc); return(FALSE); } if (mi == 0) RemoveAllExplicitMethods(theEnv,gfunc); else { nmi = CheckMethodExists(theEnv,"undefmethod",gfunc,(int) mi); if (nmi == -1) return(FALSE); RemoveDefgenericMethod(theEnv,gfunc,nmi); } return(TRUE); #endif } #if DEBUGGING_FUNCTIONS /***************************************************** NAME : EnvGetDefmethodDescription DESCRIPTION : Prints a synopsis of method parameter restrictions into caller's buffer INPUTS : 1) Caller's buffer 2) Buffer size (not including space for terminating '\0') 3) Address of generic function 4) Index of method RETURNS : Nothing useful SIDE EFFECTS : Caller's buffer written NOTES : Terminating '\n' not written *****************************************************/ globle void EnvGetDefmethodDescription( void *theEnv, char *buf, int buflen, void *ptr, unsigned theIndex) { DEFGENERIC *gfunc; int mi; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) ptr; mi = FindMethodByIndex(gfunc,theIndex); PrintMethod(theEnv,buf,buflen,&gfunc->methods[mi]); } /********************************************************* NAME : EnvGetDefgenericWatch DESCRIPTION : Determines if trace messages are gnerated when executing generic function INPUTS : A pointer to the generic RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDefgenericWatch( void *theEnv, void *theGeneric) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((DEFGENERIC *) theGeneric)->trace); } /********************************************************* NAME : EnvSetDefgenericWatch DESCRIPTION : Sets the trace to ON/OFF for the generic function INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the generic RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the generic set NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDefgenericWatch( void *theEnv, unsigned newState, void *theGeneric) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((DEFGENERIC *) theGeneric)->trace = newState; } /********************************************************* NAME : EnvGetDefmethodWatch DESCRIPTION : Determines if trace messages for calls to this method will be generated or not INPUTS : 1) A pointer to the generic 2) The index of the method RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDefmethodWatch( void *theEnv, void *theGeneric, unsigned theIndex) { DEFGENERIC *gfunc; int mi; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) theGeneric; mi = FindMethodByIndex(gfunc,theIndex); return(gfunc->methods[mi].trace); } /********************************************************* NAME : EnvSetDefmethodWatch DESCRIPTION : Sets the trace to ON/OFF for the calling of the method INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the generic 3) The index of the method RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the method set NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDefmethodWatch( void *theEnv, unsigned newState, void *theGeneric, unsigned theIndex) { DEFGENERIC *gfunc; int mi; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) theGeneric; mi = FindMethodByIndex(gfunc,theIndex); gfunc->methods[mi].trace = newState; } /******************************************************** NAME : PPDefgenericCommand DESCRIPTION : Displays the pretty-print form of a generic function header INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (ppdefgeneric ) ********************************************************/ globle void PPDefgenericCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefgeneric",DefgenericData(theEnv)->DefgenericConstruct); } /********************************************************** NAME : PPDefmethodCommand DESCRIPTION : Displays the pretty-print form of a method INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (ppdefmethod ) **********************************************************/ globle void PPDefmethodCommand( void *theEnv) { DATA_OBJECT temp; char *gname; DEFGENERIC *gfunc; int gi; if (EnvArgTypeCheck(theEnv,"ppdefmethod",1,SYMBOL,&temp) == FALSE) return; gname = DOToString(temp); if (EnvArgTypeCheck(theEnv,"ppdefmethod",2,INTEGER,&temp) == FALSE) return; gfunc = CheckGenericExists(theEnv,"ppdefmethod",gname); if (gfunc == NULL) return; gi = CheckMethodExists(theEnv,"ppdefmethod",gfunc,DOToInteger(temp)); if (gi == -1) return; if (gfunc->methods[gi].ppForm != NULL) PrintInChunks(theEnv,WDISPLAY,gfunc->methods[gi].ppForm); } /****************************************************** NAME : ListDefmethodsCommand DESCRIPTION : Lists a brief description of methods for a particular generic function INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (list-defmethods ) ******************************************************/ globle void ListDefmethodsCommand( void *theEnv) { DATA_OBJECT temp; DEFGENERIC *gfunc; if (EnvRtnArgCount(theEnv) == 0) EnvListDefmethods(theEnv,WDISPLAY,NULL); else { if (EnvArgTypeCheck(theEnv,"list-defmethods",1,SYMBOL,&temp) == FALSE) return; gfunc = CheckGenericExists(theEnv,"list-defmethods",DOToString(temp)); if (gfunc != NULL) EnvListDefmethods(theEnv,WDISPLAY,(void *) gfunc); } } /*************************************************************** NAME : EnvGetDefmethodPPForm DESCRIPTION : Getsa generic function method pretty print form INPUTS : 1) Address of the generic function 2) Index of the method RETURNS : Method ppform SIDE EFFECTS : None NOTES : None ***************************************************************/ #if IBM_TBC #pragma argsused #endif globle char *EnvGetDefmethodPPForm( void *theEnv, void *ptr, unsigned theIndex) { DEFGENERIC *gfunc; int mi; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif gfunc = (DEFGENERIC *) ptr; mi = FindMethodByIndex(gfunc,theIndex); return(gfunc->methods[mi].ppForm); } /*************************************************** NAME : ListDefgenericsCommand DESCRIPTION : Displays all defgeneric names INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Defgeneric names printed NOTES : H/L Interface ***************************************************/ globle void ListDefgenericsCommand( void *theEnv) { ListConstructCommand(theEnv,"list-defgenerics",DefgenericData(theEnv)->DefgenericConstruct); } /*************************************************** NAME : EnvListDefgenerics DESCRIPTION : Displays all defgeneric names INPUTS : 1) The logical name of the output 2) The module RETURNS : Nothing useful SIDE EFFECTS : Defgeneric names printed NOTES : C Interface ***************************************************/ globle void EnvListDefgenerics( void *theEnv, char *logicalName, struct defmodule *theModule) { ListConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logicalName,theModule); } /****************************************************** NAME : EnvListDefmethods DESCRIPTION : Lists a brief description of methods for a particular generic function INPUTS : 1) The logical name of the output 2) Generic function to list methods for (NULL means list all methods) RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ******************************************************/ globle void EnvListDefmethods( void *theEnv, char *logicalName, void *vptr) { DEFGENERIC *gfunc; long count; if (vptr != NULL) count = ListMethodsForGeneric(theEnv,logicalName,(DEFGENERIC *) vptr); else { count = 0L; for (gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL) ; gfunc != NULL ; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc)) { count += ListMethodsForGeneric(theEnv,logicalName,gfunc); if (EnvGetNextDefgeneric(theEnv,(void *) gfunc) != NULL) EnvPrintRouter(theEnv,logicalName,"\n"); } } PrintTally(theEnv,logicalName,count,"method","methods"); } #endif /*************************************************************** NAME : GetDefgenericListFunction DESCRIPTION : Groups all defgeneric names into a multifield list INPUTS : A data object buffer to hold the multifield result RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : H/L Syntax: (get-defgeneric-list []) ***************************************************************/ globle void GetDefgenericListFunction( void *theEnv, DATA_OBJECT*returnValue) { GetConstructListFunction(theEnv,"get-defgeneric-list",returnValue,DefgenericData(theEnv)->DefgenericConstruct); } /*************************************************************** NAME : EnvGetDefgenericList DESCRIPTION : Groups all defgeneric names into a multifield list INPUTS : 1) A data object buffer to hold the multifield result 2) The module from which to obtain defgenerics RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : External C access ***************************************************************/ globle void EnvGetDefgenericList( void *theEnv, DATA_OBJECT *returnValue, struct defmodule *theModule) { GetConstructList(theEnv,returnValue,DefgenericData(theEnv)->DefgenericConstruct,theModule); } /*********************************************************** NAME : GetDefmethodListCommand DESCRIPTION : Groups indices of all methdos for a generic function into a multifield variable (NULL means get methods for all generics) INPUTS : A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Multifield set to list of method indices NOTES : None ***********************************************************/ globle void GetDefmethodListCommand( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT temp; DEFGENERIC *gfunc; if (EnvRtnArgCount(theEnv) == 0) EnvGetDefmethodList(theEnv,NULL,returnValue); else { if (EnvArgTypeCheck(theEnv,"get-defmethod-list",1,SYMBOL,&temp) == FALSE) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } gfunc = CheckGenericExists(theEnv,"get-defmethod-list",DOToString(temp)); if (gfunc != NULL) EnvGetDefmethodList(theEnv,(void *) gfunc,returnValue); else EnvSetMultifieldErrorValue(theEnv,returnValue); } } /*********************************************************** NAME : EnvGetDefmethodList DESCRIPTION : Groups indices of all methdos for a generic function into a multifield variable (NULL means get methods for all generics) INPUTS : 1) A pointer to a generic function 2) A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Multifield set to list of method indices NOTES : None ***********************************************************/ globle void EnvGetDefmethodList( void *theEnv, void *vgfunc, DATA_OBJECT_PTR returnValue) { DEFGENERIC *gfunc,*svg,*svnxt; unsigned i,j; unsigned long count; MULTIFIELD_PTR theList; if (vgfunc != NULL) { gfunc = (DEFGENERIC *) vgfunc; svnxt = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,vgfunc); SetNextDefgeneric(vgfunc,NULL); } else { gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); svnxt = (gfunc != NULL) ? (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc) : NULL; } count = 0; for (svg = gfunc ; gfunc != NULL ; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc)) count += (unsigned long) gfunc->mcnt; count *= 2; SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,count); theList = (MULTIFIELD_PTR) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,theList); for (gfunc = svg , i = 1 ; gfunc != NULL ; gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc)) { for (j = 0 ; j < gfunc->mcnt ; j++) { SetMFType(theList,i,SYMBOL); SetMFValue(theList,i++,GetDefgenericNamePointer((void *) gfunc)); SetMFType(theList,i,INTEGER); SetMFValue(theList,i++,EnvAddLong(theEnv,(long) gfunc->methods[j].index)); } } if (svg != NULL) SetNextDefgeneric((void *) svg,(void *) svnxt); } /*********************************************************************************** NAME : GetMethodRestrictionsCommand DESCRIPTION : Stores restrictions of a method in multifield INPUTS : A data object buffer to hold a multifield RETURNS : Nothing useful SIDE EFFECTS : Multifield created (length zero on errors) NOTES : Syntax: (get-method-restrictions ) ***********************************************************************************/ globle void GetMethodRestrictionsCommand( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT temp; DEFGENERIC *gfunc; if (EnvArgTypeCheck(theEnv,"get-method-restrictions",1,SYMBOL,&temp) == FALSE) { EnvSetMultifieldErrorValue(theEnv,result); return; } gfunc = CheckGenericExists(theEnv,"get-method-restrictions",DOToString(temp)); if (gfunc == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } if (EnvArgTypeCheck(theEnv,"get-method-restrictions",2,INTEGER,&temp) == FALSE) { EnvSetMultifieldErrorValue(theEnv,result); return; } if (CheckMethodExists(theEnv,"get-method-restrictions",gfunc,DOToInteger(temp)) == -1) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvGetMethodRestrictions(theEnv,(void *) gfunc,(unsigned) DOToInteger(temp),result); } /*********************************************************************** NAME : EnvGetMethodRestrictions DESCRIPTION : Stores restrictions of a method in multifield INPUTS : 1) Pointer to the generic function 2) The method index 3) A data object buffer to hold a multifield RETURNS : Nothing useful SIDE EFFECTS : Multifield created (length zero on errors) NOTES : The restrictions are stored in the multifield in the following format: (-1 if wildcard allowed) . . . . . . . Thus, for the method (defmethod foo ((?a NUMBER SYMBOL) (?b (= 1 1)) $?c)) (get-method-restrictions foo 1) would yield (2 -1 3 7 11 13 FALSE 2 NUMBER SYMBOL TRUE 0 FALSE 0) ***********************************************************************/ globle void EnvGetMethodRestrictions( void *theEnv, void *vgfunc, unsigned mi, DATA_OBJECT *result) { register unsigned i,j; register DEFMETHOD *meth; register RESTRICTION *rptr; unsigned count; int roffset,rstrctIndex; MULTIFIELD_PTR theList; meth = ((DEFGENERIC *) vgfunc)->methods + FindMethodByIndex((DEFGENERIC *) vgfunc,mi); count = 3; for (i = 0 ; i < (unsigned) meth->restrictionCount ; i++) count += meth->restrictions[i].tcnt + 3; theList = (MULTIFIELD_PTR) EnvCreateMultifield(theEnv,count); SetpType(result,MULTIFIELD); SetpValue(result,theList); SetpDOBegin(result,1); SetpDOEnd(result,count); SetMFType(theList,1,INTEGER); SetMFValue(theList,1,EnvAddLong(theEnv,(long) meth->minRestrictions)); SetMFType(theList,2,INTEGER); SetMFValue(theList,2,EnvAddLong(theEnv,(long) meth->maxRestrictions)); SetMFType(theList,3,INTEGER); SetMFValue(theList,3,EnvAddLong(theEnv,(long) meth->restrictionCount)); roffset = 3 + meth->restrictionCount + 1; rstrctIndex = 4; for (i = 0 ; i < (unsigned) meth->restrictionCount ; i++) { rptr = meth->restrictions + i; SetMFType(theList,rstrctIndex,INTEGER); SetMFValue(theList,rstrctIndex++,EnvAddLong(theEnv,(long) roffset)); SetMFType(theList,roffset,SYMBOL); SetMFValue(theList,roffset++,(rptr->query != NULL) ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv)); SetMFType(theList,roffset,INTEGER); SetMFValue(theList,roffset++,EnvAddLong(theEnv,(long) rptr->tcnt)); for (j = 0 ; j < rptr->tcnt ; j++) { SetMFType(theList,roffset,SYMBOL); #if OBJECT_SYSTEM SetMFValue(theList,roffset++,EnvAddSymbol(theEnv,EnvGetDefclassName(theEnv,rptr->types[j]))); #else SetMFValue(theList,roffset++,EnvAddSymbol(theEnv,TypeName(theEnv,ValueToInteger(rptr->types[j])))); #endif } } } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : PrintGenericCall DESCRIPTION : PrintExpression() support function for generic function calls INPUTS : 1) The output logical name 2) The generic function RETURNS : Nothing useful SIDE EFFECTS : Call expression printed NOTES : None ***************************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintGenericCall( void *theEnv, char *logName, void *value) { #if DEVELOPER EnvPrintRouter(theEnv,logName,"("); EnvPrintRouter(theEnv,logName,EnvGetDefgenericName(theEnv,value)); if (GetFirstArgument() != NULL) { EnvPrintRouter(theEnv,logName," "); PrintExpression(theEnv,logName,GetFirstArgument()); } EnvPrintRouter(theEnv,logName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logName) #pragma unused(value) #endif #endif } /******************************************************* NAME : EvaluateGenericCall DESCRIPTION : Primitive support function for calling a generic function INPUTS : 1) The generic function 2) A data object buffer to hold the evaluation result RETURNS : FALSE if the generic function returns the symbol FALSE, TRUE otherwise SIDE EFFECTS : Data obejct buffer set and any side-effects of calling the generic NOTES : None *******************************************************/ static intBool EvaluateGenericCall( void *theEnv, void *value, DATA_OBJECT *result) { GenericDispatch(theEnv,(DEFGENERIC *) value,NULL,NULL,GetFirstArgument(),result); if ((GetpType(result) == SYMBOL) && (GetpValue(result) == EnvFalseSymbol(theEnv))) return(FALSE); return(TRUE); } /*************************************************** NAME : DecrementGenericBusyCount DESCRIPTION : Lowers the busy count of a generic function construct INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : Busy count decremented if a clear is not in progress (see comment) NOTES : None ***************************************************/ static void DecrementGenericBusyCount( void *theEnv, void *value) { /* ============================================== The generics to which expressions in other constructs may refer may already have been deleted - thus, it is important not to modify the busy flag during a clear. ============================================== */ if (! ConstructData(theEnv)->ClearInProgress) ((DEFGENERIC *) value)->busy--; } /*************************************************** NAME : IncrementGenericBusyCount DESCRIPTION : Raises the busy count of a generic function construct INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : Busy count incremented NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void IncrementGenericBusyCount( void *theEnv, void *value) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((DEFGENERIC *) value)->busy++; } #if (! BLOAD_ONLY) && (! RUN_TIME) /********************************************************************** NAME : SaveDefgenerics DESCRIPTION : Outputs pretty-print forms of generic function headers INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None **********************************************************************/ static void SaveDefgenerics( void *theEnv, void *theModule, char *logName) { SaveConstruct(theEnv,theModule,logName,DefgenericData(theEnv)->DefgenericConstruct); } /********************************************************************** NAME : SaveDefmethods DESCRIPTION : Outputs pretty-print forms of generic function methods INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None **********************************************************************/ static void SaveDefmethods( void *theEnv, void *theModule, char *logName) { DoForAllConstructsInModule(theEnv,theModule,SaveDefmethodsForDefgeneric, DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) logName); } /*************************************************** NAME : SaveDefmethodsForDefgeneric DESCRIPTION : Save the pretty-print forms of all methods for a generic function to a file INPUTS : 1) The defgeneric 2) The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : Methods written NOTES : None ***************************************************/ static void SaveDefmethodsForDefgeneric( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; char *logName = (char *) userBuffer; register unsigned i; for (i = 0 ; i < gfunc->mcnt ; i++) { if (gfunc->methods[i].ppForm != NULL) { PrintInChunks(theEnv,logName,gfunc->methods[i].ppForm); EnvPrintRouter(theEnv,logName,"\n"); } } } /**************************************************** NAME : RemoveDefgenericMethod DESCRIPTION : Removes a generic function method from the array and removes the generic too if its the last method INPUTS : 1) The generic function 2) The array index of the method RETURNS : Nothing useful SIDE EFFECTS : List adjusted Nodes deallocated NOTES : Assumes deletion is safe ****************************************************/ static void RemoveDefgenericMethod( void *theEnv, DEFGENERIC *gfunc, int gi) { DEFMETHOD *narr; register unsigned b,e; if (gfunc->methods[gi].system) { SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"GENRCCOM",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot remove implicit system function method for generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR,".\n"); return; } DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[gi]); if (gfunc->mcnt == 1) { rm(theEnv,(void *) gfunc->methods,(int) sizeof(DEFMETHOD)); gfunc->mcnt = 0; gfunc->methods = NULL; } else { gfunc->mcnt--; narr = (DEFMETHOD *) gm2(theEnv,(sizeof(DEFMETHOD) * gfunc->mcnt)); for (b = e = 0 ; b < gfunc->mcnt ; b++ , e++) { if (((int) b) == gi) e++; GenCopyMemory(DEFMETHOD,1,&narr[b],&gfunc->methods[e]); } rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * (gfunc->mcnt+1))); gfunc->methods = narr; } } #endif #if DEBUGGING_FUNCTIONS /****************************************************** NAME : ListMethodsForGeneric DESCRIPTION : Lists a brief description of methods for a particular generic function INPUTS : 1) The logical name of the output 2) Generic function to list methods for RETURNS : The number of methods printed SIDE EFFECTS : None NOTES : None ******************************************************/ static long ListMethodsForGeneric( void *theEnv, char *logicalName, DEFGENERIC *gfunc) { unsigned gi; char buf[256]; for (gi = 0 ; gi < gfunc->mcnt ; gi++) { EnvPrintRouter(theEnv,logicalName,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,logicalName," #"); PrintMethod(theEnv,buf,255,&gfunc->methods[gi]); EnvPrintRouter(theEnv,logicalName,buf); EnvPrintRouter(theEnv,logicalName,"\n"); } return((long) gfunc->mcnt); } /****************************************************************** NAME : DefgenericWatchAccess DESCRIPTION : Parses a list of generic names passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set Ignored 2) The value to which to set the trace flags 3) A list of expressions containing the names of the generics for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified generics NOTES : Accessory function for AddWatchItem() ******************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DefgenericWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(ConstructSetWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,newState,argExprs, EnvGetDefgenericWatch,EnvSetDefgenericWatch)); } /*********************************************************************** NAME : DefgenericWatchPrint DESCRIPTION : Parses a list of generic names passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined Ignored 3) A list of expressions containing the names of the generics for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified generics NOTES : Accessory function for AddWatchItem() ***********************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DefgenericWatchPrint( void *theEnv, char *logName, int code, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(ConstructPrintWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logName,argExprs, EnvGetDefgenericWatch,EnvSetDefgenericWatch)); } /****************************************************************** NAME : DefmethodWatchAccess DESCRIPTION : Parses a list of methods passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set Ignored 2) The value to which to set the trace flags 3) A list of expressions containing the methods for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified methods NOTES : Accessory function for AddWatchItem() ******************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DefmethodWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(DefmethodWatchSupport(theEnv,(char *) (newState ? "watch" : "unwatch"),NULL, newState,NULL,EnvSetDefmethodWatch,argExprs)); } /*********************************************************************** NAME : DefmethodWatchPrint DESCRIPTION : Parses a list of methods passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined Ignored 3) A list of expressions containing the methods for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified methods NOTES : Accessory function for AddWatchItem() ***********************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DefmethodWatchPrint( void *theEnv, char *logName, int code, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(DefmethodWatchSupport(theEnv,"list-watch-items",logName,0, PrintMethodWatchFlag,NULL,argExprs)); } /******************************************************* NAME : DefmethodWatchSupport DESCRIPTION : Sets or displays methods specified INPUTS : 1) The calling function name 2) The logical output name for displays (can be NULL) 3) The new set state 4) The print function (can be NULL) 5) The trace function (can be NULL) 6) The methods expression list RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Method trace flags set or displayed NOTES : None *******************************************************/ static unsigned DefmethodWatchSupport( void *theEnv, char *funcName, char *logName, unsigned newState, void (*printFunc)(void *,char *,void *,unsigned), void (*traceFunc)(void *,unsigned,void *,unsigned), EXPRESSION *argExprs) { void *theGeneric; unsigned theMethod = 0; int argIndex = 2; DATA_OBJECT genericName,methodIndex; struct defmodule *theModule; /* ============================== If no methods are specified, show the trace for all methods in all generics ============================== */ if (argExprs == NULL) { SaveCurrentModule(theEnv); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); if (traceFunc == NULL) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logName,":\n"); } theGeneric = EnvGetNextDefgeneric(theEnv,NULL); while (theGeneric != NULL) { theMethod = EnvGetNextDefmethod(theEnv,theGeneric,0); while (theMethod != 0) { if (traceFunc != NULL) (*traceFunc)(theEnv,newState,theGeneric,theMethod); else { EnvPrintRouter(theEnv,logName," "); (*printFunc)(theEnv,logName,theGeneric,theMethod); } theMethod = EnvGetNextDefmethod(theEnv,theGeneric,theMethod); } theGeneric = EnvGetNextDefgeneric(theEnv,theGeneric); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } RestoreCurrentModule(theEnv); return(TRUE); } /* ========================================= Set the traces for every method specified ========================================= */ while (argExprs != NULL) { if (EvaluateExpression(theEnv,argExprs,&genericName)) return(FALSE); if ((genericName.type != SYMBOL) ? TRUE : ((theGeneric = (void *) LookupDefgenericByMdlOrScope(theEnv,DOToString(genericName))) == NULL)) { ExpectedTypeError1(theEnv,funcName,argIndex,"generic function name"); return(FALSE); } if (GetNextArgument(argExprs) == NULL) theMethod = 0; else { argExprs = GetNextArgument(argExprs); argIndex++; if (EvaluateExpression(theEnv,argExprs,&methodIndex)) return(FALSE); if ((methodIndex.type != INTEGER) ? FALSE : ((DOToInteger(methodIndex) <= 0) ? FALSE : (FindMethodByIndex((DEFGENERIC *) theGeneric,theMethod) != -1))) theMethod = (unsigned) DOToInteger(methodIndex); else { ExpectedTypeError1(theEnv,funcName,argIndex,"method index"); return(FALSE); } } if (theMethod == 0) { theMethod = EnvGetNextDefmethod(theEnv,theGeneric,0); while (theMethod != 0) { if (traceFunc != NULL) (*traceFunc)(theEnv,newState,theGeneric,theMethod); else (*printFunc)(theEnv,logName,theGeneric,theMethod); theMethod = EnvGetNextDefmethod(theEnv,theGeneric,theMethod); } } else { if (traceFunc != NULL) (*traceFunc)(theEnv,newState,theGeneric,theMethod); else (*printFunc)(theEnv,logName,theGeneric,theMethod); } argExprs = GetNextArgument(argExprs); argIndex++; } return(TRUE); } /*************************************************** NAME : PrintMethodWatchFlag DESCRIPTION : Displays trace value for method INPUTS : 1) The logical name of the output 2) The generic function 3) The method index RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void PrintMethodWatchFlag( void *theEnv, char *logName, void *theGeneric, unsigned theMethod) { char buf[60]; EnvPrintRouter(theEnv,logName,EnvGetDefgenericName(theEnv,theGeneric)); EnvPrintRouter(theEnv,logName," "); EnvGetDefmethodDescription(theEnv,buf,59,theGeneric,theMethod); EnvPrintRouter(theEnv,logName,buf); EnvPrintRouter(theEnv,logName,(char *) (EnvGetDefmethodWatch(theEnv,theGeneric,theMethod) ? " = on\n" : " = off\n")); } #endif #if ! OBJECT_SYSTEM /*************************************************** NAME : TypeCommand DESCRIPTION : Works like "class" in COOL INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (type ) ***************************************************/ globle void TypeCommand( void *theEnv, DATA_OBJECT *result) { EvaluateExpression(theEnv,GetFirstArgument(),result); result->value = (void *) EnvAddSymbol(theEnv,TypeName(theEnv,result->type)); result->type = SYMBOL; } #endif #endif clips-6.24/clipssrc/rulecstr.h0000755000175000017500000000460010441151053014540 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* RULE CONSTRAINTS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for detecting constraint */ /* conflicts in the LHS and RHS of rules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_rulecstr #define _H_rulecstr #ifdef LOCALE #undef LOCALE #endif #ifdef _RULECSTR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct lhsParseNode *GetExpressionVarConstraints(void *,struct lhsParseNode *); LOCALE struct lhsParseNode *DeriveVariableConstraints(void *,struct lhsParseNode *); LOCALE intBool ProcessConnectedConstraints(void *,struct lhsParseNode *,struct lhsParseNode *,struct lhsParseNode *); LOCALE void ConstraintReferenceErrorMessage(void *, struct symbolHashNode *, struct lhsParseNode *, int,int, struct symbolHashNode *, int); LOCALE intBool CheckRHSForConstraintErrors(void *,struct expr *,struct lhsParseNode *); #endif clips-6.24/clipssrc/._miscfun.h0000400000175000017500000000075410441150005014543 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z:5,,TTFS FMWBBMPSRclips-6.24/clipssrc/msgcom.h0000755000175000017500000001261207422634537014206 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_msgcom #define _H_msgcom #ifndef _H_object #include "object.h" #endif #ifndef _H_msgpass #include "msgpass.h" #endif #define MESSAGE_HANDLER_DATA 32 struct messageHandlerData { ENTITY_RECORD HandlerGetInfo; ENTITY_RECORD HandlerPutInfo; SYMBOL_HN *INIT_SYMBOL; SYMBOL_HN *DELETE_SYMBOL; SYMBOL_HN *CREATE_SYMBOL; #if DEBUGGING_FUNCTIONS unsigned WatchHandlers; unsigned WatchMessages; #endif char *hndquals[4]; SYMBOL_HN *SELF_SYMBOL; SYMBOL_HN *CurrentMessageName; HANDLER_LINK *CurrentCore; HANDLER_LINK *TopOfCore; HANDLER_LINK *NextInCore; }; #define MessageHandlerData(theEnv) ((struct messageHandlerData *) GetEnvironmentData(theEnv,MESSAGE_HANDLER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _MSGCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define INIT_STRING "init" #define DELETE_STRING "delete" #define PRINT_STRING "print" #define CREATE_STRING "create" #if ENVIRONMENT_API_ONLY #define FindDefmessageHandler(theEnv,a,b,c) EnvFindDefmessageHandler(theEnv,a,b,c) #define GetDefmessageHandlerName(theEnv,a,b) EnvGetDefmessageHandlerName(theEnv,a,b) #define GetDefmessageHandlerPPForm(theEnv,a,b) EnvGetDefmessageHandlerPPForm(theEnv,a,b) #define GetDefmessageHandlerType(theEnv,a,b) EnvGetDefmessageHandlerType(theEnv,a,b) #define GetDefmessageHandlerWatch(theEnv,a,b) EnvGetDefmessageHandlerWatch(theEnv,a,b) #define GetNextDefmessageHandler(theEnv,a,b) EnvGetNextDefmessageHandler(theEnv,a,b) #define IsDefmessageHandlerDeletable(theEnv,a,b) EnvIsDefmessageHandlerDeletable(theEnv,a,b) #define ListDefmessageHandlers(theEnv,a,b,c) EnvListDefmessageHandler(theEnv,a,b,c) #define PreviewSend(theEnv,a,b,c) EnvPreviewSend(theEnv,a,b,c) #define SetDefmessageHandlerWatch(theEnv,a,b,c) EnvSetDefmessageHandlerWatch(theEnv,a,b,c) #define UndefmessageHandler(theEnv,a,b) EnvUndefmessageHandler(theEnv,a,b) #else #define FindDefmessageHandler(a,b,c) EnvFindDefmessageHandler(GetCurrentEnvironment(),a,b,c) #define GetDefmessageHandlerName(a,b) EnvGetDefmessageHandlerName(GetCurrentEnvironment(),a,b) #define GetDefmessageHandlerPPForm(a,b) EnvGetDefmessageHandlerPPForm(GetCurrentEnvironment(),a,b) #define GetDefmessageHandlerType(a,b) EnvGetDefmessageHandlerType(GetCurrentEnvironment(),a,b) #define GetDefmessageHandlerWatch(a,b) EnvGetDefmessageHandlerWatch(GetCurrentEnvironment(),a,b) #define GetNextDefmessageHandler(a,b) EnvGetNextDefmessageHandler(GetCurrentEnvironment(),a,b) #define IsDefmessageHandlerDeletable(a,b) EnvIsDefmessageHandlerDeletable(GetCurrentEnvironment(),a,b) #define ListDefmessageHandlers(a,b,c) EnvListDefmessageHandlers(GetCurrentEnvironment(),a,b,c) #define PreviewSend(a,b,c) EnvPreviewSend(GetCurrentEnvironment(),a,b,c) #define SetDefmessageHandlerWatch(a,b,c) EnvSetDefmessageHandlerWatch(GetCurrentEnvironment(),a,b,c) #define UndefmessageHandler(a,b) EnvUndefmessageHandler(GetCurrentEnvironment(),a,b) #endif LOCALE void SetupMessageHandlers(void *); LOCALE char *EnvGetDefmessageHandlerName(void *,void *,unsigned); LOCALE char *EnvGetDefmessageHandlerType(void *,void *,unsigned); LOCALE unsigned EnvGetNextDefmessageHandler(void *,void *,unsigned); LOCALE HANDLER *GetDefmessageHandlerPointer(void *,unsigned); #if DEBUGGING_FUNCTIONS LOCALE unsigned EnvGetDefmessageHandlerWatch(void *,void *,unsigned); LOCALE void EnvSetDefmessageHandlerWatch(void *,int,void *,unsigned); #endif LOCALE unsigned EnvFindDefmessageHandler(void *,void *,char *,char *); LOCALE int EnvIsDefmessageHandlerDeletable(void *,void *,unsigned); LOCALE void UndefmessageHandlerCommand(void *); LOCALE int EnvUndefmessageHandler(void *,void *,unsigned); #if DEBUGGING_FUNCTIONS LOCALE void PPDefmessageHandlerCommand(void *); LOCALE void ListDefmessageHandlersCommand(void *); LOCALE void PreviewSendCommand(void *); LOCALE char *EnvGetDefmessageHandlerPPForm(void *,void *,unsigned); LOCALE void EnvListDefmessageHandlers(void *,char *,void *,int); LOCALE void EnvPreviewSend(void *,char *,void *,char *); LOCALE long DisplayHandlersInLinks(void *,char *,PACKED_CLASS_LINKS *,unsigned); #endif #endif clips-6.24/clipssrc/._multifld.c0000400000175000017500000000075410441602250014716 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0^90^9:TTFL,FMPSRMWBBLclips-6.24/clipssrc/._factrhs.c0000400000175000017500000000075407673515124014550 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco==%@%#TTFONFMWBBMPSRclips-6.24/clipssrc/inscom.h0000755000175000017500000001403410441147443014177 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_inscom #define _H_inscom #ifndef _H_object #include "object.h" #endif #ifndef _H_insfun #include "insfun.h" #endif #define INSTANCE_DATA 29 struct instanceData { INSTANCE_TYPE DummyInstance; INSTANCE_TYPE **InstanceTable; int MaintainGarbageInstances; int MkInsMsgPass; int ChangesToInstances; IGARBAGE *InstanceGarbageList; struct patternEntityRecord InstanceInfo; INSTANCE_TYPE *InstanceList; unsigned long GlobalNumberOfInstances; INSTANCE_TYPE *CurrentInstance; INSTANCE_TYPE *InstanceListBottom; intBool ObjectModDupMsgValid; }; #define InstanceData(theEnv) ((struct instanceData *) GetEnvironmentData(theEnv,INSTANCE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _INSCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define CreateRawInstance(theEnv,a,b) EnvCreateRawInstance(theEnv,a,b) #define DeleteInstance(theEnv,a) EnvDeleteInstance(theEnv,a) #define DirectGetSlot(theEnv,a,b,c) EnvDirectGetSlot(theEnv,a,b,c) #define DirectPutSlot(theEnv,a,b,c) EnvDirectPutSlot(theEnv,a,b,c) #define FindInstance(theEnv,a,b,c) EnvFindInstance(theEnv,a,b,c) #define GetInstanceClass(theEnv,a) EnvGetInstanceClass(theEnv,a) #define GetInstanceName(theEnv,a) EnvGetInstanceName(theEnv,a) #define GetInstancePPForm(theEnv,a,b,c) EnvGetInstancePPForm(theEnv,a,b,c) #define GetNextInstance(theEnv,a) EnvGetNextInstance(theEnv,a) #define GetNextInstanceInClass(theEnv,a,b) EnvGetNextInstanceInClass(theEnv,a,b) #define GetNextInstanceInClassAndSubclasses(theEnv,a,b,c) EnvGetNextInstanceInClassAndSubclasses(theEnv,a,b,c) #define Instances(theEnv,a,b,c,d) EnvInstances(theEnv,a,b,c,d) #define MakeInstance(theEnv,a) EnvMakeInstance(theEnv,a) #define UnmakeInstance(theEnv,a) EnvUnmakeInstance(theEnv,a) #define ValidInstanceAddress(theEnv,a) EnvValidInstanceAddress(theEnv,a) #else #define CreateRawInstance(a,b) EnvCreateRawInstance(GetCurrentEnvironment(),a,b) #define DeleteInstance(a) EnvDeleteInstance(GetCurrentEnvironment(),a) #define DirectGetSlot(a,b,c) EnvDirectGetSlot(GetCurrentEnvironment(),a,b,c) #define DirectPutSlot(a,b,c) EnvDirectPutSlot(GetCurrentEnvironment(),a,b,c) #define FindInstance(a,b,c) EnvFindInstance(GetCurrentEnvironment(),a,b,c) #define GetInstanceClass(a) EnvGetInstanceClass(GetCurrentEnvironment(),a) #define GetInstanceName(a) EnvGetInstanceName(GetCurrentEnvironment(),a) #define GetInstancePPForm(a,b,c) EnvGetInstancePPForm(GetCurrentEnvironment(),a,b,c) #define GetNextInstance(a) EnvGetNextInstance(GetCurrentEnvironment(),a) #define GetNextInstanceInClass(a,b) EnvGetNextInstanceInClass(GetCurrentEnvironment(),a,b) #define GetNextInstanceInClassAndSubclasses(a,b,c) EnvGetNextInstanceInClassAndSubclasses(GetCurrentEnvironment(),a,b,c) #define Instances(a,b,c,d) EnvInstances(GetCurrentEnvironment(),a,b,c,d) #define MakeInstance(a) EnvMakeInstance(GetCurrentEnvironment(),a) #define UnmakeInstance(a) EnvUnmakeInstance(GetCurrentEnvironment(),a) #define ValidInstanceAddress(a) EnvValidInstanceAddress(GetCurrentEnvironment(),a) #endif LOCALE void SetupInstances(void *); LOCALE intBool EnvDeleteInstance(void *,void *); LOCALE intBool EnvUnmakeInstance(void *,void *); #if DEBUGGING_FUNCTIONS LOCALE void InstancesCommand(void *); LOCALE void PPInstanceCommand(void *); LOCALE void EnvInstances(void *,char *,void *,char *,int); #endif LOCALE void *EnvMakeInstance(void *,char *); LOCALE void *EnvCreateRawInstance(void *,void *,char *); LOCALE void *EnvFindInstance(void *,void *,char *,unsigned); LOCALE int EnvValidInstanceAddress(void *,void *); LOCALE void EnvDirectGetSlot(void *,void *,char *,DATA_OBJECT *); LOCALE int EnvDirectPutSlot(void *,void *,char *,DATA_OBJECT *); LOCALE char *EnvGetInstanceName(void *,void *); LOCALE void *EnvGetInstanceClass(void *,void *); LOCALE unsigned long GetGlobalNumberOfInstances(void *); LOCALE void *EnvGetNextInstance(void *,void *); LOCALE void *GetNextInstanceInScope(void *,void *); LOCALE void *EnvGetNextInstanceInClass(void *,void *,void *); LOCALE void *EnvGetNextInstanceInClassAndSubclasses(void *,void **,void *,DATA_OBJECT *); LOCALE void EnvGetInstancePPForm(void *,char *,unsigned,void *); LOCALE void ClassCommand(void *,DATA_OBJECT *); LOCALE intBool DeleteInstanceCommand(void *); LOCALE intBool UnmakeInstanceCommand(void *); LOCALE void SymbolToInstanceName(void *,DATA_OBJECT *); LOCALE void *InstanceNameToSymbol(void *); LOCALE void InstanceAddressCommand(void *,DATA_OBJECT *); LOCALE void InstanceNameCommand(void *,DATA_OBJECT *); LOCALE intBool InstanceAddressPCommand(void *); LOCALE intBool InstanceNamePCommand(void *); LOCALE intBool InstancePCommand(void *); LOCALE intBool InstanceExistPCommand(void *); LOCALE intBool CreateInstanceHandler(void *); #endif clips-6.24/clipssrc/._default.c0000400000175000017500000000075410441166550014532 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco;v<;v<JTTF/B"FMPSRMWBBLclips-6.24/clipssrc/._multifld.h0000400000175000017500000000075410441602251014724 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0R0R:TTFL,FMPSRMWBBLclips-6.24/clipssrc/._evaluatn.c0000400000175000017500000000075410441602154014720 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH MonacoNsNNsN&,,TTFL(FMPSRMWBBLclips-6.24/clipssrc/filertr.h0000755000175000017500000000415607422634710014365 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FILE I/O ROUTER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: I/O Router routines which allow files to be used */ /* as input and output sources. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_filertr #define _H_filertr #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define FILE_ROUTER_DATA 47 struct fileRouter { char *logicalName; FILE *stream; struct fileRouter *next; }; struct fileRouterData { struct fileRouter *ListOfFileRouters; }; #define FileRouterData(theEnv) ((struct fileRouterData *) GetEnvironmentData(theEnv,FILE_ROUTER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _FILERTR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeFileRouter(void *); LOCALE FILE *FindFptr(void *,char *); LOCALE int OpenAFile(void *,char *,char *,char *); LOCALE int CloseAllFiles(void *); LOCALE int CloseFile(void *,char *); LOCALE int FindFile(void *,char *); #endif clips-6.24/clipssrc/._pattern.c0000400000175000017500000000075410441150460014554 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco00;`TTFS SFMWBBMPSRclips-6.24/clipssrc/prcdrfun.c0000755000175000017500000005113510441150533014522 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* PROCEDURAL FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several procedural */ /* functions including if, while, loop-for-count, bind, */ /* progn, return, break, and switch */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _PRCDRFUN_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "argacces.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnops.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "multifld.h" #include "prcdrpsr.h" #include "router.h" #include "scanner.h" #include "utility.h" #include "prcdrfun.h" #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #endif /**********************************************/ /* ProceduralFunctionDefinitions: Initializes */ /* the procedural functions. */ /**********************************************/ globle void ProceduralFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,PRCDRFUN_DATA,sizeof(struct procedureFunctionData),NULL); #if ! RUN_TIME EnvDefineFunction2(theEnv,"if", 'u', PTIEF IfFunction, "IfFunction", NULL); EnvDefineFunction2(theEnv,"while", 'u', PTIEF WhileFunction, "WhileFunction", NULL); EnvDefineFunction2(theEnv,"loop-for-count",'u', PTIEF LoopForCountFunction, "LoopForCountFunction", NULL); EnvDefineFunction2(theEnv,"(get-loop-count)",'l', PTIEF GetLoopCount, "GetLoopCount", NULL); EnvDefineFunction2(theEnv,"bind", 'u', PTIEF BindFunction, "BindFunction", NULL); EnvDefineFunction2(theEnv,"progn", 'u', PTIEF PrognFunction, "PrognFunction", NULL); EnvDefineFunction2(theEnv,"return", 'u', PTIEF ReturnFunction, "ReturnFunction",NULL); EnvDefineFunction2(theEnv,"break", 'v', PTIEF BreakFunction, "BreakFunction",NULL); EnvDefineFunction2(theEnv,"switch", 'u', PTIEF SwitchFunction, "SwitchFunction",NULL); ProceduralFunctionParsers(theEnv); FuncSeqOvlFlags(theEnv,"progn",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"if",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"while",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"loop-for-count",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"return",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"switch",FALSE,FALSE); #endif } /***************************************/ /* WhileFunction: H/L access routine */ /* for the while function. */ /***************************************/ globle void WhileFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theResult; /*====================================================*/ /* Evaluate the body of the while loop as long as the */ /* while condition evaluates to a non-FALSE value. */ /*====================================================*/ EvaluationData(theEnv)->CurrentEvaluationDepth++; EnvRtnUnknown(theEnv,1,&theResult); while (((theResult.value != EnvFalseSymbol(theEnv)) || (theResult.type != SYMBOL)) && (EvaluationData(theEnv)->HaltExecution != TRUE)) { if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; EnvRtnUnknown(theEnv,2,&theResult); EvaluationData(theEnv)->CurrentEvaluationDepth--; if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { PropagateReturnValue(theEnv,&theResult); } PeriodicCleanup(theEnv,FALSE,TRUE); EvaluationData(theEnv)->CurrentEvaluationDepth++; if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; EnvRtnUnknown(theEnv,1,&theResult); } EvaluationData(theEnv)->CurrentEvaluationDepth--; /*=====================================================*/ /* Reset the break flag. The return flag is not reset */ /* because the while loop is probably contained within */ /* a deffunction or RHS of a rule which needs to be */ /* returned from as well. */ /*=====================================================*/ ProcedureFunctionData(theEnv)->BreakFlag = FALSE; /*====================================================*/ /* If the return command was issued, then return that */ /* value, otherwise return the symbol FALSE. */ /*====================================================*/ if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { returnValue->type = theResult.type; returnValue->value = theResult.value; returnValue->begin = theResult.begin; returnValue->end = theResult.end; } else { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); } } /**********************************************/ /* LoopForCountFunction: H/L access routine */ /* for the loop-for-count function. */ /**********************************************/ globle void LoopForCountFunction( void *theEnv, DATA_OBJECT_PTR loopResult) { DATA_OBJECT arg_ptr; long iterationEnd; LOOP_COUNTER_STACK *tmpCounter; tmpCounter = get_struct(theEnv,loopCounterStack); tmpCounter->loopCounter = 0L; tmpCounter->nxt = ProcedureFunctionData(theEnv)->LoopCounterStack; ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter; if (EnvArgTypeCheck(theEnv,"loop-for-count",1,INTEGER,&arg_ptr) == FALSE) { loopResult->type = SYMBOL; loopResult->value = EnvFalseSymbol(theEnv); ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt; rtn_struct(theEnv,loopCounterStack,tmpCounter); return; } tmpCounter->loopCounter = DOToLong(arg_ptr); if (EnvArgTypeCheck(theEnv,"loop-for-count",2,INTEGER,&arg_ptr) == FALSE) { loopResult->type = SYMBOL; loopResult->value = EnvFalseSymbol(theEnv); ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt; rtn_struct(theEnv,loopCounterStack,tmpCounter); return; } iterationEnd = DOToLong(arg_ptr); while ((tmpCounter->loopCounter <= iterationEnd) && (EvaluationData(theEnv)->HaltExecution != TRUE)) { if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; EvaluationData(theEnv)->CurrentEvaluationDepth++; EnvRtnUnknown(theEnv,3,&arg_ptr); EvaluationData(theEnv)->CurrentEvaluationDepth--; if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { PropagateReturnValue(theEnv,&arg_ptr); } PeriodicCleanup(theEnv,FALSE,TRUE); if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; tmpCounter->loopCounter++; } ProcedureFunctionData(theEnv)->BreakFlag = FALSE; if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { loopResult->type = arg_ptr.type; loopResult->value = arg_ptr.value; loopResult->begin = arg_ptr.begin; loopResult->end = arg_ptr.end; } else { loopResult->type = SYMBOL; loopResult->value = EnvFalseSymbol(theEnv); } ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt; rtn_struct(theEnv,loopCounterStack,tmpCounter); } /************************************************/ /* GetLoopCount */ /************************************************/ globle long GetLoopCount( void *theEnv) { int depth; LOOP_COUNTER_STACK *tmpCounter; depth = ValueToInteger(GetFirstArgument()->value); tmpCounter = ProcedureFunctionData(theEnv)->LoopCounterStack; while (depth > 0) { tmpCounter = tmpCounter->nxt; depth--; } return(tmpCounter->loopCounter); } /************************************/ /* IfFunction: H/L access routine */ /* for the if function. */ /************************************/ globle void IfFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { int numArgs; struct expr *theExpr; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((EvaluationData(theEnv)->CurrentExpression->argList == NULL) || (EvaluationData(theEnv)->CurrentExpression->argList->nextArg == NULL)) { EnvArgRangeCheck(theEnv,"if",2,3); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } if (EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg == NULL) { numArgs = 2; } else if (EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg->nextArg == NULL) { numArgs = 3; } else { EnvArgRangeCheck(theEnv,"if",2,3); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /*=========================*/ /* Evaluate the condition. */ /*=========================*/ EvaluateExpression(theEnv,EvaluationData(theEnv)->CurrentExpression->argList,returnValue); if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /*=========================================*/ /* If the condition evaluated to FALSE and */ /* an "else" portion exists, evaluate it */ /* and return the value. */ /*=========================================*/ if ((returnValue->value == EnvFalseSymbol(theEnv)) && (returnValue->type == SYMBOL) && (numArgs == 3)) { theExpr = EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg; switch (theExpr->type) { case INTEGER: case FLOAT: case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif case EXTERNAL_ADDRESS: returnValue->type = theExpr->type; returnValue->value = theExpr->value; break; default: EvaluateExpression(theEnv,theExpr,returnValue); break; } return; } /*===================================================*/ /* Otherwise if the symbol evaluated to a non-FALSE */ /* value, evaluate the "then" portion and return it. */ /*===================================================*/ else if ((returnValue->value != EnvFalseSymbol(theEnv)) || (returnValue->type != SYMBOL)) { theExpr = EvaluationData(theEnv)->CurrentExpression->argList->nextArg; switch (theExpr->type) { case INTEGER: case FLOAT: case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif case EXTERNAL_ADDRESS: returnValue->type = theExpr->type; returnValue->value = theExpr->value; break; default: EvaluateExpression(theEnv,theExpr,returnValue); break; } return; } /*=========================================*/ /* Return FALSE if the condition evaluated */ /* to FALSE and there is no "else" portion */ /* of the if statement. */ /*=========================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /**************************************/ /* BindFunction: H/L access routine */ /* for the bind function. */ /**************************************/ globle void BindFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT *theBind, *lastBind; int found = FALSE, unbindVar = FALSE; SYMBOL_HN *variableName = NULL; #if DEFGLOBAL_CONSTRUCT struct defglobal *theGlobal = NULL; #endif /*===============================================*/ /* Determine the name of the variable to be set. */ /*===============================================*/ #if DEFGLOBAL_CONSTRUCT if (GetFirstArgument()->type == DEFGLOBAL_PTR) { theGlobal = (struct defglobal *) GetFirstArgument()->value; } else #endif { EvaluateExpression(theEnv,GetFirstArgument(),returnValue); variableName = (SYMBOL_HN *) DOPToPointer(returnValue); } /*===========================================*/ /* Determine the new value for the variable. */ /*===========================================*/ if (GetFirstArgument()->nextArg == NULL) { unbindVar = TRUE; } else if (GetFirstArgument()->nextArg->nextArg == NULL) { EvaluateExpression(theEnv,GetFirstArgument()->nextArg,returnValue); } else { StoreInMultifield(theEnv,returnValue,GetFirstArgument()->nextArg,TRUE); } /*==================================*/ /* Bind a defglobal if appropriate. */ /*==================================*/ #if DEFGLOBAL_CONSTRUCT if (theGlobal != NULL) { QSetDefglobalValue(theEnv,theGlobal,returnValue,unbindVar); return; } #endif /*===============================================*/ /* Search for the variable in the list of binds. */ /*===============================================*/ theBind = ProcedureFunctionData(theEnv)->BindList; lastBind = NULL; while ((theBind != NULL) && (found == FALSE)) { if (theBind->supplementalInfo == (void *) variableName) { found = TRUE; } else { lastBind = theBind; theBind = theBind->next; } } /*========================================================*/ /* If variable was not in the list of binds, then add it. */ /* Make sure that this operation preserves the bind list */ /* as a stack. */ /*========================================================*/ if (found == FALSE) { if (unbindVar == FALSE) { theBind = get_struct(theEnv,dataObject); theBind->supplementalInfo = (void *) variableName; theBind->next = NULL; if (lastBind == NULL) { ProcedureFunctionData(theEnv)->BindList = theBind; } else { lastBind->next = theBind; } } else { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } } else { ValueDeinstall(theEnv,theBind); } /*================================*/ /* Set the value of the variable. */ /*================================*/ if (unbindVar == FALSE) { theBind->type = returnValue->type; theBind->value = returnValue->value; theBind->begin = returnValue->begin; theBind->end = returnValue->end; ValueInstall(theEnv,returnValue); } else { if (lastBind == NULL) ProcedureFunctionData(theEnv)->BindList = theBind->next; else lastBind->next = theBind->next; rtn_struct(theEnv,dataObject,theBind); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); } } /*******************************************/ /* GetBoundVariable: Searches the BindList */ /* for a specified variable. */ /*******************************************/ globle intBool GetBoundVariable( void *theEnv, DATA_OBJECT_PTR vPtr, SYMBOL_HN *varName) { DATA_OBJECT_PTR bindPtr; for (bindPtr = ProcedureFunctionData(theEnv)->BindList; bindPtr != NULL; bindPtr = bindPtr->next) { if (bindPtr->supplementalInfo == (void *) varName) { vPtr->type = bindPtr->type; vPtr->value = bindPtr->value; vPtr->begin = bindPtr->begin; vPtr->end = bindPtr->end; return(TRUE); } } return(FALSE); } /*************************************************/ /* FlushBindList: Removes all variables from the */ /* list of currently bound local variables. */ /*************************************************/ globle void FlushBindList( void *theEnv) { ReturnValues(theEnv,ProcedureFunctionData(theEnv)->BindList); ProcedureFunctionData(theEnv)->BindList = NULL; } /***************************************/ /* PrognFunction: H/L access routine */ /* for the progn function. */ /***************************************/ globle void PrognFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { int numa, i; numa = EnvRtnArgCount(theEnv); if (numa == 0) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } i = 1; while ((i <= numa) && (GetHaltExecution(theEnv) != TRUE)) { EnvRtnUnknown(theEnv,i,returnValue); if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)) break; i++; } if (GetHaltExecution(theEnv) == TRUE) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } return; } /*****************************************************************/ /* ReturnFunction: H/L access routine for the return function. */ /*****************************************************************/ globle void ReturnFunction( void *theEnv, DATA_OBJECT_PTR result) { if (EnvRtnArgCount(theEnv) == 0) { result->type = RVOID; result->value = EnvFalseSymbol(theEnv); } else EnvRtnUnknown(theEnv,1,result); ProcedureFunctionData(theEnv)->ReturnFlag = TRUE; } /***************************************************************/ /* BreakFunction: H/L access routine for the break function. */ /***************************************************************/ globle void BreakFunction( void *theEnv) { ProcedureFunctionData(theEnv)->BreakFlag = TRUE; } /*****************************************************************/ /* SwitchFunction: H/L access routine for the switch function. */ /*****************************************************************/ globle void SwitchFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT switch_val,case_val; EXPRESSION *theExp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); /* ========================== Get the value to switch on ========================== */ EvaluateExpression(theEnv,GetFirstArgument(),&switch_val); if (EvaluationData(theEnv)->EvaluationError) return; for (theExp = GetFirstArgument()->nextArg ; theExp != NULL ; theExp = theExp->nextArg->nextArg) { /* ================================================= RVOID is the default case (if any) for the switch ================================================= */ if (theExp->type == RVOID) { EvaluateExpression(theEnv,theExp->nextArg,result); return; } /* ==================================================== If the case matches, evaluate the actions and return ==================================================== */ EvaluateExpression(theEnv,theExp,&case_val); if (EvaluationData(theEnv)->EvaluationError) return; if (switch_val.type == case_val.type) { if ((case_val.type == MULTIFIELD) ? MultifieldDOsEqual(&switch_val,&case_val) : (switch_val.value == case_val.value)) { EvaluateExpression(theEnv,theExp->nextArg,result); return; } } } } clips-6.24/clipssrc/._factmch.h0000400000175000017500000000012207422634760014515 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/modulpsr.c0000755000175000017500000011671110441150035014543 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFMODULE PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses a defmodule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _MODULPSR_SOURCE_ #include "setup.h" #if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) #include #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "constant.h" #include "router.h" #include "extnfunc.h" #include "argacces.h" #include "cstrcpsr.h" #include "constrct.h" #include "modulutl.h" #include "utility.h" #include "envrnmnt.h" #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "modulpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ParsePortSpecifications(void *, char *,struct token *, struct defmodule *); static int ParseImportSpec(void *,char *,struct token *, struct defmodule *); static int ParseExportSpec(void *,char *,struct token *, struct defmodule *, struct defmodule *); static intBool DeleteDefmodule(void *,void *); static int FindMultiImportConflict(void *,struct defmodule *); static void NotExportedErrorMessage(void *,char *,char *,char *); /*********************************************/ /* GetNumberOfDefmodules: Returns the number */ /* of defmodules currently defined. */ /*********************************************/ globle long GetNumberOfDefmodules( void *theEnv) { return(DefmoduleData(theEnv)->NumberOfDefmodules); } /******************************************/ /* SetNumberOfDefmodules: Sets the number */ /* of defmodules currently defined. */ /******************************************/ globle void SetNumberOfDefmodules( void *theEnv, long value) { DefmoduleData(theEnv)->NumberOfDefmodules = value; } /****************************************************/ /* AddAfterModuleChangeFunction: Adds a function to */ /* the list of functions that are to be called */ /* after a module change occurs. */ /****************************************************/ globle void AddAfterModuleDefinedFunction( void *theEnv, char *name, void (*func)(void *), int priority) { DefmoduleData(theEnv)->AfterModuleDefinedFunctions = AddFunctionToCallList(theEnv,name,priority,func,DefmoduleData(theEnv)->AfterModuleDefinedFunctions,TRUE); } /******************************************************/ /* AddPortConstructItem: Adds an item to the list of */ /* items that can be imported/exported by a module. */ /******************************************************/ globle void AddPortConstructItem( void *theEnv, char *theName, int theType) { struct portConstructItem *newItem; newItem = get_struct(theEnv,portConstructItem); newItem->constructName = theName; newItem->typeExpected = theType; newItem->next = DefmoduleData(theEnv)->ListOfPortConstructItems; DefmoduleData(theEnv)->ListOfPortConstructItems = newItem; } /******************************************************/ /* ParseDefmodule: Coordinates all actions necessary */ /* for the parsing and creation of a defmodule into */ /* the current environment. */ /******************************************************/ 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); } /*************************************************************/ /* DeleteDefmodule: Used by the parsing routine to determine */ /* if a module can be redefined. Only the MAIN module can */ /* be redefined (and it can only be redefined once). */ /*************************************************************/ static intBool DeleteDefmodule( void *theEnv, void *theConstruct) { if (strcmp(EnvGetDefmoduleName(theEnv,theConstruct),"MAIN") == 0) { return(DefmoduleData(theEnv)->MainModuleRedefinable); } return(FALSE); } /*********************************************************/ /* ParsePortSpecifications: Parses the import and export */ /* specifications found in a defmodule construct. */ /*********************************************************/ static int ParsePortSpecifications( void *theEnv, char *readSource, struct token *theToken, struct defmodule *theDefmodule) { int error; /*=============================*/ /* The import and export lists */ /* are initially empty. */ /*=============================*/ theDefmodule->importList = NULL; theDefmodule->exportList = NULL; /*==========================================*/ /* Parse import/export specifications until */ /* a right parenthesis is encountered. */ /*==========================================*/ while (theToken->type != RPAREN) { /*========================================*/ /* Look for the opening left parenthesis. */ /*========================================*/ if (theToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } /*====================================*/ /* Look for the import/export keyword */ /* and call the appropriate functions */ /* for parsing the specification. */ /*====================================*/ GetToken(theEnv,readSource,theToken); if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } if (strcmp(ValueToString(theToken->value),"import") == 0) { error = ParseImportSpec(theEnv,readSource,theToken,theDefmodule); } else if (strcmp(ValueToString(theToken->value),"export") == 0) { error = ParseExportSpec(theEnv,readSource,theToken,theDefmodule,NULL); } else { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } if (error) return(TRUE); /*============================================*/ /* Begin parsing the next port specification. */ /*============================================*/ PPCRAndIndent(theEnv); GetToken(theEnv,readSource,theToken); if (theToken->type == RPAREN) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } } /*===================================*/ /* Return FALSE to indicate no error */ /* occurred while parsing the */ /* import/export specifications. */ /*===================================*/ return(FALSE); } /**********************************************************/ /* ParseImportSpec: Parses import specifications found in */ /* a defmodule construct. */ /* */ /* ::= (import ) */ /* */ /* ::= ?ALL | */ /* ?NONE | */ /* ?ALL | */ /* ?NONE | */ /* * */ /**********************************************************/ static int ParseImportSpec( void *theEnv, char *readSource, struct token *theToken, struct defmodule *newModule) { struct defmodule *theModule; struct portItem *thePort, *oldImportSpec; int found, count; /*===========================*/ /* Look for the module name. */ /*===========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"defmodule import specification"); return(TRUE); } /*=====================================*/ /* Verify the existence of the module. */ /*=====================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value)); return(TRUE); } /*========================================*/ /* If the specified module doesn't export */ /* any constructs, then the import */ /* specification is meaningless. */ /*========================================*/ if (theModule->exportList == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL); return(TRUE); } /*==============================================*/ /* Parse the remaining portion of the import */ /* specification and return if an error occurs. */ /*==============================================*/ oldImportSpec = newModule->importList; if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE); /*========================================================*/ /* If the ?NONE keyword was used with the import spec, */ /* then no constructs were actually imported and the */ /* import spec does not need to be checked for conflicts. */ /*========================================================*/ if (newModule->importList == oldImportSpec) return(FALSE); /*======================================================*/ /* Check to see if the construct being imported can be */ /* by the specified module. This check exported doesn't */ /* guarantee that a specific named construct actually */ /* exists. It just checks that it could be exported if */ /* it does exists. */ /*======================================================*/ if (newModule->importList->constructType != NULL) { /*=============================*/ /* Look for the construct in */ /* the module that exports it. */ /*=============================*/ found = FALSE; for (thePort = theModule->exportList; (thePort != NULL) && (! found); thePort = thePort->next) { if (thePort->constructType == NULL) found = TRUE; else if (thePort->constructType == newModule->importList->constructType) { if (newModule->importList->constructName == NULL) found = TRUE; else if (thePort->constructName == NULL) found = TRUE; else if (thePort->constructName == newModule->importList->constructName) { found = TRUE; } } } /*=======================================*/ /* If it's not exported by the specified */ /* module, print an error message. */ /*=======================================*/ if (! found) { if (newModule->importList->constructName == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(newModule->importList->constructType), NULL); } else { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(newModule->importList->constructType), ValueToString(newModule->importList->constructName)); } return(TRUE); } } /*======================================================*/ /* Verify that specific named constructs actually exist */ /* and can be seen from the module importing them. */ /*======================================================*/ SaveCurrentModule(theEnv); EnvSetCurrentModule(theEnv,(void *) newModule); for (thePort = newModule->importList; thePort != NULL; thePort = thePort->next) { if ((thePort->constructType == NULL) || (thePort->constructName == NULL)) { continue; } theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName)); EnvSetCurrentModule(theEnv,theModule); if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL, ValueToString(thePort->constructName),&count, TRUE,FALSE) == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(thePort->constructType), ValueToString(thePort->constructName)); RestoreCurrentModule(theEnv); return(TRUE); } } RestoreCurrentModule(theEnv); /*===============================================*/ /* The import list has been successfully parsed. */ /*===============================================*/ return(FALSE); } /**********************************************************/ /* ParseExportSpec: Parses export specifications found in */ /* a defmodule construct. This includes parsing the */ /* remaining specification found in an import */ /* specification after the module name. */ /**********************************************************/ 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); } /*************************************************************/ /* ValidPortConstructItem: Returns TRUE if a given construct */ /* name is in the list of constructs which can be exported */ /* and imported, otherwise FALSE is returned. */ /*************************************************************/ globle struct portConstructItem *ValidPortConstructItem( void *theEnv, char *theName) { struct portConstructItem *theItem; for (theItem = DefmoduleData(theEnv)->ListOfPortConstructItems; theItem != NULL; theItem = theItem->next) { if (strcmp(theName,theItem->constructName) == 0) return(theItem); } return(NULL); } /***********************************************************/ /* FindMultiImportConflict: Determines if a module imports */ /* the same named construct from more than one module */ /* (i.e. an ambiguous reference which is not allowed). */ /***********************************************************/ static int FindMultiImportConflict( void *theEnv, struct defmodule *theModule) { struct defmodule *testModule; int count; struct portConstructItem *thePCItem; struct construct *theConstruct; void *theCItem; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*============================*/ /* Loop through every module. */ /*============================*/ for (testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); testModule != NULL; testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,testModule)) { /*========================================*/ /* Loop through every construct type that */ /* can be imported/exported by a module. */ /*========================================*/ for (thePCItem = DefmoduleData(theEnv)->ListOfPortConstructItems; thePCItem != NULL; thePCItem = thePCItem->next) { EnvSetCurrentModule(theEnv,(void *) testModule); /*=====================================================*/ /* Loop through every construct of the specified type. */ /*=====================================================*/ theConstruct = FindConstruct(theEnv,thePCItem->constructName); for (theCItem = (*theConstruct->getNextItemFunction)(theEnv,NULL); theCItem != NULL; theCItem = (*theConstruct->getNextItemFunction)(theEnv,theCItem)) { /*===============================================*/ /* Check to see if the specific construct in the */ /* module can be imported with more than one */ /* reference into the module we're examining for */ /* ambiguous import specifications. */ /*===============================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); FindImportedConstruct(theEnv,thePCItem->constructName,NULL, ValueToString((*theConstruct->getConstructNameFunction) ((struct constructHeader *) theCItem)), &count,FALSE,NULL); if (count > 1) { ImportExportConflictMessage(theEnv,"defmodule",EnvGetDefmoduleName(theEnv,theModule), thePCItem->constructName, ValueToString((*theConstruct->getConstructNameFunction) ((struct constructHeader *) theCItem))); RestoreCurrentModule(theEnv); return(TRUE); } EnvSetCurrentModule(theEnv,(void *) testModule); } } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*=======================================*/ /* Return FALSE to indicate no ambiguous */ /* references were found. */ /*=======================================*/ return(FALSE); } /******************************************************/ /* NotExportedErrorMessage: Generalized error message */ /* for indicating that a construct type or specific */ /* named construct is not exported. */ /******************************************************/ static void NotExportedErrorMessage( void *theEnv, char *theModule, char *theConstruct, char *theName) { PrintErrorID(theEnv,"MODULPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Module "); EnvPrintRouter(theEnv,WERROR,theModule); EnvPrintRouter(theEnv,WERROR," does not export "); if (theConstruct == NULL) EnvPrintRouter(theEnv,WERROR,"any constructs"); else if (theName == NULL) { EnvPrintRouter(theEnv,WERROR,"any "); EnvPrintRouter(theEnv,WERROR,theConstruct); EnvPrintRouter(theEnv,WERROR," constructs"); } else { EnvPrintRouter(theEnv,WERROR,"the "); EnvPrintRouter(theEnv,WERROR,theConstruct); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,theName); } EnvPrintRouter(theEnv,WERROR,".\n"); } /*************************************************************/ /* FindImportExportConflict: Determines if the definition of */ /* a construct would cause an import/export conflict. The */ /* construct is not yet defined when this function is */ /* called. TRUE is returned if an import/export conflicts */ /* is found, otherwise FALSE is returned. */ /*************************************************************/ globle int FindImportExportConflict( void *theEnv, char *constructName, struct defmodule *matchModule, char *findName) { struct defmodule *theModule; struct moduleItem *theModuleItem; int count; /*===========================================================*/ /* If the construct type can't be imported or exported, then */ /* it's not possible to have an import/export conflict. */ /*===========================================================*/ if (ValidPortConstructItem(theEnv,constructName) == NULL) return(FALSE); /*============================================*/ /* There module name should already have been */ /* separated fromthe construct's name. */ /*============================================*/ if (FindModuleSeparator(findName)) return(FALSE); /*===============================================================*/ /* The construct must be capable of being stored within a module */ /* (this test should never fail). The construct must also have */ /* a find function associated with it so we can actually look */ /* for import/export conflicts. */ /*===============================================================*/ if ((theModuleItem = FindModuleItem(theEnv,constructName)) == NULL) return(FALSE); if (theModuleItem->findFunction == NULL) return(FALSE); /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*================================================================*/ /* Look at each module and count each definition of the specified */ /* construct which is visible to the module. If more than one */ /* definition is visible, then an import/export conflict exists */ /* and TRUE is returned. */ /*================================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); FindImportedConstruct(theEnv,constructName,NULL,findName,&count,TRUE,matchModule); if (count > 1) { RestoreCurrentModule(theEnv); return(TRUE); } } /*==========================================*/ /* Restore the current module. No conflicts */ /* were detected so FALSE is returned. */ /*==========================================*/ RestoreCurrentModule(theEnv); return(FALSE); } #endif /* DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) */ clips-6.24/clipssrc/._memalloc.c0000400000175000017500000000452210441602242014665 0ustar jfsjfsMac OS X  2 R TEXTR*chn memalloc.crol PanelTCmr.txt.docTEXTR*ch p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco1313:99nL,tnGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/retract.h0000755000175000017500000000470210441162535014353 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* RETRACT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Handles join network activity associated with */ /* with the removal of a data entity such as a fact or */ /* instance. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /*************************************************************/ #ifndef _H_retract #define _H_retract #ifndef _H_match #include "match.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RETRACT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct rdriveinfo { struct partialMatch *link; struct joinNode *jlist; struct rdriveinfo *next; }; LOCALE void NetworkRetract(void *,struct patternMatch *); LOCALE void PosEntryRetract(void *,struct joinNode *,struct alphaMatch *,struct partialMatch *,int,void *); LOCALE void ReturnPartialMatch(void *,struct partialMatch *); LOCALE void DestroyPartialMatch(void *,struct partialMatch *); LOCALE void FlushGarbagePartialMatches(void *); LOCALE void NegEntryRetract(void *,struct joinNode *,struct partialMatch *,void *); LOCALE void RetractCheckDriveRetractions(void *,struct alphaMatch *,int); #endif clips-6.24/clipssrc/prntutil.h0000755000175000017500000001007210441602274014564 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* PRINT UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Utility routines for printing various items */ /* and messages. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Link error occurs for the SlotExistError */ /* function when OBJECT_SYSTEM is set to 0 in */ /* setup.h. DR0865 */ /* */ /* Added DataObjectToString function. */ /* */ /* Added SlotExistError function. */ /* */ /*************************************************************/ #ifndef _H_prntutil #define _H_prntutil #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define PRINT_UTILITY_DATA 53 struct printUtilityData { intBool PreserveEscapedCharacters; intBool AddressesToStrings; intBool InstanceAddressesToNames; }; #define PrintUtilityData(theEnv) ((struct printUtilityData *) GetEnvironmentData(theEnv,PRINT_UTILITY_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _PRNTUTIL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializePrintUtilityData(void *); LOCALE void PrintInChunks(void *,char *,char *); LOCALE void PrintFloat(void *,char *,double); LOCALE void PrintLongInteger(void *,char *,long); LOCALE void PrintAtom(void *,char *,int,void *); LOCALE void PrintTally(void *,char *,long,char *,char *); LOCALE char *FloatToString(void *,double); LOCALE char *LongIntegerToString(void *,long); LOCALE char *DataObjectToString(void *,DATA_OBJECT *); LOCALE void SyntaxErrorMessage(void *,char *); LOCALE void SystemError(void *,char *,int); LOCALE void PrintErrorID(void *,char *,int,int); LOCALE void PrintWarningID(void *,char *,int,int); LOCALE void CantFindItemErrorMessage(void *,char *,char *); LOCALE void CantDeleteItemErrorMessage(void *,char *,char *); LOCALE void AlreadyParsedErrorMessage(void *,char *,char *); LOCALE void LocalVariableErrorMessage(void *,char *); LOCALE void DivideByZeroErrorMessage(void *,char *); LOCALE void SalienceInformationError(void *,char *,char *); LOCALE void SalienceRangeError(void *,int,int); LOCALE void SalienceNonIntegerError(void *); LOCALE void CantFindItemInFunctionErrorMessage(void *,char *,char *,char *); LOCALE void SlotExistError(void *,char *,char *); #endif clips-6.24/clipssrc/genrcbin.c0000755000175000017500000010505610177533441014501 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions for Generic Functions */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "bload.h" #include "bsave.h" #include "cstrcbin.h" #if OBJECT_SYSTEM #include "objbin.h" #endif #include "genrccom.h" #include "modulbin.h" #define _GENRCBIN_SOURCE_ #include "genrcbin.h" #include "router.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define MethodPointer(i) (((i) == -1L) ? NULL : (DEFMETHOD *) &DefgenericBinaryData(theEnv)->MethodArray[i]) #define RestrictionPointer(i) (((i) == -1L) ? NULL : (RESTRICTION *) &DefgenericBinaryData(theEnv)->RestrictionArray[i]) #define TypePointer(i) (((i) == -1L) ? NULL : (void **) &DefgenericBinaryData(theEnv)->TypeArray[i]) typedef struct bsaveRestriction { long types,query; unsigned tcnt; } BSAVE_RESTRICTION; typedef struct bsaveMethod { unsigned index; int restrictionCount, minRestrictions,maxRestrictions, localVarCount; int system; long restrictions,actions; } BSAVE_METHOD; typedef struct bsaveGenericFunc { struct bsaveConstructHeader header; long methods; unsigned mcnt; } BSAVE_GENERIC; typedef struct bsaveGenericModule { struct bsaveDefmoduleItemHeader header; } BSAVE_DEFGENERIC_MODULE; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveGenericsFind(void *); static void MarkDefgenericItems(void *,struct constructHeader *,void *); static void BsaveGenericsExpressions(void *,FILE *); static void BsaveMethodExpressions(void *,struct constructHeader *,void *); static void BsaveRestrictionExpressions(void *,struct constructHeader *,void *); static void BsaveGenerics(void *,FILE *); static void BsaveDefgenericHeader(void *,struct constructHeader *,void *); static void BsaveMethods(void *,struct constructHeader *,void *); static void BsaveMethodRestrictions(void *,struct constructHeader *,void *); static void BsaveRestrictionTypes(void *,struct constructHeader *,void *); static void BsaveStorageGenerics(void *,FILE *); #endif static void BloadStorageGenerics(void *); static void BloadGenerics(void *); static void UpdateGenericModule(void *,void *,long); static void UpdateGeneric(void *,void *,long); static void UpdateMethod(void *,void *,long); static void UpdateRestriction(void *,void *,long); static void UpdateType(void *,void *,long); static void ClearBloadGenerics(void *); static void DeallocateDefgenericBinaryData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupGenericsBload DESCRIPTION : Initializes data structures and routines for binary loads of generic function constructs INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupGenericsBload( void *theEnv) { AllocateEnvironmentData(theEnv,GENRCBIN_DATA,sizeof(struct defgenericBinaryData),DeallocateDefgenericBinaryData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"generic functions",0,BsaveGenericsFind,BsaveGenericsExpressions, BsaveStorageGenerics,BsaveGenerics, BloadStorageGenerics,BloadGenerics, ClearBloadGenerics); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"generic functions",0,NULL,NULL,NULL,NULL, BloadStorageGenerics,BloadGenerics, ClearBloadGenerics); #endif } /***********************************************************/ /* DeallocateDefgenericBinaryData: Deallocates environment */ /* data for the defgeneric binary functionality. */ /***********************************************************/ static void DeallocateDefgenericBinaryData( void *theEnv) { #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) unsigned long space; space = DefgenericBinaryData(theEnv)->GenericCount * sizeof(struct defgeneric); if (space != 0) genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->DefgenericArray,space); space = DefgenericBinaryData(theEnv)->MethodCount * sizeof(struct method); if (space != 0) genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->MethodArray,space); space = DefgenericBinaryData(theEnv)->RestrictionCount * sizeof(struct restriction); if (space != 0) genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->RestrictionArray,space); space = DefgenericBinaryData(theEnv)->TypeCount * sizeof(void *); if (space != 0) genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->TypeArray,space); space = DefgenericBinaryData(theEnv)->ModuleCount * sizeof(struct defgenericModule); if (space != 0) genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->ModuleArray,space); #endif } /*************************************************** NAME : BloadDefgenericModuleReference DESCRIPTION : Returns a pointer to the appropriate defgeneric module INPUTS : The index of the module RETURNS : A pointer to the module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *BloadDefgenericModuleReference( void *theEnv, int theIndex) { return ((void *) &DefgenericBinaryData(theEnv)->ModuleArray[theIndex]); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************************************** NAME : BsaveGenericsFind DESCRIPTION : For all generic functions and their methods, this routine marks all the needed symbols and system functions. Also, it also counts the number of expression structures needed. Also, counts total number of generics, methods, restrictions and types. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented for every expression needed Symbols and system function are marked in their structures NOTES : Also sets bsaveIndex for each generic function (assumes generic functions will be bsaved in order of binary list) ***************************************************************************/ static void BsaveGenericsFind( void *theEnv) { SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->ModuleCount); SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->GenericCount); SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->MethodCount); SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->RestrictionCount); SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->TypeCount); DefgenericBinaryData(theEnv)->GenericCount = 0L; DefgenericBinaryData(theEnv)->MethodCount = 0L; DefgenericBinaryData(theEnv)->RestrictionCount = 0L; DefgenericBinaryData(theEnv)->TypeCount = 0L; DefgenericBinaryData(theEnv)->ModuleCount = DoForAllConstructs(theEnv,MarkDefgenericItems,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,NULL); } /*************************************************** NAME : MarkDefgenericItems DESCRIPTION : Marks the needed items for a defgeneric (and methods) bsave INPUTS : 1) The defgeneric 2) User data buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Needed items marked NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void MarkDefgenericItems( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(userBuffer) #endif DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; register unsigned i,j; DEFMETHOD *meth; RESTRICTION *rptr; MarkConstructHeaderNeededItems(&gfunc->header,DefgenericBinaryData(theEnv)->GenericCount++); DefgenericBinaryData(theEnv)->MethodCount += (long) gfunc->mcnt; for (i = 0 ; i < gfunc->mcnt ; i++) { meth = &gfunc->methods[i]; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(meth->actions); MarkNeededItems(theEnv,meth->actions); DefgenericBinaryData(theEnv)->RestrictionCount += meth->restrictionCount; for (j = 0 ; j < (unsigned) meth->restrictionCount ; j++) { rptr = &meth->restrictions[j]; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(rptr->query); MarkNeededItems(theEnv,rptr->query); DefgenericBinaryData(theEnv)->TypeCount += (long) rptr->tcnt; } } } /*************************************************** NAME : BsaveGenericsExpressions DESCRIPTION : Writes out all expressions needed by generic functions INPUTS : The file pointer of the binary file RETURNS : Nothing useful SIDE EFFECTS : File updated NOTES : None ***************************************************/ static void BsaveGenericsExpressions( void *theEnv, FILE *fp) { /* ================================================================ Important to save all expressions for methods before any expressions for restrictions, since methods will be stored first ================================================================ */ DoForAllConstructs(theEnv,BsaveMethodExpressions,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); DoForAllConstructs(theEnv,BsaveRestrictionExpressions,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); } /*************************************************** NAME : BsaveMethodExpressions DESCRIPTION : Saves the needed expressions for a defgeneric methods bsave INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Method action expressions saved NOTES : None ***************************************************/ static void BsaveMethodExpressions( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; register unsigned i; for (i = 0 ; i < gfunc->mcnt ; i++) BsaveExpression(theEnv,gfunc->methods[i].actions,(FILE *) userBuffer); } /*************************************************** NAME : BsaveRestrictionExpressions DESCRIPTION : Saves the needed expressions for a defgeneric method restriction queries bsave INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Method restriction query expressions saved NOTES : None ***************************************************/ static void BsaveRestrictionExpressions( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; register unsigned i,j; DEFMETHOD *meth; for (i = 0 ; i < gfunc->mcnt ; i++) { meth = &gfunc->methods[i]; for (j = 0 ; j < (unsigned) meth->restrictionCount ; j++) BsaveExpression(theEnv,meth->restrictions[j].query,(FILE *) userBuffer); } } /*********************************************************** NAME : BsaveStorageGenerics DESCRIPTION : Writes out number of each type of structure required for generics Space required for counts (unsigned long) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None ***********************************************************/ static void BsaveStorageGenerics( void *theEnv, FILE *fp) { unsigned long space; space = sizeof(long) * 5; GenWrite((void *) &space,(unsigned long) sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->ModuleCount,(unsigned long) sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->GenericCount,(unsigned long) sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->MethodCount,(unsigned long) sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->RestrictionCount,(unsigned long) sizeof(long),fp); GenWrite((void *) &DefgenericBinaryData(theEnv)->TypeCount,(unsigned long) sizeof(long),fp); } /**************************************************************************************** NAME : BsaveGenerics DESCRIPTION : Writes out generic function in binary format Space required (unsigned long) All generic modules (sizeof(DEFGENERIC_MODULE) * Number of generic modules) All generic headers (sizeof(DEFGENERIC) * Number of generics) All methods (sizeof(DEFMETHOD) * Number of methods) All method restrictions (sizeof(RESTRICTION) * Number of restrictions) All restriction type arrays (sizeof(void *) * # of types) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None ****************************************************************************************/ static void BsaveGenerics( void *theEnv, FILE *fp) { struct defmodule *theModule; DEFGENERIC_MODULE *theModuleItem; unsigned long space; BSAVE_DEFGENERIC_MODULE dummy_generic_module; /* ===================================================================== Space is: Sum over all structures(sizeof(structure) * structure-cnt)) ===================================================================== */ space = ((unsigned long) DefgenericBinaryData(theEnv)->ModuleCount * (unsigned long) sizeof(BSAVE_DEFGENERIC_MODULE)) + ((unsigned long) DefgenericBinaryData(theEnv)->GenericCount * (unsigned long) sizeof(BSAVE_GENERIC)) + ((unsigned long) DefgenericBinaryData(theEnv)->MethodCount * (unsigned long) sizeof(BSAVE_METHOD)) + ((unsigned long) DefgenericBinaryData(theEnv)->RestrictionCount * (unsigned long) sizeof(BSAVE_RESTRICTION)) + ((unsigned long) DefgenericBinaryData(theEnv)->TypeCount * (unsigned long) sizeof(unsigned long)); /* ================================================================ Write out the total amount of space required: modules,headers, methods, restrictions, types ================================================================ */ GenWrite((void *) &space,(unsigned long) sizeof(unsigned long),fp); /* ====================================== Write out the generic function modules ====================================== */ DefgenericBinaryData(theEnv)->GenericCount = 0L; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { theModuleItem = (DEFGENERIC_MODULE *) GetModuleItem(theEnv,theModule,FindModuleItem(theEnv,"defgeneric")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&dummy_generic_module.header, &theModuleItem->header); GenWrite((void *) &dummy_generic_module, (unsigned long) sizeof(BSAVE_DEFGENERIC_MODULE),fp); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } /* ====================================== Write out the generic function headers ====================================== */ DefgenericBinaryData(theEnv)->MethodCount = 0L; DoForAllConstructs(theEnv,BsaveDefgenericHeader,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); /* ===================== Write out the methods ===================== */ DefgenericBinaryData(theEnv)->RestrictionCount = 0L; DoForAllConstructs(theEnv,BsaveMethods,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); /* ================================= Write out the method restrictions ================================= */ DefgenericBinaryData(theEnv)->TypeCount = 0L; DoForAllConstructs(theEnv,BsaveMethodRestrictions,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); /* ============================================================= Finally, write out the type lists for the method restrictions ============================================================= */ DoForAllConstructs(theEnv,BsaveRestrictionTypes,DefgenericData(theEnv)->DefgenericModuleIndex, FALSE,(void *) fp); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->ModuleCount); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->GenericCount); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->MethodCount); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->RestrictionCount); RestoreBloadCount(theEnv,&DefgenericBinaryData(theEnv)->TypeCount); } /*************************************************** NAME : BsaveDefgenericHeader DESCRIPTION : Bsaves a generic function header INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Defgeneric header saved NOTES : None ***************************************************/ static void BsaveDefgenericHeader( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; BSAVE_GENERIC dummy_generic; AssignBsaveConstructHeaderVals(&dummy_generic.header,&gfunc->header); dummy_generic.mcnt = gfunc->mcnt; if (gfunc->methods != NULL) { dummy_generic.methods = DefgenericBinaryData(theEnv)->MethodCount; DefgenericBinaryData(theEnv)->MethodCount += (long) gfunc->mcnt; } else dummy_generic.methods = -1L; GenWrite((void *) &dummy_generic,(unsigned long) sizeof(BSAVE_GENERIC),(FILE *) userBuffer); } /*************************************************** NAME : BsaveMethods DESCRIPTION : Bsaves defgeneric methods INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Defgeneric methods saved NOTES : None ***************************************************/ static void BsaveMethods( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; DEFMETHOD *meth; BSAVE_METHOD dummy_method; register unsigned i; for (i = 0 ; i < gfunc->mcnt ; i++) { meth = &gfunc->methods[i]; dummy_method.index = meth->index; dummy_method.restrictionCount = meth->restrictionCount; dummy_method.minRestrictions = meth->minRestrictions; dummy_method.maxRestrictions = meth->maxRestrictions; dummy_method.localVarCount = meth->localVarCount; dummy_method.system = meth->system; if (meth->restrictions != NULL) { dummy_method.restrictions = DefgenericBinaryData(theEnv)->RestrictionCount; DefgenericBinaryData(theEnv)->RestrictionCount += meth->restrictionCount; } else dummy_method.restrictions = -1L; if (meth->actions != NULL) { dummy_method.actions = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(meth->actions); } else dummy_method.actions = -1L; GenWrite((void *) &dummy_method,(unsigned long) sizeof(BSAVE_METHOD),(FILE *) userBuffer); } } /****************************************************** NAME : BsaveMethodRestrictions DESCRIPTION : Bsaves defgeneric methods' retrictions INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Defgeneric methods' restrictions saved NOTES : None ******************************************************/ static void BsaveMethodRestrictions( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; BSAVE_RESTRICTION dummy_restriction; RESTRICTION *rptr; register unsigned i,j; for (i = 0 ; i < gfunc->mcnt ; i++) { for (j = 0 ; j < (unsigned) gfunc->methods[i].restrictionCount ; j++) { rptr = &gfunc->methods[i].restrictions[j]; dummy_restriction.tcnt = rptr->tcnt; if (rptr->types != NULL) { dummy_restriction.types = DefgenericBinaryData(theEnv)->TypeCount; DefgenericBinaryData(theEnv)->TypeCount += (long) rptr->tcnt; } else dummy_restriction.types = -1L; if (rptr->query != NULL) { dummy_restriction.query = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(rptr->query); } else dummy_restriction.query = -1L; GenWrite((void *) &dummy_restriction, (unsigned long) sizeof(BSAVE_RESTRICTION),(FILE *) userBuffer); } } } /************************************************************* NAME : BsaveRestrictionTypes DESCRIPTION : Bsaves defgeneric methods' retrictions' types INPUTS : 1) The defgeneric 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Defgeneric methods' restrictions' types saved NOTES : None *************************************************************/ #if IBM_TBC #pragma argsused #endif static void BsaveRestrictionTypes( void *theEnv, struct constructHeader *theDefgeneric, void *userBuffer) { DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric; long dummy_type; RESTRICTION *rptr; register unsigned i,j,k; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif for (i = 0 ; i < gfunc->mcnt ; i++) { for (j = 0 ; j < (unsigned) gfunc->methods[i].restrictionCount ; j++) { rptr = &gfunc->methods[i].restrictions[j]; for (k = 0 ; k < rptr->tcnt ; k++) { #if OBJECT_SYSTEM dummy_type = DefclassIndex(rptr->types[k]); #else dummy_type = (long) ((INTEGER_HN *) rptr->types[k])->contents; #endif GenWrite(&dummy_type,(unsigned long) sizeof(long),(FILE *) userBuffer); } } } } #endif /*********************************************************************** NAME : BloadStorageGenerics DESCRIPTION : This routine space required for generic function structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageGenerics( void *theEnv) { unsigned long space; long counts[5]; GenReadBinary(theEnv,(void *) &space,(unsigned long) sizeof(unsigned long)); if (space == 0L) return; GenReadBinary(theEnv,(void *) counts,space); DefgenericBinaryData(theEnv)->ModuleCount = counts[0]; DefgenericBinaryData(theEnv)->GenericCount = counts[1]; DefgenericBinaryData(theEnv)->MethodCount = counts[2]; DefgenericBinaryData(theEnv)->RestrictionCount = counts[3]; DefgenericBinaryData(theEnv)->TypeCount = counts[4]; if (DefgenericBinaryData(theEnv)->ModuleCount != 0L) { space = (unsigned long) (sizeof(DEFGENERIC_MODULE) * DefgenericBinaryData(theEnv)->ModuleCount); DefgenericBinaryData(theEnv)->ModuleArray = (DEFGENERIC_MODULE *) genlongalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->GenericCount != 0L) { space = (unsigned long) (sizeof(DEFGENERIC) * DefgenericBinaryData(theEnv)->GenericCount); DefgenericBinaryData(theEnv)->DefgenericArray = (DEFGENERIC *) genlongalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->MethodCount != 0L) { space = (unsigned long) (sizeof(DEFMETHOD) * DefgenericBinaryData(theEnv)->MethodCount); DefgenericBinaryData(theEnv)->MethodArray = (DEFMETHOD *) genlongalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->RestrictionCount != 0L) { space = (unsigned long) (sizeof(RESTRICTION) * DefgenericBinaryData(theEnv)->RestrictionCount); DefgenericBinaryData(theEnv)->RestrictionArray = (RESTRICTION *) genlongalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->TypeCount != 0L) { space = (unsigned long) (sizeof(void *) * DefgenericBinaryData(theEnv)->TypeCount); DefgenericBinaryData(theEnv)->TypeArray = (void * *) genlongalloc(theEnv,space); } } /********************************************************************* NAME : BloadGenerics DESCRIPTION : This routine reads generic function information from a binary file in four chunks: Generic-header array Method array Method restrictions array Restriction types array This routine moves through the generic function binary arrays updating pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pointers reset from array indices NOTES : Assumes all loading is finished ********************************************************************/ static void BloadGenerics( void *theEnv) { unsigned long space; GenReadBinary(theEnv,(void *) &space,(unsigned long) sizeof(unsigned long)); if (DefgenericBinaryData(theEnv)->ModuleCount == 0L) return; BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->ModuleCount,(unsigned) sizeof(BSAVE_DEFGENERIC_MODULE),UpdateGenericModule); if (DefgenericBinaryData(theEnv)->GenericCount == 0L) return; BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->GenericCount,(unsigned) sizeof(BSAVE_GENERIC),UpdateGeneric); BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->MethodCount,(unsigned) sizeof(BSAVE_METHOD),UpdateMethod); BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->RestrictionCount,(unsigned) sizeof(BSAVE_RESTRICTION),UpdateRestriction); BloadandRefresh(theEnv,DefgenericBinaryData(theEnv)->TypeCount,(unsigned) sizeof(long),UpdateType); } /********************************************* Bload update routines for generic structures *********************************************/ static void UpdateGenericModule( void *theEnv, void *buf, long obji) { BSAVE_DEFGENERIC_MODULE *bdptr; bdptr = (BSAVE_DEFGENERIC_MODULE *) buf; UpdateDefmoduleItemHeader(theEnv,&bdptr->header,&DefgenericBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(DEFGENERIC),(void *) DefgenericBinaryData(theEnv)->DefgenericArray); } static void UpdateGeneric( void *theEnv, void *buf, long obji) { BSAVE_GENERIC *bgp; DEFGENERIC *gp; bgp = (BSAVE_GENERIC *) buf; gp = (DEFGENERIC *) &DefgenericBinaryData(theEnv)->DefgenericArray[obji]; UpdateConstructHeader(theEnv,&bgp->header,&gp->header, (int) sizeof(DEFGENERIC_MODULE),(void *) DefgenericBinaryData(theEnv)->ModuleArray, (int) sizeof(DEFGENERIC),(void *) DefgenericBinaryData(theEnv)->DefgenericArray); DefgenericBinaryData(theEnv)->DefgenericArray[obji].busy = 0; #if DEBUGGING_FUNCTIONS DefgenericBinaryData(theEnv)->DefgenericArray[obji].trace = DefgenericData(theEnv)->WatchGenerics; #endif DefgenericBinaryData(theEnv)->DefgenericArray[obji].methods = MethodPointer(bgp->methods); DefgenericBinaryData(theEnv)->DefgenericArray[obji].mcnt = bgp->mcnt; DefgenericBinaryData(theEnv)->DefgenericArray[obji].new_index = 0; } static void UpdateMethod( void *theEnv, void *buf, long obji) { BSAVE_METHOD *bmth; bmth = (BSAVE_METHOD *) buf; DefgenericBinaryData(theEnv)->MethodArray[obji].index = bmth->index; DefgenericBinaryData(theEnv)->MethodArray[obji].busy = 0; #if DEBUGGING_FUNCTIONS DefgenericBinaryData(theEnv)->MethodArray[obji].trace = DefgenericData(theEnv)->WatchMethods; #endif DefgenericBinaryData(theEnv)->MethodArray[obji].restrictionCount = bmth->restrictionCount; DefgenericBinaryData(theEnv)->MethodArray[obji].minRestrictions = bmth->minRestrictions; DefgenericBinaryData(theEnv)->MethodArray[obji].maxRestrictions = bmth->maxRestrictions; DefgenericBinaryData(theEnv)->MethodArray[obji].localVarCount = bmth->localVarCount; DefgenericBinaryData(theEnv)->MethodArray[obji].system = bmth->system; DefgenericBinaryData(theEnv)->MethodArray[obji].restrictions = RestrictionPointer(bmth->restrictions); DefgenericBinaryData(theEnv)->MethodArray[obji].actions = ExpressionPointer(bmth->actions); DefgenericBinaryData(theEnv)->MethodArray[obji].ppForm = NULL; DefgenericBinaryData(theEnv)->MethodArray[obji].usrData = NULL; } static void UpdateRestriction( void *theEnv, void *buf, long obji) { BSAVE_RESTRICTION *brp; brp = (BSAVE_RESTRICTION *) buf; DefgenericBinaryData(theEnv)->RestrictionArray[obji].tcnt = brp->tcnt; DefgenericBinaryData(theEnv)->RestrictionArray[obji].types = TypePointer(brp->types); DefgenericBinaryData(theEnv)->RestrictionArray[obji].query = ExpressionPointer(brp->query); } static void UpdateType( void *theEnv, void *buf, long obji) { #if OBJECT_SYSTEM DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) DefclassPointer(* (long *) buf); #else if ((* (long *) buf) > (long) INSTANCE_TYPE_CODE) { PrintWarningID(theEnv,"GENRCBIN",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"COOL not installed! User-defined class\n"); EnvPrintRouter(theEnv,WWARNING," in method restriction substituted with OBJECT.\n"); DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) EnvAddLong(theEnv,(long) OBJECT_TYPE_CODE); } else DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) EnvAddLong(theEnv,* (long *) buf); IncrementIntegerCount((INTEGER_HN *) DefgenericBinaryData(theEnv)->TypeArray[obji]); #endif } /*************************************************************** NAME : ClearBloadGenerics DESCRIPTION : Release all binary-loaded generic function structure arrays Resets generic function list to NULL INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : Generic function name symbol counts decremented ***************************************************************/ static void ClearBloadGenerics( void *theEnv) { register long i; unsigned long space; space = (unsigned long) (sizeof(DEFGENERIC_MODULE) * DefgenericBinaryData(theEnv)->ModuleCount); if (space == 0L) return; genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->ModuleArray,space); DefgenericBinaryData(theEnv)->ModuleArray = NULL; DefgenericBinaryData(theEnv)->ModuleCount = 0L; for (i = 0 ; i < DefgenericBinaryData(theEnv)->GenericCount ; i++) UnmarkConstructHeader(theEnv,&DefgenericBinaryData(theEnv)->DefgenericArray[i].header); space = (unsigned long) (sizeof(DEFGENERIC) * DefgenericBinaryData(theEnv)->GenericCount); if (space == 0L) return; genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->DefgenericArray,space); DefgenericBinaryData(theEnv)->DefgenericArray = NULL; DefgenericBinaryData(theEnv)->GenericCount = 0L; space = (unsigned long) (sizeof(DEFMETHOD) * DefgenericBinaryData(theEnv)->MethodCount); if (space == 0L) return; genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->MethodArray,space); DefgenericBinaryData(theEnv)->MethodArray = NULL; DefgenericBinaryData(theEnv)->MethodCount = 0L; space = (unsigned long) (sizeof(RESTRICTION) * DefgenericBinaryData(theEnv)->RestrictionCount); if (space == 0L) return; genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->RestrictionArray,space); DefgenericBinaryData(theEnv)->RestrictionArray = NULL; DefgenericBinaryData(theEnv)->RestrictionCount = 0L; #if ! OBJECT_SYSTEM for (i = 0 ; i < DefgenericBinaryData(theEnv)->TypeCount ; i++) DecrementIntegerCount(theEnv,(INTEGER_HN *) DefgenericBinaryData(theEnv)->TypeArray[i]); #endif space = (unsigned long) (sizeof(void *) * DefgenericBinaryData(theEnv)->TypeCount); if (space == 0L) return; genlongfree(theEnv,(void *) DefgenericBinaryData(theEnv)->TypeArray,space); DefgenericBinaryData(theEnv)->TypeArray = NULL; DefgenericBinaryData(theEnv)->TypeCount = 0L; } #endif clips-6.24/clipssrc/reorder.c0000755000175000017500000015607307673515535014374 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* REORDER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines necessary for converting the */ /* the LHS of a rule into an appropriate form suitable for */ /* the KB Rete topology. This includes transforming the */ /* LHS so there is at most one "or" CE (and this is the */ /* first CE of the LHS if it is used), adding initial */ /* patterns to the LHS (if no LHS is specified or a "test" */ /* or "not" CE is the first pattern within an "and" CE), */ /* removing redundant CEs, and determining appropriate */ /* information on nesting for implementing joins from the */ /* right. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _REORDER_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "cstrnutl.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "pattern.h" #include "prntutil.h" #include "router.h" #include "rulelhs.h" #include "reorder.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct lhsParseNode *ReverseAndOr(void *,struct lhsParseNode *,struct lhsParseNode *,int); static struct lhsParseNode *PerformReorder1(void *,struct lhsParseNode *,int *); static struct lhsParseNode *PerformReorder2(void *,struct lhsParseNode *,int *); static struct lhsParseNode *CompressCEs(void *,struct lhsParseNode *,int *); static void IncrementNandDepth(void *,struct lhsParseNode *,int); static struct lhsParseNode *CreateInitialPattern(void *,struct patternParser *); static struct lhsParseNode *ReorderDriver(void *,struct lhsParseNode *,int *,int); static void AddRemainingInitialPatterns(void *,struct lhsParseNode *,struct patternParser *); static void PrintNodes(void *,char *,struct lhsParseNode *); static struct lhsParseNode *AssignPatternIndices(struct lhsParseNode *,short); static void PropagateIndexSlotPatternValues(struct lhsParseNode *, short,short, struct symbolHashNode *, short); /********************************************/ /* ReorderPatterns: Reorders a group of CEs */ /* to accommodate KB Rete topology. */ /********************************************/ globle struct lhsParseNode *ReorderPatterns( void *theEnv, struct lhsParseNode *theLHS, int *anyChange) { struct lhsParseNode *newLHS, *patternPtr, *tempLHS, *lastLHS; unsigned int whichCE; /*===========================================================*/ /* The LHS of a rule is enclosed within an implied "and" CE. */ /*===========================================================*/ newLHS = GetLHSParseNode(theEnv); newLHS->type = AND_CE; /*=============================================*/ /* If the LHS of the rule was left unspecified */ /* (e.g., (defrule x => ...)), then add an */ /* initial fact or instance pattern to the LHS */ /* of the rule. Otherwise, attach the user */ /* specified LHS to the implied "and" Ce. */ /*=============================================*/ if (theLHS == NULL) newLHS->right = CreateInitialPattern(theEnv,NULL); else newLHS->right = theLHS; /*=======================================================*/ /* Reorder the patterns to support the KB Rete topology. */ /*=======================================================*/ newLHS = ReorderDriver(theEnv,newLHS,anyChange,1); newLHS = ReorderDriver(theEnv,newLHS,anyChange,2); /*===========================================*/ /* The top level and CE may have disappeared */ /* as a result of pattern compression. */ /*===========================================*/ if (newLHS->type == OR_CE) { for (tempLHS = newLHS->right, lastLHS = NULL; tempLHS != NULL; lastLHS = tempLHS, tempLHS = tempLHS->bottom) { if (tempLHS->type != AND_CE) { theLHS = GetLHSParseNode(theEnv); theLHS->type = AND_CE; theLHS->right = tempLHS; theLHS->bottom = tempLHS->bottom; tempLHS->bottom = NULL; if (lastLHS == NULL) { newLHS->right = theLHS; } else { lastLHS->bottom = theLHS; } tempLHS = theLHS; } } } else if (newLHS->type != AND_CE) { theLHS = newLHS; newLHS = GetLHSParseNode(theEnv); newLHS->type = AND_CE; newLHS->right = theLHS; } /*=====================================================*/ /* Add initial patterns where needed (such as before a */ /* "test" CE or "not" CE which is the first CE within */ /* an "and" CE). */ /*=====================================================*/ AddInitialPatterns(theEnv,newLHS); /*===========================================================*/ /* Number the user specified patterns. Patterns added while */ /* analyzing the rule (such as placing initial-fact patterns */ /* before not CEs) are not numbered so that there is no */ /* confusion when an error message refers to a CE. Also */ /* propagate field and slot values throughout each pattern. */ /*===========================================================*/ if (newLHS->type == OR_CE) theLHS = newLHS->right; else theLHS = newLHS; for (; theLHS != NULL; theLHS = theLHS->bottom) { whichCE = 1; for (patternPtr = theLHS->right; patternPtr != NULL; patternPtr = patternPtr->bottom) { if (patternPtr->userCE) patternPtr->whichCE = whichCE++; } AssignPatternIndices(theLHS->right,1); } /*===========================*/ /* Return the processed LHS. */ /*===========================*/ return(newLHS); } /******************************************/ /* ReorderDriver: Reorders a group of CEs */ /* to accommodate KB Rete topology. */ /******************************************/ static struct lhsParseNode *ReorderDriver( void *theEnv, struct lhsParseNode *theLHS, int *anyChange, int pass) { struct lhsParseNode *argPtr; struct lhsParseNode *before, *save; int change, newChange; *anyChange = FALSE; /*===================================*/ /* Continue processing the LHS until */ /* no more changes have been made. */ /*===================================*/ change = TRUE; while (change) { /*==================================*/ /* No change yet on this iteration. */ /*==================================*/ change = FALSE; /*=======================================*/ /* Reorder the current level of the LHS. */ /*=======================================*/ if ((theLHS->type == AND_CE) || (theLHS->type == NOT_CE) || (theLHS->type == OR_CE)) { if (pass == 1) theLHS = PerformReorder1(theEnv,theLHS,&newChange); else theLHS = PerformReorder2(theEnv,theLHS,&newChange); if (newChange) { *anyChange = TRUE; change = TRUE; } theLHS = CompressCEs(theEnv,theLHS,&newChange); if (newChange) { *anyChange = TRUE; change = TRUE; } } /*=====================================================*/ /* Recursively reorder CEs at lower levels in the LHS. */ /*=====================================================*/ before = NULL; argPtr = theLHS->right; while (argPtr != NULL) { /*==================================*/ /* Remember the next CE to reorder. */ /*==================================*/ save = argPtr->bottom; /*============================================*/ /* Reorder the current CE at the lower level. */ /*============================================*/ if ((argPtr->type == AND_CE) || (argPtr->type == NOT_CE) || (argPtr->type == OR_CE)) { if (before == NULL) { argPtr->bottom = NULL; theLHS->right = ReorderDriver(theEnv,argPtr,&newChange,pass); theLHS->right->bottom = save; before = theLHS->right; } else { argPtr->bottom = NULL; before->bottom = ReorderDriver(theEnv,argPtr,&newChange,pass); before->bottom->bottom = save; before = before->bottom; } if (newChange) { *anyChange = TRUE; change = TRUE; } } else { before = argPtr; } /*====================================*/ /* Move on to the next CE to reorder. */ /*====================================*/ argPtr = save; } } /*===========================*/ /* Return the reordered LHS. */ /*===========================*/ return(theLHS); } /****************************************************************/ /* AddInitialPatterns: Add initial patterns to CEs where needed */ /* (such as before a "test" CE or "not" CE which is the first */ /* CE within an "and" CE). */ /****************************************************************/ globle void AddInitialPatterns( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *thePattern; struct patternParser *lastType; /*====================================================*/ /* If there are multiple disjuncts for the rule, then */ /* add initial patterns to each disjunct separately. */ /*====================================================*/ if (theLHS->type == OR_CE) { for (thePattern = theLHS->right; thePattern != NULL; thePattern = thePattern->bottom) { AddInitialPatterns(theEnv,thePattern); } return; } /*======================================================*/ /* Determine what the default pattern type for the rule */ /* should be (in case the rule begins with a test CE). */ /* The default pattern type is the type of the data */ /* entity associated with the first pattern CE found in */ /* the LHS of the rule. */ /*======================================================*/ for (lastType = NULL, thePattern = theLHS->right; thePattern != NULL; thePattern = thePattern->bottom) { if (thePattern->type == PATTERN_CE) { lastType = thePattern->patternType; break; } } /*===================================================*/ /* Add an initial pattern to the first CE of a rule */ /* if the CE is a "test" CE, "not" CE or a join from */ /* the right. */ /*===================================================*/ if ((theLHS->right->negated) || (theLHS->right->type == TEST_CE) || (theLHS->right->beginNandDepth > 1)) { thePattern = CreateInitialPattern(theEnv,lastType); thePattern->logical = (theLHS->logical || theLHS->right->logical); thePattern->bottom = theLHS->right; theLHS->right = thePattern; } /*================================*/ /* Handle the remaining patterns. */ /*================================*/ AddRemainingInitialPatterns(theEnv,theLHS->right,lastType); } /***********************************************************/ /* PerformReorder1: Reorders a group of CEs to accommodate */ /* KB Rete topology. The first pass of this function */ /* transforms or CEs into equivalent forms. */ /***********************************************************/ static struct lhsParseNode *PerformReorder1( void *theEnv, struct lhsParseNode *theLHS, int *newChange) { struct lhsParseNode *argPtr, *lastArg, *nextArg; struct lhsParseNode *tempArg, *newNode; int count; int change; /*======================================================*/ /* Loop through the CEs as long as changes can be made. */ /*======================================================*/ change = TRUE; *newChange = FALSE; while (change) { change = FALSE; count = 1; lastArg = NULL; for (argPtr = theLHS->right; argPtr != NULL;) { /*=============================================================*/ /* Convert and/or CE combinations into or/and CE combinations. */ /*=============================================================*/ if ((theLHS->type == AND_CE) && (argPtr->type == OR_CE)) { theLHS = ReverseAndOr(theEnv,theLHS,argPtr->right,count); change = TRUE; *newChange = TRUE; break; } /*==============================================================*/ /* Convert not/or CE combinations into and/not CE combinations. */ /*==============================================================*/ else if ((theLHS->type == NOT_CE) && (argPtr->type == OR_CE)) { change = TRUE; *newChange = TRUE; tempArg = argPtr->right; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); theLHS->type = AND_CE; theLHS->right = tempArg; while (tempArg != NULL) { newNode = GetLHSParseNode(theEnv); CopyLHSParseNode(theEnv,newNode,tempArg,FALSE); newNode->right = tempArg->right; newNode->bottom = NULL; tempArg->type = NOT_CE; tempArg->negated = FALSE; tempArg->logical = FALSE; tempArg->value = NULL; tempArg->expression = NULL; tempArg->right = newNode; tempArg = tempArg->bottom; } break; } /*=====================================*/ /* Remove duplication of or CEs within */ /* or CEs and and CEs within and CEs. */ /*=====================================*/ else if (((theLHS->type == OR_CE) && (argPtr->type == OR_CE)) || ((theLHS->type == AND_CE) && (argPtr->type == AND_CE))) { if (argPtr->logical) theLHS->logical = TRUE; change = TRUE; *newChange = TRUE; tempArg = argPtr->right; nextArg = argPtr->bottom; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); if (lastArg == NULL) { theLHS->right = tempArg; } else { lastArg->bottom = tempArg; } argPtr = tempArg; while (tempArg->bottom != NULL) tempArg = tempArg->bottom; tempArg->bottom = nextArg; } /*===================================================*/ /* If no changes are needed, move on to the next CE. */ /*===================================================*/ else { count++; lastArg = argPtr; argPtr = argPtr->bottom; } } } /*===========================*/ /* Return the reordered LHS. */ /*===========================*/ return(theLHS); } /***********************************************************/ /* PerformReorder2: Reorders a group of CEs to accommodate */ /* KB Rete topology. The second pass performs all other */ /* transformations not associated with the or CE. */ /***********************************************************/ static struct lhsParseNode *PerformReorder2( void *theEnv, struct lhsParseNode *theLHS, int *newChange) { struct lhsParseNode *argPtr; int change; /*======================================================*/ /* Loop through the CEs as long as changes can be made. */ /*======================================================*/ change = TRUE; *newChange = FALSE; while (change) { change = FALSE; for (argPtr = theLHS->right; argPtr != NULL;) { /*======================================*/ /* Replace not CEs containing a pattern */ /* CE with a negated pattern CE. */ /*======================================*/ if ((theLHS->type == NOT_CE) && (argPtr->type == PATTERN_CE)) { change = TRUE; *newChange = TRUE; CopyLHSParseNode(theEnv,theLHS,argPtr,FALSE); theLHS->negated = TRUE; theLHS->right = argPtr->right; argPtr->networkTest = NULL; argPtr->expression = NULL; argPtr->userData = NULL; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); break; } /*============================================================*/ /* Replace "and" and "not" CEs contained within a not CE with */ /* just the and CE, but increment the nand depths of the */ /* pattern contained within. */ /*============================================================*/ else if ((theLHS->type == NOT_CE) && ((argPtr->type == AND_CE) || (argPtr->type == NOT_CE))) { change = TRUE; *newChange = TRUE; theLHS->type = argPtr->type; theLHS->negated = argPtr->negated; theLHS->value = argPtr->value; theLHS->logical = argPtr->logical; theLHS->right = argPtr->right; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); IncrementNandDepth(theEnv,theLHS->right,TRUE); break; } /*===================================================*/ /* If no changes are needed, move on to the next CE. */ /*===================================================*/ else { argPtr = argPtr->bottom; } } } /*===========================*/ /* Return the reordered LHS. */ /*===========================*/ return(theLHS); } /**************************************************/ /* ReverseAndOr: Switches and/or CEs into */ /* equivalent or/and CEs. For example: */ /* */ /* (and (or a b) (or c d)) */ /* */ /* would be converted to */ /* */ /* (or (and a (or c d)) (and b (or c d))), */ /* */ /* if the "or" CE being expanded was (or a b). */ /**************************************************/ static struct lhsParseNode *ReverseAndOr( void *theEnv, struct lhsParseNode *listOfCEs, struct lhsParseNode *orCE, int orPosition) { int count; struct lhsParseNode *listOfExpandedOrCEs = NULL; struct lhsParseNode *lastExpandedOrCE = NULL; struct lhsParseNode *copyOfCEs, *replaceCE; /*========================================================*/ /* Loop through each of the CEs contained within the "or" */ /* CE that is being expanded into the enclosing "and" CE. */ /*========================================================*/ while (orCE != NULL) { /*===============================*/ /* Make a copy of the and/or CE. */ /*===============================*/ copyOfCEs = CopyLHSParseNodes(theEnv,listOfCEs); /*====================================================*/ /* Get a pointer to the "or" CE being expanded in the */ /* copy just made based on the position of the "or" */ /* CE in the original and/or CE (e.g., 1st, 2nd). */ /*====================================================*/ for (count = 1, replaceCE = copyOfCEs->right; count != orPosition; count++, replaceCE = replaceCE->bottom) { /* Do Nothing*/ } /*===================================================*/ /* Delete the contents of the "or" CE being expanded */ /* in the copy of the and/or CE. From the example */ /* above, (and (or a b) (or c d)) would be replaced */ /* with (and (or) (or c d)). Note that the "or" CE */ /* is still left as a placeholder. */ /*===================================================*/ ReturnLHSParseNodes(theEnv,replaceCE->right); /*======================================================*/ /* Copy the current CE being examined in the "or" CE to */ /* the placeholder left in the and/or CE. From the */ /* example above, (and (or) (or c d)) would be replaced */ /* with (and a (or c d)) if the "a" pattern from the */ /* "or" CE was being examined or (and b (or c d)) if */ /* the "b" pattern from the "or" CE was being examined. */ /*======================================================*/ CopyLHSParseNode(theEnv,replaceCE,orCE,TRUE); replaceCE->right = CopyLHSParseNodes(theEnv,orCE->right); /*====================================*/ /* Add the newly expanded "and" CE to */ /* the list of CEs already expanded. */ /*====================================*/ if (lastExpandedOrCE == NULL) { listOfExpandedOrCEs = copyOfCEs; copyOfCEs->bottom = NULL; lastExpandedOrCE = copyOfCEs; } else { lastExpandedOrCE->bottom = copyOfCEs; copyOfCEs->bottom = NULL; lastExpandedOrCE = copyOfCEs; } /*=======================================================*/ /* Move on to the next CE in the "or" CE being expanded. */ /*=======================================================*/ orCE = orCE->bottom; } /*=====================================================*/ /* Release the original and/or CE list to free memory. */ /*=====================================================*/ ReturnLHSParseNodes(theEnv,listOfCEs); /*================================================*/ /* Wrap an or CE around the list of expanded CEs. */ /*================================================*/ copyOfCEs = GetLHSParseNode(theEnv); copyOfCEs->type = OR_CE; copyOfCEs->right = listOfExpandedOrCEs; /*================================*/ /* Return the newly expanded CEs. */ /*================================*/ return(copyOfCEs); } /***********************************************************/ /* CompressCEs: */ /***********************************************************/ static struct lhsParseNode *CompressCEs( void *theEnv, struct lhsParseNode *theLHS, int *newChange) { struct lhsParseNode *argPtr, *lastArg, *nextArg; struct lhsParseNode *tempArg; int change; struct expr *e1, *e2; /*======================================================*/ /* Loop through the CEs as long as changes can be made. */ /*======================================================*/ change = TRUE; *newChange = FALSE; while (change) { change = FALSE; lastArg = NULL; for (argPtr = theLHS->right; argPtr != NULL;) { /*=====================================*/ /* Remove duplication of or CEs within */ /* or CEs and and CEs within and CEs. */ /*=====================================*/ if (((theLHS->type == OR_CE) && (argPtr->type == OR_CE)) || ((theLHS->type == AND_CE) && (argPtr->type == AND_CE))) { if (argPtr->logical) theLHS->logical = TRUE; change = TRUE; *newChange = TRUE; tempArg = argPtr->right; nextArg = argPtr->bottom; argPtr->right = NULL; argPtr->bottom = NULL; ReturnLHSParseNodes(theEnv,argPtr); if (lastArg == NULL) { theLHS->right = tempArg; } else { lastArg->bottom = tempArg; } argPtr = tempArg; while (tempArg->bottom != NULL) tempArg = tempArg->bottom; tempArg->bottom = nextArg; } /*=======================================================*/ /* Replace not CEs containing a test CE with just a test */ /* CE with the original test CE condition negated. */ /*=======================================================*/ else if ((theLHS->type == NOT_CE) && (argPtr->type == TEST_CE)) { change = TRUE; *newChange = TRUE; e1 = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NOT); e2 = LHSParseNodesToExpression(theEnv,argPtr->expression); e1->arg_list = e2; CopyLHSParseNode(theEnv,theLHS,argPtr,TRUE); ReturnLHSParseNodes(theEnv,argPtr); ReturnLHSParseNodes(theEnv,theLHS->expression); theLHS->expression = ExpressionToLHSParseNodes(theEnv,e1); theLHS->right = NULL; ReturnExpression(theEnv,e1); break; } /*==============================*/ /* Two adjacent test CEs within */ /* an and CE can be combined. */ /*==============================*/ else if ((theLHS->type == AND_CE) && (argPtr->type == TEST_CE) && ((argPtr->bottom != NULL) ? argPtr->bottom->type == TEST_CE : FALSE) && (argPtr->beginNandDepth == argPtr->endNandDepth) && (argPtr->endNandDepth == argPtr->bottom->beginNandDepth)) { change = TRUE; *newChange = TRUE; e1 = LHSParseNodesToExpression(theEnv,argPtr->expression); e2 = LHSParseNodesToExpression(theEnv,argPtr->bottom->expression); e1 = CombineExpressions(theEnv,e1,e2); ReturnLHSParseNodes(theEnv,argPtr->expression); argPtr->expression = ExpressionToLHSParseNodes(theEnv,e1); ReturnExpression(theEnv,e1); tempArg = argPtr->bottom; argPtr->bottom = tempArg->bottom; tempArg->bottom = NULL; ReturnLHSParseNodes(theEnv,tempArg); } /*=====================================*/ /* Replace and CEs containing a single */ /* test CE with just a test CE. */ /*=====================================*/ else if ((theLHS->type == AND_CE) && (argPtr->type == TEST_CE) && (theLHS->right == argPtr) && (argPtr->bottom == NULL)) { change = TRUE; *newChange = TRUE; CopyLHSParseNode(theEnv,theLHS,argPtr,TRUE); theLHS->right = NULL; ReturnLHSParseNodes(theEnv,argPtr); break; } /*===================================================*/ /* If no changes are needed, move on to the next CE. */ /*===================================================*/ else { lastArg = argPtr; argPtr = argPtr->bottom; } } } /*===========================*/ /* Return the reordered LHS. */ /*===========================*/ return(theLHS); } /*********************************************************************/ /* CopyLHSParseNodes: Copies a linked group of conditional elements. */ /*********************************************************************/ globle struct lhsParseNode *CopyLHSParseNodes( void *theEnv, struct lhsParseNode *listOfCEs) { struct lhsParseNode *newList; if (listOfCEs == NULL) { return(NULL); } newList = get_struct(theEnv,lhsParseNode); CopyLHSParseNode(theEnv,newList,listOfCEs,TRUE); newList->right = CopyLHSParseNodes(theEnv,listOfCEs->right); newList->bottom = CopyLHSParseNodes(theEnv,listOfCEs->bottom); return(newList); } /**********************************************************/ /* CopyLHSParseNode: Copies a single conditional element. */ /**********************************************************/ globle void CopyLHSParseNode( void *theEnv, struct lhsParseNode *dest, struct lhsParseNode *src, int duplicate) { dest->type = src->type; dest->value = src->value; dest->negated = src->negated; dest->bindingVariable = src->bindingVariable; dest->withinMultifieldSlot = src->withinMultifieldSlot; dest->multifieldSlot = src->multifieldSlot; dest->multiFieldsBefore = src->multiFieldsBefore; dest->multiFieldsAfter = src->multiFieldsAfter; dest->singleFieldsBefore = src->singleFieldsBefore; dest->singleFieldsAfter = src->singleFieldsAfter; dest->logical = src->logical; dest->userCE = src->userCE; dest->referringNode = src->referringNode; dest->patternType = src->patternType; dest->pattern = src->pattern; dest->index = src->index; dest->slot = src->slot; dest->slotNumber = src->slotNumber; dest->beginNandDepth = src->beginNandDepth; dest->endNandDepth = src->endNandDepth; /*==========================================================*/ /* The duplicate flag controls whether pointers to existing */ /* data structures are used when copying some slots or if */ /* new copies of the data structures are made. */ /*==========================================================*/ if (duplicate) { dest->networkTest = CopyExpression(theEnv,src->networkTest); if (src->userData == NULL) { dest->userData = NULL; } else if (src->patternType->copyUserDataFunction == NULL) { dest->userData = src->userData; } else { dest->userData = (*src->patternType->copyUserDataFunction)(theEnv,src->userData); } dest->expression = CopyLHSParseNodes(theEnv,src->expression); dest->constraints = CopyConstraintRecord(theEnv,src->constraints); if (dest->constraints != NULL) dest->derivedConstraints = TRUE; else dest->derivedConstraints = FALSE; } else { dest->networkTest = src->networkTest; dest->userData = src->userData; dest->expression = src->expression; dest->derivedConstraints = FALSE; dest->constraints = src->constraints; } } /****************************************************/ /* GetLHSParseNode: Creates an empty node structure */ /* used for building conditional elements. */ /****************************************************/ globle struct lhsParseNode *GetLHSParseNode( void *theEnv) { struct lhsParseNode *newNode; newNode = get_struct(theEnv,lhsParseNode); newNode->type = UNKNOWN_VALUE; newNode->value = NULL; newNode->negated = FALSE; newNode->bindingVariable = FALSE; newNode->withinMultifieldSlot = FALSE; newNode->multifieldSlot = FALSE; newNode->multiFieldsBefore = 0; newNode->multiFieldsAfter = 0; newNode->singleFieldsBefore = 0; newNode->singleFieldsAfter = 0; newNode->logical = FALSE; newNode->derivedConstraints = FALSE; newNode->userCE = TRUE; newNode->constraints = NULL; newNode->referringNode = NULL; newNode->patternType = NULL; newNode->pattern = -1; newNode->index = -1; newNode->slot = NULL; newNode->slotNumber = -1; newNode->beginNandDepth = 1; newNode->endNandDepth = 1; newNode->userData = NULL; newNode->networkTest = NULL; newNode->expression = NULL; newNode->right = NULL; newNode->bottom = NULL; return(newNode); } /********************************************************/ /* ReturnLHSParseNodes: Returns a multiply linked list */ /* of lhsParseNode structures to the memory manager. */ /********************************************************/ globle void ReturnLHSParseNodes( void *theEnv, struct lhsParseNode *waste) { if (waste != NULL) { ReturnExpression(theEnv,waste->networkTest); ReturnLHSParseNodes(theEnv,waste->right); ReturnLHSParseNodes(theEnv,waste->bottom); ReturnLHSParseNodes(theEnv,waste->expression); if (waste->derivedConstraints) RemoveConstraint(theEnv,waste->constraints); if ((waste->userData != NULL) && (waste->patternType->returnUserDataFunction != NULL)) { (*waste->patternType->returnUserDataFunction)(theEnv,waste->userData); } rtn_struct(theEnv,lhsParseNode,waste); } } /********************************************************/ /* ExpressionToLHSParseNodes: Copies an expression into */ /* the equivalent lhsParseNode data structures. */ /********************************************************/ globle struct lhsParseNode *ExpressionToLHSParseNodes( void *theEnv, struct expr *expressionList) { struct lhsParseNode *newList, *theList; struct FunctionDefinition *theFunction; int i, theRestriction; /*===========================================*/ /* A NULL expression requires no conversion. */ /*===========================================*/ if (expressionList == NULL) return(NULL); /*====================================*/ /* Recursively convert the expression */ /* to lhsParseNode data structures. */ /*====================================*/ newList = GetLHSParseNode(theEnv); newList->type = expressionList->type; newList->value = expressionList->value; newList->right = ExpressionToLHSParseNodes(theEnv,expressionList->nextArg); newList->bottom = ExpressionToLHSParseNodes(theEnv,expressionList->argList); /*==================================================*/ /* If the expression is a function call, then store */ /* the constraint information for the functions */ /* arguments in the lshParseNode data structures. */ /*==================================================*/ if (newList->type != FCALL) return(newList); theFunction = (struct FunctionDefinition *) newList->value; for (theList = newList->bottom, i = 1; theList != NULL; theList = theList->right, i++) { if (theList->type == SF_VARIABLE) { theRestriction = GetNthRestriction(theFunction,i); theList->constraints = ArgumentTypeToConstraintRecord(theEnv,theRestriction); theList->derivedConstraints = TRUE; } } /*==================================*/ /* Return the converted expression. */ /*==================================*/ return(newList); } /******************************************************************/ /* LHSParseNodesToExpression: Copies lhsParseNode data structures */ /* into the equivalent expression data structures. */ /******************************************************************/ globle struct expr *LHSParseNodesToExpression( void *theEnv, struct lhsParseNode *nodeList) { struct expr *newList; if (nodeList == NULL) { return(NULL); } newList = get_struct(theEnv,expr); newList->type = nodeList->type; newList->value = nodeList->value; newList->nextArg = LHSParseNodesToExpression(theEnv,nodeList->right); newList->argList = LHSParseNodesToExpression(theEnv,nodeList->bottom); return(newList); } /************************************************************/ /* IncrementNandDepth: Increments the nand depth of a group */ /* of CEs. The nand depth is used to indicate the nesting */ /* of not/and or not/not CEs which are implemented using */ /* joins from the right. A single pattern within a "not" */ /* CE does not require a join from the right and its nand */ /* depth is normally not increased (except when it's */ /* within a not/and or not/not CE. The begin nand depth */ /* indicates the current nesting for a CE. The end nand */ /* depth indicates the nand depth in the following CE */ /* (assuming that the next CE is not the beginning of a */ /* new group of nand CEs). All but the last CE in a nand */ /* group should have the same begin and end nand depths. */ /* Since a single CE can be the last CE of several nand */ /* groups, it is possible to have an end nand depth that */ /* is more than 1 less than the begin nand depth of the */ /* CE. */ /************************************************************/ static void IncrementNandDepth( void *theEnv, struct lhsParseNode *theLHS, int lastCE) { /*======================================*/ /* Loop through each CE in the group of */ /* CEs having its nand depth increased. */ /*======================================*/ for (; theLHS != NULL; theLHS = theLHS->bottom) { /*=========================================================*/ /* Increment the begin nand depth of pattern and test CEs. */ /* The last CE in the original list doesn't have its end */ /* nand depth incremented. All other last CEs in other CEs */ /* entered recursively do have their end depth incremented */ /* (unless the last CE in the recursively entered CE is */ /* the same last CE as contained in the original group */ /* when this function was first entered). */ /*=========================================================*/ if ((theLHS->type == PATTERN_CE) || (theLHS->type == TEST_CE)) { theLHS->beginNandDepth++; if (lastCE == FALSE) theLHS->endNandDepth++; else if (theLHS->bottom != NULL) theLHS->endNandDepth++; } /*==============================================*/ /* Recursively increase the nand depth of other */ /* CEs contained within the CE having its nand */ /* depth increased. */ /*==============================================*/ else if ((theLHS->type == AND_CE) || (theLHS->type == NOT_CE)) { IncrementNandDepth(theEnv,theLHS->right, (lastCE ? (theLHS->bottom == NULL) : FALSE)); } /*=====================================*/ /* All or CEs should have been removed */ /* from the LHS at this point. */ /*=====================================*/ else if (theLHS->type == OR_CE) { SystemError(theEnv,"REORDER",1); } } } /***********************************************************/ /* CreateInitialPattern: Creates a default pattern used in */ /* the LHS of a rule under certain cirmustances (such as */ /* when a "not" or "test" CE is the first CE in an "and" */ /* CE or when no CEs are specified in the LHS of a rule. */ /***********************************************************/ static struct lhsParseNode *CreateInitialPattern( void *theEnv, struct patternParser *theParser) { struct lhsParseNode *topNode; /*==========================================*/ /* Create the top most node of the pattern. */ /*==========================================*/ topNode = GetLHSParseNode(theEnv); topNode->type = PATTERN_CE; topNode->userCE = FALSE; topNode->bottom = NULL; /*==============================================*/ /* If a pattern type was not supplied, then try */ /* to use the (initial-fact) fact pattern. */ /*==============================================*/ if (theParser == NULL) { theParser = FindPatternParser(theEnv,"facts"); } /*====================================================*/ /* If a pattern type was supplied or the initial fact */ /* pattern is available, create the initial pattern */ /* with one of those in the given order. */ /*====================================================*/ if (theParser != NULL) { topNode->right = (*theParser->initialPatternFunction)(theEnv); PropagatePatternType(topNode,theParser); return(topNode); } /*=============================================*/ /* If neither a pattern type was supplied nor */ /* the initial fact pattern was available, use */ /* any available initial pattern. */ /*=============================================*/ for (theParser = PatternData(theEnv)->ListOfPatternParsers; theParser != NULL; theParser = theParser->next) { if (theParser->initialPatternFunction != NULL) { topNode->right = (*theParser->initialPatternFunction)(theEnv); PropagatePatternType(topNode,theParser); return(topNode); } } /*===========================================*/ /* There must be at least one pattern parser */ /* capable of creating an initial pattern. */ /*===========================================*/ SystemError(theEnv,"REORDER",2); return(NULL); } /*****************************************************************/ /* AddRemainingInitialPatterns: Finishes adding initial patterns */ /* where needed on the LHS of a rule. Assumes that an initial */ /* pattern has been added to the beginning of the rule if one */ /* was needed. */ /*****************************************************************/ static void AddRemainingInitialPatterns( void *theEnv, struct lhsParseNode *theLHS, struct patternParser *defaultType) { struct lhsParseNode *trackNode, *tempNode, *lastNode; /*====================================================*/ /* Set the mark flag for each CE in the LHS to FALSE. */ /*====================================================*/ for (trackNode = theLHS; trackNode != NULL; trackNode = trackNode->bottom) { trackNode->marked = FALSE; } /*==================================*/ /* Loop through each CE in the LHS. */ /*==================================*/ lastNode = NULL; while (theLHS != NULL) { /*===================================*/ /* A "not" CE will not propagate its */ /* pattern type to following CEs. */ /*===================================*/ if ((theLHS->negated) && (theLHS->marked)) { trackNode = NULL; } /*==================================================*/ /* A "test" or "not" CE was found that has not been */ /* marked. Add an initial pattern before the CE. */ /*==================================================*/ else if (((theLHS->type == TEST_CE) || (theLHS->negated)) && (theLHS->marked == FALSE)) { if (theLHS->negated) tempNode = CreateInitialPattern(theEnv,theLHS->patternType); else tempNode = CreateInitialPattern(theEnv,defaultType); tempNode->logical = theLHS->logical; tempNode->beginNandDepth = theLHS->beginNandDepth; tempNode->endNandDepth = theLHS->beginNandDepth; if (lastNode == NULL) { SystemError(theEnv,"REORDER",3); } lastNode->bottom = tempNode; tempNode->bottom = theLHS; theLHS = tempNode; trackNode = theLHS->bottom; } /*===================================================*/ /* If a pattern CE is found, then propagate its type */ /* to following test CEs in the same lexical scope. */ /*===================================================*/ else { trackNode = theLHS->bottom; } /*=======================================================*/ /* Mark the pattern type of a "test" or "not" CE as the */ /* same type as the last pattern CE found that is within */ /* the same lexical scope as the "test" or "not" CE. */ /*=======================================================*/ for (; trackNode != NULL; trackNode = trackNode->bottom) { /*=====================================*/ /* If the CE isn't in the same lexical */ /* scope, move on to the next CE. */ /*=====================================*/ if (trackNode->beginNandDepth != theLHS->beginNandDepth) { continue; } /*=======================================================*/ /* Mark a negated CE that is in the same lexical scope. */ /* This signifies that there is a preceeding non-negated */ /* pattern and thus no need for an initial pattern to be */ /* placed before this CE. */ /*=======================================================*/ else if (trackNode->negated) { trackNode->marked = TRUE; } /*====================================================*/ /* If another non-negated pattern in the same lexical */ /* scope if found, stop propagation of the current */ /* pattern type. */ /*====================================================*/ else if (trackNode->type == PATTERN_CE) { break; } /*====================================================*/ /* A "test" CE in the same lexical scope is marked to */ /* indicate that it has a non-negated pattern that it */ /* can be attached to. */ /*====================================================*/ else if (trackNode->type == TEST_CE) { trackNode->marked = TRUE; trackNode->patternType = theLHS->patternType; } } /*====================================*/ /* Move on to the next CE in the LHS. */ /*====================================*/ lastNode = theLHS; theLHS = theLHS->bottom; } } /**********************************************/ /* PrintNodes: Debugging routine which prints */ /* the representation of a CE. */ /**********************************************/ static void PrintNodes( void *theEnv, char *fileid, struct lhsParseNode *theNode) { if (theNode == NULL) return; while (theNode != NULL) { switch (theNode->type) { case PATTERN_CE: EnvPrintRouter(theEnv,fileid,"("); if (theNode->negated) EnvPrintRouter(theEnv,fileid,"n"); if (theNode->logical) EnvPrintRouter(theEnv,fileid,"l"); PrintLongInteger(theEnv,fileid,(long) theNode->beginNandDepth); EnvPrintRouter(theEnv,fileid,"-"); PrintLongInteger(theEnv,fileid,(long) theNode->endNandDepth); EnvPrintRouter(theEnv,fileid," "); EnvPrintRouter(theEnv,fileid,ValueToString(theNode->right->bottom->value)); EnvPrintRouter(theEnv,fileid,")"); break; case TEST_CE: EnvPrintRouter(theEnv,fileid,"(test "); PrintLongInteger(theEnv,fileid,(long) theNode->beginNandDepth); EnvPrintRouter(theEnv,fileid,"-"); PrintLongInteger(theEnv,fileid,(long) theNode->endNandDepth); EnvPrintRouter(theEnv,fileid,")"); break; case NOT_CE: if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(lnot "); else EnvPrintRouter(theEnv,fileid,"(not ");; PrintNodes(theEnv,fileid,theNode->right); EnvPrintRouter(theEnv,fileid,")"); break; case OR_CE: if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(lor "); else EnvPrintRouter(theEnv,fileid,"(or "); PrintNodes(theEnv,fileid,theNode->right); EnvPrintRouter(theEnv,fileid,")"); break; case AND_CE: if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(land "); else EnvPrintRouter(theEnv,fileid,"(and "); PrintNodes(theEnv,fileid,theNode->right); EnvPrintRouter(theEnv,fileid,")"); break; default: EnvPrintRouter(theEnv,fileid,"(unknown)"); break; } theNode = theNode->bottom; if (theNode != NULL) EnvPrintRouter(theEnv,fileid," "); } return; } /*************************************************************/ /* AssignPatternIndices: For each pattern CE in the LHS of a */ /* rule, determines the pattern index for the CE. A simple */ /* 1 to N numbering can't be used since a join from the */ /* right only counts as a single CE to other CEs outside */ /* the lexical scope of the join from the right. For */ /* example, the patterns in the following LHS */ /* */ /* (a) (not (b) (c) (d)) (e) */ /* */ /* would be assigned the following numbers: a-1, b-2, c-3, */ /* d-4, and e-3. */ /*************************************************************/ static struct lhsParseNode *AssignPatternIndices( struct lhsParseNode *theLHS, short startIndex) { int depth; struct lhsParseNode *theField; depth = theLHS->beginNandDepth; /*====================================*/ /* Loop through the CEs at this level */ /* assigning each CE a pattern index. */ /*====================================*/ while (theLHS != NULL) { /*============================================================*/ /* If we're entering a group of CEs requiring a join from the */ /* right, compute the pattern indices for that group and then */ /* proceed with the next CE in this group. A join from the */ /* right only counts as one CE on this level regardless of */ /* the number of CEs it contains. If the end of this level is */ /* encountered while processing the join from right, then */ /* return to the previous level. */ /*============================================================*/ if (theLHS->beginNandDepth > depth) { theLHS = AssignPatternIndices(theLHS,startIndex); if (theLHS->endNandDepth < depth) return(theLHS); startIndex++; } /*=====================================================*/ /* A test CE is not assigned a pattern index, however, */ /* if it is the last CE at the end of this level, then */ /* return to the previous level. */ /*=====================================================*/ else if (theLHS->type == TEST_CE) { if (theLHS->endNandDepth < depth) return(theLHS); } /*==========================================================*/ /* The fields of a pattern CE need to be assigned a pattern */ /* index, field index, and/or slot names. If this CE is the */ /* last CE at the end of this level, then return to the */ /* previous level. */ /*==========================================================*/ else if (theLHS->type == PATTERN_CE) { theLHS->pattern = startIndex; for (theField = theLHS->right; theField != NULL; theField = theField->right) { theField->pattern = startIndex; PropagateIndexSlotPatternValues(theField,theField->pattern, theField->index,theField->slot, theField->slotNumber); } if (theLHS->endNandDepth < depth) return(theLHS); startIndex++; } /*=========================*/ /* Move on to the next CE. */ /*=========================*/ theLHS = theLHS->bottom; } /*========================================*/ /* There are no more CEs left to process. */ /* Return to the previous level. */ /*========================================*/ return(NULL); } /***********************************************************/ /* PropagateIndexSlotPatternValues: Assigns pattern, field */ /* and slot identifiers to a field in a pattern. */ /***********************************************************/ static void PropagateIndexSlotPatternValues( struct lhsParseNode *theField, short thePattern, short theIndex, struct symbolHashNode *theSlot, short theSlotNumber) { struct lhsParseNode *tmpNode, *andField; /*=============================================*/ /* A NULL field does not have to be processed. */ /*=============================================*/ if (theField == NULL) return; /*=====================================================*/ /* Assign the appropriate identifiers for a multifield */ /* slot by calling this routine recursively. */ /*=====================================================*/ if (theField->multifieldSlot) { theField->pattern = thePattern; if (theIndex > 0) theField->index = theIndex; theField->slot = theSlot; theField->slotNumber = theSlotNumber; for (tmpNode = theField->bottom; tmpNode != NULL; tmpNode = tmpNode->right) { tmpNode->pattern = thePattern; tmpNode->slot = theSlot; PropagateIndexSlotPatternValues(tmpNode,thePattern,tmpNode->index, theSlot,theSlotNumber); } return; } /*=======================================================*/ /* Loop through each of the or'ed constraints (connected */ /* by a |) in this field of the pattern. */ /*=======================================================*/ for (theField = theField->bottom; theField != NULL; theField = theField->bottom) { /*===========================================================*/ /* Loop through each of the and'ed constraints (connected by */ /* a &) in this field of the pattern. Assign the pattern, */ /* field, and slot identifiers. */ /*===========================================================*/ for (andField = theField; andField != NULL; andField = andField->right) { andField->pattern = thePattern; if (theIndex > 0) andField->index = theIndex; andField->slot = theSlot; andField->slotNumber = theSlotNumber; } } } #endif clips-6.24/clipssrc/._msgcom.c0000400000175000017500000000075410441602244014366 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH MonacoaLDsaLDslJ996TTFL,FMPSRMWBBLclips-6.24/clipssrc/._factbld.h0000400000175000017500000000012207422635004014477 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/dffctbin.h0000755000175000017500000000410007422634657014474 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFFACTS BSAVE/BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #if (! RUN_TIME) #ifndef _H_dffctbin #define _H_dffctbin #include "modulbin.h" #include "cstrcbin.h" #ifndef _H_constrct #include "constrct.h" #endif struct bsaveDeffacts { struct bsaveConstructHeader header; long assertList; }; struct bsaveDeffactsModule { struct bsaveDefmoduleItemHeader header; }; #define DFFCTBIN_DATA 26 struct deffactsBinaryData { struct deffacts *DeffactsArray; long NumberOfDeffacts; struct deffactsModule *ModuleArray; long NumberOfDeffactsModules; }; #define DeffactsBinaryData(theEnv) ((struct deffactsBinaryData *) GetEnvironmentData(theEnv,DFFCTBIN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeffactsBinarySetup(void *); LOCALE void *BloadDeffactsModuleReference(void *,int); #endif #endif clips-6.24/clipssrc/objrtcmp.h0000755000175000017500000000335610441072155014531 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /*************************************************************/ #ifndef _H_objrtcmp #define _H_objrtcmp #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && CONSTRUCT_COMPILER #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ObjectPatternsCompilerSetup(void *); LOCALE void ObjectPatternNodeReference(void *,void *,FILE *,int,int); #endif #endif clips-6.24/clipssrc/factcom.h0000755000175000017500000000562210357050014014317 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* FACT COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factcom #define _H_factcom #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define Facts(theEnv,a,b,c,d,e) EnvFacts(theEnv,a,b,c,d,e) #define LoadFacts(theEnv,a) EnvLoadFacts(theEnv,a) #define SaveFacts(theEnv,a,b,c) EnvSaveFacts(theEnv,a,b,c) #define LoadFactsFromString(theEnv,a,b) EnvLoadFactsFromString(theEnv,a,b) #else #define Facts(a,b,c,d,e) EnvFacts(GetCurrentEnvironment(),a,b,c,d,e) #define LoadFacts(a) EnvLoadFacts(GetCurrentEnvironment(),a) #define SaveFacts(a,b,c) EnvSaveFacts(GetCurrentEnvironment(),a,b,c) #define LoadFactsFromString(a,b) EnvLoadFactsFromString(GetCurrentEnvironment(),a,b) #endif LOCALE void FactCommandDefinitions(void *); LOCALE void AssertCommand(void *,DATA_OBJECT_PTR); LOCALE void RetractCommand(void *); LOCALE void AssertStringFunction(void *,DATA_OBJECT_PTR); LOCALE void FactsCommand(void *); LOCALE void EnvFacts(void *,char *,void *,long,long,long); LOCALE int SetFactDuplicationCommand(void *); LOCALE int GetFactDuplicationCommand(void *); LOCALE int SaveFactsCommand(void *); LOCALE int LoadFactsCommand(void *); LOCALE int EnvSaveFacts(void *,char *,int,struct expr *); LOCALE int EnvLoadFacts(void *,char *); LOCALE int EnvLoadFactsFromString(void *,char *,int); LOCALE long int FactIndexFunction(void *); #endif clips-6.24/clipssrc/._bsave.h0000400000175000017500000000075410441127776014222 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco0z0z.TTFSFMWBBMPSRclips-6.24/clipssrc/._prcdrpsr.c0000400000175000017500000000075410441150551014737 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco;TTFS eFMWBBMPSRclips-6.24/clipssrc/._edmain.c0000400000175000017500000000061410441163372014335 0ustar jfsjfsMac OS X  2 R:TEXT????22/B2MWBB clips-6.24/clipssrc/._pprint.h0000400000175000017500000000012207422635023014415 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._facthsh.h0000400000175000017500000000075410441143353014527 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z1TTFS FMWBBMPSRclips-6.24/clipssrc/exprnpsr.c0000755000175000017500000006671710441132036014572 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EXPRESSION PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for parsing expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _EXPRNPSR_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include "constant.h" #include "envrnmnt.h" #include "router.h" #include "strngrtr.h" #include "scanner.h" #include "memalloc.h" #include "argacces.h" #include "prntutil.h" #include "cstrnchk.h" #include "extnfunc.h" #include "exprnpsr.h" #include "modulutl.h" #include "prcdrfun.h" #if DEFRULE_CONSTRUCT #include "network.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if (! RUN_TIME) /***************************************************/ /* Function0Parse: Parses a function. Assumes that */ /* none of the function has been parsed yet. */ /***************************************************/ globle struct expr *Function0Parse( void *theEnv, char *logicalName) { struct token theToken; struct expr *top; /*=================================*/ /* All functions begin with a '('. */ /*=================================*/ GetToken(theEnv,logicalName,&theToken); if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"function calls"); return(NULL); } /*=================================*/ /* Parse the rest of the function. */ /*=================================*/ top = Function1Parse(theEnv,logicalName); return(top); } /*******************************************************/ /* Function1Parse: Parses a function. Assumes that the */ /* opening left parenthesis has already been parsed. */ /*******************************************************/ globle struct expr *Function1Parse( void *theEnv, char *logicalName) { struct token theToken; struct expr *top; /*========================*/ /* Get the function name. */ /*========================*/ GetToken(theEnv,logicalName,&theToken); if (theToken.type != SYMBOL) { PrintErrorID(theEnv,"EXPRNPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"A function name must be a symbol\n"); return(NULL); } /*=================================*/ /* Parse the rest of the function. */ /*=================================*/ top = Function2Parse(theEnv,logicalName,ValueToString(theToken.value)); return(top); } /****************************************************/ /* Function2Parse: Parses a function. Assumes that */ /* the opening left parenthesis and function name */ /* have already been parsed. */ /****************************************************/ globle struct expr *Function2Parse( void *theEnv, char *logicalName, char *name) { struct FunctionDefinition *theFunction; struct expr *top; #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif /*=========================================================*/ /* Module specification cannot be used in a function call. */ /*=========================================================*/ if (FindModuleSeparator(name)) { IllegalModuleSpecifierMessage(theEnv); return(NULL); } /*================================*/ /* Has the function been defined? */ /*================================*/ theFunction = FindFunction(theEnv,name); #if DEFGENERIC_CONSTRUCT gfunc = (void *) LookupDefgenericInScope(theEnv,name); #endif #if DEFFUNCTION_CONSTRUCT if ((theFunction == NULL) #if DEFGENERIC_CONSTRUCT && (gfunc == NULL) #endif ) dptr = (void *) LookupDeffunctionInScope(theEnv,name); else dptr = NULL; #endif /*=============================*/ /* Define top level structure. */ /*=============================*/ #if DEFFUNCTION_CONSTRUCT if (dptr != NULL) top = GenConstant(theEnv,PCALL,dptr); else #endif #if DEFGENERIC_CONSTRUCT if (gfunc != NULL) top = GenConstant(theEnv,GCALL,gfunc); else #endif if (theFunction != NULL) top = GenConstant(theEnv,FCALL,theFunction); else { PrintErrorID(theEnv,"EXPRNPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Missing function declaration for "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR,".\n"); return(NULL); } /*=======================================================*/ /* Check to see if function has its own parsing routine. */ /*=======================================================*/ PushRtnBrkContexts(theEnv); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; #if DEFGENERIC_CONSTRUCT || DEFFUNCTION_CONSTRUCT if (top->type == FCALL) #endif { if (theFunction->parser != NULL) { top = (*theFunction->parser)(theEnv,top,logicalName); PopRtnBrkContexts(theEnv); if (top == NULL) return(NULL); if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } return(top); } } /*========================================*/ /* Default parsing routine for functions. */ /*========================================*/ top = CollectArguments(theEnv,top,logicalName); PopRtnBrkContexts(theEnv); if (top == NULL) return(NULL); if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } /*============================================================*/ /* If the function call uses the sequence expansion operator, */ /* its arguments cannot be checked until runtime. */ /*============================================================*/ if (top->value == (void *) FindFunction(theEnv,"(expansion-call)")) { return(top); } /*============================*/ /* Check for argument errors. */ /*============================*/ if ((top->type == FCALL) && EnvGetStaticConstraintChecking(theEnv)) { if (CheckExpressionAgainstRestrictions(theEnv,top,theFunction->restrictions,name)) { ReturnExpression(theEnv,top); return(NULL); } } #if DEFFUNCTION_CONSTRUCT else if (top->type == PCALL) { if (CheckDeffunctionCall(theEnv,top->value,CountArguments(top->argList)) == FALSE) { ReturnExpression(theEnv,top); return(NULL); } } #endif /*========================*/ /* Return the expression. */ /*========================*/ return(top); } /*********************************************************************** NAME : ReplaceSequenceExpansionOps DESCRIPTION : Replaces function calls which have multifield references as arguments into a call to a special function which expands the multifield into single arguments at run-time. Multifield references which are not function arguments are errors INPUTS : 1) The expression 2) The current function call 3) The address of the internal H/L function (expansion-call) 4) The address of the H/L function expand$ RETURNS : FALSE if OK, TRUE on errors SIDE EFFECTS : Function call expressions modified, if necessary NOTES : Function calls which truly want a multifield to be passed need use only a single-field refernce (i.e. ? instead of $? - the $ is being treated as a special expansion operator) **********************************************************************/ globle intBool ReplaceSequenceExpansionOps( void *theEnv, EXPRESSION *actions, EXPRESSION *fcallexp, void *expcall, void *expmult) { EXPRESSION *theExp; while (actions != NULL) { if ((ExpressionData(theEnv)->SequenceOpMode == FALSE) && (actions->type == MF_VARIABLE)) actions->type = SF_VARIABLE; if ((actions->type == MF_VARIABLE) || (actions->type == MF_GBL_VARIABLE) || (actions->value == expmult)) { if ((fcallexp->type != FCALL) ? FALSE : (((struct FunctionDefinition *) fcallexp->value)->sequenceuseok == FALSE)) { PrintErrorID(theEnv,"EXPRNPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"$ Sequence operator not a valid argument for "); EnvPrintRouter(theEnv,WERROR,ValueToString(((struct FunctionDefinition *) fcallexp->value)->callFunctionName)); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } if (fcallexp->value != expcall) { theExp = GenConstant(theEnv,fcallexp->type,fcallexp->value); theExp->argList = fcallexp->argList; theExp->nextArg = NULL; fcallexp->type = FCALL; fcallexp->value = expcall; fcallexp->argList = theExp; } if (actions->value != expmult) { theExp = GenConstant(theEnv,SF_VARIABLE,actions->value); if (actions->type == MF_GBL_VARIABLE) theExp->type = GBL_VARIABLE; actions->argList = theExp; actions->type = FCALL; actions->value = expmult; } } if (actions->argList != NULL) { if ((actions->type == GCALL) || (actions->type == PCALL) || (actions->type == FCALL)) theExp = actions; else theExp = fcallexp; if (ReplaceSequenceExpansionOps(theEnv,actions->argList,theExp,expcall,expmult)) return(TRUE); } actions = actions->nextArg; } return(FALSE); } /*************************************************/ /* PushRtnBrkContexts: Saves the current context */ /* for the break/return functions. */ /*************************************************/ globle void PushRtnBrkContexts( void *theEnv) { SAVED_CONTEXTS *svtmp; svtmp = get_struct(theEnv,saved_contexts); svtmp->rtn = ExpressionData(theEnv)->ReturnContext; svtmp->brk = ExpressionData(theEnv)->BreakContext; svtmp->nxt = ExpressionData(theEnv)->svContexts; ExpressionData(theEnv)->svContexts = svtmp; } /***************************************************/ /* PopRtnBrkContexts: Restores the current context */ /* for the break/return functions. */ /***************************************************/ globle void PopRtnBrkContexts( void *theEnv) { SAVED_CONTEXTS *svtmp; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk; svtmp = ExpressionData(theEnv)->svContexts; ExpressionData(theEnv)->svContexts = ExpressionData(theEnv)->svContexts->nxt; rtn_struct(theEnv,saved_contexts,svtmp); } /*****************************************************************/ /* CheckExpressionAgainstRestrictions: Compares the arguments to */ /* a function to the set of restrictions for that function to */ /* determine if any incompatibilities exist. If so, the value */ /* TRUE is returned, otherwise FALSE is returned. */ /*****************************************************************/ globle int CheckExpressionAgainstRestrictions( void *theEnv, struct expr *theExpression, char *restrictions, char *functionName) { char theChar[2]; int i = 0, j = 1; int number1, number2; int argCount; char defaultRestriction, argRestriction; struct expr *argPtr; int theRestriction; theChar[0] = '0'; theChar[1] = '\0'; /*============================================*/ /* If there are no restrictions, then there's */ /* no need to check the function. */ /*============================================*/ if (restrictions == NULL) return(FALSE); /*=========================================*/ /* Count the number of function arguments. */ /*=========================================*/ argCount = CountArguments(theExpression->argList); /*======================================*/ /* Get the minimum number of arguments. */ /*======================================*/ theChar[0] = restrictions[i++]; if (isdigit(theChar[0])) { number1 = atoi(theChar); } else if (theChar[0] == '*') { number1 = -1; } else { return(FALSE); } /*======================================*/ /* Get the maximum number of arguments. */ /*======================================*/ theChar[0] = restrictions[i++]; if (isdigit(theChar[0])) { number2 = atoi(theChar); } else if (theChar[0] == '*') { number2 = 10000; } else { return(FALSE); } /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (number1 == number2) { if (argCount != number1) { ExpectedCountError(theEnv,functionName,EXACTLY,number1); return(TRUE); } } else if (argCount < number1) { ExpectedCountError(theEnv,functionName,AT_LEAST,number1); return(TRUE); } else if (argCount > number2) { ExpectedCountError(theEnv,functionName,NO_MORE_THAN,number2); return(TRUE); } /*=======================================*/ /* Check for the default argument types. */ /*=======================================*/ defaultRestriction = restrictions[i]; if (defaultRestriction == '\0') { defaultRestriction = 'u'; } else if (defaultRestriction == '*') { defaultRestriction = 'u'; i++; } else { i++; } /*======================*/ /* Check each argument. */ /*======================*/ for (argPtr = theExpression->argList; argPtr != NULL; argPtr = argPtr->nextArg) { argRestriction = restrictions[i]; if (argRestriction == '\0') { argRestriction = defaultRestriction; } else { i++; } if (argRestriction != '*') { theRestriction = (int) argRestriction; } else { theRestriction = (int) defaultRestriction; } if (CheckArgumentAgainstRestriction(theEnv,argPtr,theRestriction)) { ExpectedTypeError1(theEnv,functionName,j,GetArgumentTypeName(theRestriction)); return(TRUE); } j++; } return(FALSE); } /*******************************************************/ /* CollectArguments: Parses and groups together all of */ /* the arguments for a function call expression. */ /*******************************************************/ globle struct expr *CollectArguments( void *theEnv, struct expr *top, char *logicalName) { int errorFlag; struct expr *lastOne, *nextOne; /*========================================*/ /* Default parsing routine for functions. */ /*========================================*/ lastOne = NULL; while (TRUE) { SavePPBuffer(theEnv," "); errorFlag = FALSE; nextOne = ArgumentParse(theEnv,logicalName,&errorFlag); if (errorFlag == TRUE) { ReturnExpression(theEnv,top); return(NULL); } if (nextOne == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); return(top); } if (lastOne == NULL) { top->argList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; } } /********************************************/ /* ArgumentParse: Parses an argument within */ /* a function call expression. */ /********************************************/ globle struct expr *ArgumentParse( void *theEnv, char *logicalName, int *errorFlag) { struct expr *top; struct token theToken; /*===============*/ /* Grab a token. */ /*===============*/ GetToken(theEnv,logicalName,&theToken); /*============================*/ /* ')' counts as no argument. */ /*============================*/ if (theToken.type == RPAREN) { return(NULL); } /*================================*/ /* Parse constants and variables. */ /*================================*/ if ((theToken.type == SF_VARIABLE) || (theToken.type == MF_VARIABLE) || (theToken.type == SYMBOL) || (theToken.type == STRING) || #if DEFGLOBAL_CONSTRUCT (theToken.type == GBL_VARIABLE) || (theToken.type == MF_GBL_VARIABLE) || #endif #if OBJECT_SYSTEM (theToken.type == INSTANCE_NAME) || #endif (theToken.type == FLOAT) || (theToken.type == INTEGER)) { return(GenConstant(theEnv,theToken.type,theToken.value)); } /*======================*/ /* Parse function call. */ /*======================*/ if (theToken.type != LPAREN) { PrintErrorID(theEnv,"EXPRNPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected a constant, variable, or expression.\n"); *errorFlag = TRUE; return(NULL); } top = Function1Parse(theEnv,logicalName); if (top == NULL) *errorFlag = TRUE; return(top); } /************************************************************/ /* ParseAtomOrExpression: Parses an expression which may be */ /* a function call, atomic value (string, symbol, etc.), */ /* or variable (local or global). */ /************************************************************/ globle struct expr *ParseAtomOrExpression( void *theEnv, char *logicalName, struct token *useToken) { struct token theToken, *thisToken; struct expr *rv; if (useToken == NULL) { thisToken = &theToken; GetToken(theEnv,logicalName,thisToken); } else thisToken = useToken; if ((thisToken->type == SYMBOL) || (thisToken->type == STRING) || (thisToken->type == INTEGER) || (thisToken->type == FLOAT) || #if OBJECT_SYSTEM (thisToken->type == INSTANCE_NAME) || #endif #if DEFGLOBAL_CONSTRUCT (thisToken->type == GBL_VARIABLE) || (thisToken->type == MF_GBL_VARIABLE) || #endif (thisToken->type == SF_VARIABLE) || (thisToken->type == MF_VARIABLE)) { rv = GenConstant(theEnv,thisToken->type,thisToken->value); } else if (thisToken->type == LPAREN) { rv = Function1Parse(theEnv,logicalName); if (rv == NULL) return(NULL); } else { PrintErrorID(theEnv,"EXPRNPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected a constant, variable, or expression.\n"); return(NULL); } return(rv); } /*********************************************/ /* GroupActions: Groups together a series of */ /* actions within a progn expression. Used */ /* for example to parse the RHS of a rule. */ /*********************************************/ globle struct expr *GroupActions( void *theEnv, char *logicalName, struct token *theToken, int readFirstToken, char *endWord, int functionNameParsed) { struct expr *top, *nextOne, *lastOne = NULL; /*=============================*/ /* Create the enclosing progn. */ /*=============================*/ top = GenConstant(theEnv,FCALL,FindFunction(theEnv,"progn")); /*========================================================*/ /* Continue until all appropriate commands are processed. */ /*========================================================*/ while (TRUE) { /*================================================*/ /* Skip reading in the token if this is the first */ /* pass and the initial token was already read */ /* before calling this function. */ /*================================================*/ if (readFirstToken) { GetToken(theEnv,logicalName,theToken); } else { readFirstToken = TRUE; } /*=================================================*/ /* Look to see if a symbol has terminated the list */ /* of actions (such as "else" in an if function). */ /*=================================================*/ if ((theToken->type == SYMBOL) && (endWord != NULL) && (! functionNameParsed)) { if (strcmp(ValueToString(theToken->value),endWord) == 0) { return(top); } } /*====================================*/ /* Process a function if the function */ /* name has already been read. */ /*====================================*/ if (functionNameParsed) { nextOne = Function2Parse(theEnv,logicalName,ValueToString(theToken->value)); functionNameParsed = FALSE; } /*========================================*/ /* Process a constant or global variable. */ /*========================================*/ else if ((theToken->type == SYMBOL) || (theToken->type == STRING) || (theToken->type == INTEGER) || (theToken->type == FLOAT) || #if DEFGLOBAL_CONSTRUCT (theToken->type == GBL_VARIABLE) || (theToken->type == MF_GBL_VARIABLE) || #endif #if OBJECT_SYSTEM (theToken->type == INSTANCE_NAME) || #endif (theToken->type == SF_VARIABLE) || (theToken->type == MF_VARIABLE)) { nextOne = GenConstant(theEnv,theToken->type,theToken->value); } /*=============================*/ /* Otherwise parse a function. */ /*=============================*/ else if (theToken->type == LPAREN) { nextOne = Function1Parse(theEnv,logicalName); } /*======================================*/ /* Otherwise replace sequence expansion */ /* variables and return the expression. */ /*======================================*/ else { if (ReplaceSequenceExpansionOps(theEnv,top,NULL, FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } return(top); } /*===========================*/ /* Add the new action to the */ /* list of progn arguments. */ /*===========================*/ if (nextOne == NULL) { theToken->type = UNKNOWN_VALUE; ReturnExpression(theEnv,top); return(NULL); } if (lastOne == NULL) { top->argList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; PPCRAndIndent(theEnv); } } #endif /* (! RUN_TIME) */ /********************************************************/ /* EnvSetSequenceOperatorRecognition: C access routine */ /* for the set-sequence-operator-recognition function */ /********************************************************/ globle intBool EnvSetSequenceOperatorRecognition( void *theEnv, int value) { int ov; ov = ExpressionData(theEnv)->SequenceOpMode; ExpressionData(theEnv)->SequenceOpMode = value; return(ov); } /********************************************************/ /* EnvSetSequenceOperatorRecognition: C access routine */ /* for the Get-sequence-operator-recognition function */ /********************************************************/ globle intBool EnvGetSequenceOperatorRecognition( void *theEnv) { return(ExpressionData(theEnv)->SequenceOpMode); } /*******************************************/ /* ParseConstantArguments: Parses a string */ /* into a set of constant expressions. */ /*******************************************/ globle EXPRESSION *ParseConstantArguments( void *theEnv, char *argstr, int *error) { EXPRESSION *top = NULL,*bot = NULL,*tmp; char *router = "***FNXARGS***"; struct token tkn; *error = FALSE; if (argstr == NULL) return(NULL); /*=====================================*/ /* Open the string as an input source. */ /*=====================================*/ if (OpenStringSource(theEnv,router,argstr,0) == 0) { PrintErrorID(theEnv,"EXPRNPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot read arguments for external call.\n"); *error = TRUE; return(NULL); } /*======================*/ /* Parse the constants. */ /*======================*/ GetToken(theEnv,router,&tkn); while (tkn.type != STOP) { if ((tkn.type != SYMBOL) && (tkn.type != STRING) && (tkn.type != FLOAT) && (tkn.type != INTEGER) && (tkn.type != INSTANCE_NAME)) { PrintErrorID(theEnv,"EXPRNPSR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Only constant arguments allowed for external function call.\n"); ReturnExpression(theEnv,top); *error = TRUE; CloseStringSource(theEnv,router); return(NULL); } tmp = GenConstant(theEnv,tkn.type,tkn.value); if (top == NULL) top = tmp; else bot->nextArg = tmp; bot = tmp; GetToken(theEnv,router,&tkn); } /*================================*/ /* Close the string input source. */ /*================================*/ CloseStringSource(theEnv,router); /*=======================*/ /* Return the arguments. */ /*=======================*/ return(top); } /*********************************************/ /* RemoveUnneededProgn: */ /*********************************************/ globle struct expr *RemoveUnneededProgn( void *theEnv, struct expr *theExpression) { struct FunctionDefinition *fptr; struct expr *temp; if (theExpression == NULL) return(theExpression); if (theExpression->type != FCALL) return(theExpression); fptr = (struct FunctionDefinition *) theExpression->value; if (fptr->functionPointer != PTIF PrognFunction) { return(theExpression); } if ((theExpression->argList != NULL) && (theExpression->argList->nextArg == NULL)) { temp = theExpression; theExpression = theExpression->argList; temp->argList = NULL; temp->nextArg = NULL; ReturnExpression(theEnv,temp); } return(theExpression); } clips-6.24/clipssrc/rulebld.c0000755000175000017500000005533310441602323014333 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* RULE BUILD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines to ntegrates a set of pattern */ /* and join tests associated with a rule into the pattern */ /* and join networks. The joins are integrated into the */ /* join network by routines in this module. The pattern */ /* is integrated by calling the external routine */ /* associated with the pattern parser that originally */ /* parsed the pattern. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /*************************************************************/ #define _RULEBLD_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "envrnmnt.h" #include "constrct.h" #include "drive.h" #include "incrrset.h" #include "memalloc.h" #include "pattern.h" #include "reteutil.h" #include "router.h" #include "rulebld.h" #include "watch.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct joinNode *FindShareableJoin(struct joinNode *,void *,unsigned,unsigned,int, struct expr *, int,int,int,struct joinNode **); static int TestJoinForReuse(struct joinNode *,unsigned,unsigned,int, struct expr *, int,int,int,struct joinNode **); static struct joinNode *CreateNewJoin(void *,struct expr *, struct joinNode *,void *,int,int); static void AttachTestCEsToPatternCEs(void *,struct lhsParseNode *); /****************************************************************/ /* ConstructJoins: Integrates a set of pattern and join tests */ /* associated with a rule into the pattern and join networks. */ /****************************************************************/ globle struct joinNode *ConstructJoins( void *theEnv, int logicalJoin, struct lhsParseNode *theLHS) { struct joinNode *lastJoin = NULL; struct patternNodeHeader *lastPattern; unsigned firstJoin = TRUE; int tryToReuse = TRUE; struct joinNode *listOfJoins; struct joinNode *oldJoin; int joinNumber = 1; int isLogical; struct joinNode *nandReconnect[32]; int currentDepth = 1; int lastIteration = FALSE; int rhsType; int endDepth; /*===================================================*/ /* Remove any test CEs from the LHS and attach their */ /* expression to the closest preceeding non-negated */ /* join at the same not/and depth. */ /*===================================================*/ AttachTestCEsToPatternCEs(theEnv,theLHS); /*=====================================================*/ /* Process each pattern CE in the rule. At this point, */ /* there should be no and/or/not/test CEs in the LHS. */ /*=====================================================*/ while (theLHS != NULL) { if (theLHS->bottom == NULL) lastIteration = TRUE; /*==================================================*/ /* If the pattern is the start of a new not/and CE, */ /* then remember the join to reconnect to after the */ /* join from the right is completed. */ /*==================================================*/ while (theLHS->beginNandDepth > currentDepth) { nandReconnect[currentDepth-1] = lastJoin; currentDepth++; } /*============================================================*/ /* Add the next pattern for this rule to the pattern network. */ /*============================================================*/ rhsType = theLHS->patternType->positionInArray; lastPattern = (*theLHS->patternType->addPatternFunction)(theEnv,theLHS); /*======================================================*/ /* Determine if the join being added is a logical join. */ /*======================================================*/ if (joinNumber == logicalJoin) isLogical = TRUE; else isLogical = FALSE; /*===============================================*/ /* Get the list of joins which could potentially */ /* be reused in place of the join being added. */ /*===============================================*/ if (firstJoin == TRUE) { listOfJoins = lastPattern->entryJoin; } else { listOfJoins = lastJoin->nextLevel; } /*=======================================================*/ /* Determine if the next join to be added can be shared. */ /*=======================================================*/ endDepth = theLHS->endNandDepth; if ((tryToReuse == TRUE) && ((oldJoin = FindShareableJoin(listOfJoins,(void *) lastPattern,firstJoin, theLHS->negated,isLogical, theLHS->networkTest, endDepth,currentDepth, lastIteration,nandReconnect)) != NULL) ) { #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv)) { EnvPrintRouter(theEnv,WDIALOG,"=j"); } #endif lastJoin = oldJoin; } else { tryToReuse = FALSE; lastJoin = CreateNewJoin(theEnv,theLHS->networkTest, lastJoin,lastPattern, FALSE,(int) theLHS->negated); lastJoin->rhsType = rhsType; } /*==========================================================*/ /* Create any joins from the right needed to handle not/and */ /* CE combinations and connect them to the join network. */ /*==========================================================*/ while (endDepth < currentDepth) { currentDepth--; if (lastJoin->nextLevel == NULL) tryToReuse = FALSE; if (tryToReuse) { #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv)) { EnvPrintRouter(theEnv,WDIALOG,"=j"); } #endif lastJoin = lastJoin->nextLevel; } else { lastJoin = CreateNewJoin(theEnv,NULL,nandReconnect[currentDepth-1], lastJoin,TRUE,FALSE); } } /*=======================================*/ /* Move on to the next join to be added. */ /*=======================================*/ theLHS = theLHS->bottom; joinNumber++; firstJoin = FALSE; } /*===================================================*/ /* If compilations are being watched, put a carriage */ /* return after all of the =j's and +j's */ /*===================================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv)) { EnvPrintRouter(theEnv,WDIALOG,"\n"); } #endif /*=============================*/ /* Return the last join added. */ /*=============================*/ return(lastJoin); } /****************************************************************/ /* AttachTestCEsToPatternCEs: Attaches the expressions found in */ /* test CEs to the closest preceeding pattern CE that is not */ /* negated and is at the same not/and depth. */ /****************************************************************/ static void AttachTestCEsToPatternCEs( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *lastNode = NULL, *trackNode, *tempNode; /*===============================================*/ /* Look at each pattern on the rule's LHS to see */ /* if any test CEs should be attached to it. */ /*===============================================*/ while (theLHS != NULL) { /*==============================================*/ /* If the pattern is negated, then don't bother */ /* looking for any test CEs to attach to it. */ /*==============================================*/ if (theLHS->negated) { trackNode = NULL; } else { lastNode = theLHS; trackNode = theLHS->bottom; } /*=================================================*/ /* Check all of the patterns following the current */ /* pattern to check for test CEs which can be */ /* attached to the current pattern. */ /*=================================================*/ while (trackNode != NULL) { /*=======================================================*/ /* Skip over any CEs that have a higher not/and depth or */ /* are negated since any test CEs found within these CEs */ /* would be attached to another pattern with the same */ /* depth, rather than the current pattern. */ /*=======================================================*/ if ((trackNode->beginNandDepth != theLHS->beginNandDepth) || (trackNode->negated)) { lastNode = trackNode; trackNode = trackNode->bottom; } /*======================================================*/ /* Once a non-negated pattern has been encounted at the */ /* same not/and depth as the current pattern, then stop */ /* because any test CEs following this pattern would be */ /* attached to it rather than the current pattern. */ /*======================================================*/ else if (trackNode->type == PATTERN_CE) { trackNode = NULL; } /*==================================================*/ /* A test CE encountered at the same not/and depth */ /* can be added to the network test expressions for */ /* the currentpattern. */ /*==================================================*/ else if (trackNode->type == TEST_CE) { theLHS->networkTest = CombineExpressions(theEnv,theLHS->networkTest, trackNode->networkTest); trackNode->networkTest = NULL; tempNode = trackNode->bottom; trackNode->bottom = NULL; lastNode->bottom = tempNode; lastNode->endNandDepth = trackNode->endNandDepth; ReturnLHSParseNodes(theEnv,trackNode); trackNode = tempNode; } /*================================================*/ /* If none of the previous conditions have been */ /* met, then there is an internal error. */ /*================================================*/ else { SystemError(theEnv,"BUILD",1); EnvExitRouter(theEnv,EXIT_FAILURE); } } /*====================================*/ /* Check the next pattern in the LHS. */ /*====================================*/ theLHS = theLHS->bottom; } } /********************************************************************/ /* FindShareableJoin: Determines whether a join exists that can be */ /* reused for the join currently being added to the join network. */ /* Returns a pointer to the join to be shared if one if found, */ /* otherwise returns a NULL pointer. */ /********************************************************************/ static struct joinNode *FindShareableJoin( struct joinNode *listOfJoins, void *rhsStruct, unsigned int firstJoin, unsigned int negatedRHS, int isLogical, struct expr *joinTest, int endDepth, int currentDepth, int lastIteration, struct joinNode **nandReconnect) { /*========================================*/ /* Loop through all of the joins in the */ /* list of potential candiates for reuse. */ /*========================================*/ while (listOfJoins != NULL) { /*=========================================================*/ /* If the join being tested for reuse is connected on the */ /* RHS to the end node of the pattern node associated with */ /* the join to be added, then determine if the join can */ /* be reused. If so, return the join. */ /*=========================================================*/ if (listOfJoins->rightSideEntryStructure == rhsStruct) { if (TestJoinForReuse(listOfJoins,firstJoin,negatedRHS,isLogical, joinTest,endDepth,currentDepth, lastIteration,nandReconnect)) { return(listOfJoins); } } /*====================================================*/ /* Move on to the next potential candidate. Note that */ /* the rightMatchNode link is used for traversing */ /* through the candidates for the first join of a */ /* rule and that rightDriveNode link is used for */ /* traversing through the candidates for subsequent */ /* joins of a rule. */ /*====================================================*/ if (firstJoin) { listOfJoins = listOfJoins->rightMatchNode; } else { listOfJoins = listOfJoins->rightDriveNode; } } /*================================*/ /* Return a NULL pointer, since a */ /* reusable join was not found. */ /*================================*/ return(NULL); } /**************************************************************/ /* TestJoinForReuse: Determines if the specified join can be */ /* shared with a join being added for a rule being defined. */ /* Returns TRUE if the join can be shared, otherwise FALSE. */ /**************************************************************/ static int TestJoinForReuse( struct joinNode *testJoin, unsigned firstJoin, unsigned negatedRHS, int isLogical, struct expr *joinTest, int endDepth, int currentDepth, int lastIteration, struct joinNode **nandReconnect) { /*==================================================*/ /* The first join of a rule may only be shared with */ /* a join that has its firstJoin field set to TRUE. */ /*==================================================*/ if (testJoin->firstJoin != firstJoin) return(FALSE); /*========================================================*/ /* A join connected to a not CE may only be shared with a */ /* join that has its patternIsNegated field set to TRUE. */ /*========================================================*/ if (testJoin->patternIsNegated != negatedRHS) return(FALSE); /*==========================================================*/ /* If the join added is associated with a logical CE, then */ /* either the join to be shared must be associated with a */ /* logical CE or the beta memory must be empty (since */ /* joins associate an extra field with each partial match). */ /*==========================================================*/ if ((isLogical == TRUE) && (testJoin->logicalJoin == FALSE) && (testJoin->beta != NULL)) { return(FALSE); } /*===============================================================*/ /* The expression associated with the join must be identical to */ /* the networkTest expression stored with the join to be shared. */ /*===============================================================*/ if (IdenticalExpression(testJoin->networkTest,joinTest) != TRUE) { return(FALSE); } /*==============================================================*/ /* If the join being added enters another join from the right, */ /* then the series of "joins from the right" for the join being */ /* added must match the series of "joins from the right" for */ /* the join being tested for reuse (i.e. the LHS connections */ /* from other joins must be identical for each of the joins in */ /* the series of "joins from the right." */ /*==============================================================*/ for (; endDepth < currentDepth; currentDepth--) { testJoin = testJoin->nextLevel; if (testJoin == NULL) return(FALSE); if (testJoin->joinFromTheRight == FALSE) { return(FALSE); } else if (nandReconnect[currentDepth-2] != testJoin->lastLevel) { return(FALSE); } } /*=============================================================*/ /* The last join of a rule cannot be shared with the last join */ /* of another rule. A join cannot be used as the last join of */ /* a rule if it already has partial matches in its beta memory */ /* (because of the extra slot used to point at activations). */ /*=============================================================*/ if (lastIteration) { if (testJoin->ruleToActivate != NULL) return(FALSE); if (testJoin->beta != NULL) return(FALSE); } /*===========================================================================*/ /* A join cannot be shared if it is not the last join for a rule and shares */ /* part, but not all, of a series of joins connected to other joins from the */ /* right. This is because the data structure for joins can only point to */ /* either a single join that is entered from the right or a series of joins */ /* that are entered from the left, but not both. (The last join of a rule */ /* does not require any links to other joins so it can be shared). */ /*===========================================================================*/ if ((! lastIteration) && (testJoin->nextLevel != NULL)) { if (testJoin->nextLevel->joinFromTheRight == TRUE) { if (((struct joinNode *) testJoin->nextLevel->rightSideEntryStructure) == testJoin) { return(FALSE); } } } /*=============================================*/ /* The join can be shared since all conditions */ /* for sharing have been satisfied. */ /*=============================================*/ return(TRUE); } /*************************************************************************/ /* CreateNewJoin: Creates a new join and links it into the join network. */ /*************************************************************************/ static struct joinNode *CreateNewJoin( void *theEnv, struct expr *joinTest, struct joinNode *lhsEntryStruct, void *rhsEntryStruct, int joinFromTheRight, int negatedRHSPattern) { struct joinNode *newJoin; /*===============================================*/ /* 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,"compilations") == TRUE) && GetPrintWhileLoading(theEnv)) { EnvPrintRouter(theEnv,WDIALOG,"+j"); } #endif /*========================================================*/ /* Create the new join and initialize some of its values. */ /*========================================================*/ newJoin = get_struct(theEnv,joinNode); newJoin->beta = NULL; newJoin->nextLevel = NULL; newJoin->joinFromTheRight = joinFromTheRight; newJoin->patternIsNegated = negatedRHSPattern; newJoin->initialize = EnvGetIncrementalReset(theEnv); newJoin->logicalJoin = FALSE; newJoin->ruleToActivate = NULL; /*==============================================*/ /* Install the expressions used to determine */ /* if a partial match satisfies the constraints */ /* associated with this join. */ /*==============================================*/ newJoin->networkTest = AddHashedExpression(theEnv,joinTest); /*============================================================*/ /* Initialize the values associated with the LHS of the join. */ /*============================================================*/ newJoin->lastLevel = lhsEntryStruct; if (lhsEntryStruct == NULL) { newJoin->firstJoin = TRUE; newJoin->depth = 1; newJoin->rightDriveNode = NULL; } else { newJoin->firstJoin = FALSE; newJoin->depth = lhsEntryStruct->depth; newJoin->depth++; /* To work around Sparcworks C compiler bug */ newJoin->rightDriveNode = lhsEntryStruct->nextLevel; lhsEntryStruct->nextLevel = newJoin; } /*=======================================================*/ /* 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 (joinFromTheRight) { newJoin->rightMatchNode = NULL; ((struct joinNode *) rhsEntryStruct)->nextLevel = newJoin; } else { newJoin->rightMatchNode = ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin; ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin = newJoin; } /*================================*/ /* Return the newly created join. */ /*================================*/ return(newJoin); } #endif clips-6.24/clipssrc/.DS_Store0000644000175000017500000006000410444326120014206 0ustar jfsjfsBud1%  @ @ @ @ E%DSDB` @ @ @ef.hIlocblob tmpltfun.cIlocblob tmpltfun.hIlocblob tmpltlhs.cIlocblob tmpltlhs.hIlocblob tmpltpsr.cIlocblob tmpltpsr.hIlocblob tmpltrhs.cIlocblob tmpltrhs.hIlocblob tmpltutl.cIlocblob tmpltutl.hIlocblob userdata.cIlocblob userdata.hIlocblob usrsetup.hIlocblob utility.cIlocblob utility.hIlocblobwatch.cIlocblobwatch.hIlocblobOagenda.cIlocblobagenda.hIlocblob analysis.cIlocblob analysis.hIlocblob argacces.cIlocblob argacces.hIlocblobbload.cIlocblobbload.hIlocblob bmathfun.cIlocblob bmathfun.hIlocblobbsave.cIlocblobbsave.hIlocblob classcom.cIlocblob classcom.hIlocblob classexm.cIlocblob classexm.hIlocblob classfun.cIlocblob classfun.hIlocblob) classinf.cIlocblob classinf.hIlocblob; classini.cIlocblob classini.hIlocblobM classpsr.cIlocblob classpsr.hIlocblob_clips.hIlocblobq clsltpsr.cIlocblob clsltpsr.hIlocblob cmptblty.hIlocblob commline.cIlocblob commline.hIlocblob conscomp.cIlocblob conscomp.hIlocblob constant.hIlocblob constrct.cIlocblob constrct.hIlocblob constrnt.cIlocblob constrnt.hIlocblob crstrtgy.cIlocblob crstrtgy.hIlocblob cstrcbin.cIlocblob cstrcbin.hIlocblob cstrccmp.hIlocblob cstrccom.cIlocblob cstrccom.hIlocblob cstrcpsr.cIlocblob cstrcpsr.hIlocblob cstrnbin.cIlocblob cstrnbin.hIlocblob cstrnchk.cIlocblob cstrnchk.hIlocblob cstrncmp.cIlocblob cstrncmp.hIlocblob cstrnops.cIlocblob cstrnops.hIlocblob cstrnpsr.cIlocblob cstrnpsr.hIlocblob cstrnutl.cIlocblob cstrnutl.hIlocblob default.cIlocblob default.hIlocblobdefins.cIlocblobdefins.hIlocblob developr.cIlocblob developr.hIlocblob dffctbin.cIlocblob dffctbin.hIlocblob dffctbsc.cIlocblob dffctbsc.hIlocblob dffctcmp.cIlocblob dffctcmp.hIlocblob dffctdef.cIlocblob dffctdef.hIlocblob dffctpsr.cIlocblob dffctpsr.hIlocblob dffnxbin.cIlocblob dffnxbin.hIlocblob dffnxcmp.cIlocblob dffnxcmp.hIlocblob dffnxexe.cIlocblobP dffnxfun.cIlocblob dffnxfun.hIlocblob dffnxpsr.cIlocblob dffnxpsr.hIlocblob dfinsbin.cIlocblob dfinsbin.hIlocblob dfinscmp.cIlocblob dfinscmp.hIlocblobdrive.cIlocblobdrive.hIlocblobed.hIlocblob edbasic.cIlocblobedmain.cIlocblobedmisc.cIlocblob edstruct.cIlocblobedterm.cIlocblob emathfun.cIlocblob emathfun.hIlocblobengine.cIlocblobengine.hIlocblob envrnmnt.cIlocblob envrnmnt.hIlocblob evaluatn.cIlocblob evaluatn.hIlocblob expressn.cIlocblob expressn.hIlocblob exprnbin.cIlocblob exprnbin.hIlocblob exprnops.cIlocblob exprnops.hIlocblob exprnpsr.cIlocblob exprnpsr.hIlocblob extnfunc.cIlocblob extnfunc.hIlocblob factbin.cIlocblob factbin.hIlocblob factbld.cIlocblob factbld.hIlocblob factcmp.cIlocblob factcmp.hIlocblob factcom.cIlocblob factcom.hIlocblob factfun.cIlocblob factfun.hIlocblob factgen.cIlocblob factgen.hIlocblob facthsh.cIlocblob facthsh.hIlocblob factlhs.cIlocblob factlhs.hIlocblob factmch.cIlocblob factmch.hIlocblob factmngr.cIlocblob factmngr.hIlocblob factprt.cIlocblob factprt.hIlocblob factqpsr.cIlocblob factqpsr.hIlocblob factqury.cIlocblob factqury.hIlocblob factrete.cIlocblob factrete.hIlocblob factrhs.cIlocblob factrhs.hIlocblob filecom.cIlocblob filecom.hIlocblob filertr.cIlocblob filertr.hIlocblob generate.cIlocblob generate.hIlocblob genrcbin.cIlocblob genrcbin.hIlocblob genrccmp.cIlocblob genrccmp.hIlocblob genrccom.cIlocblob genrccom.hIlocblob genrcexe.cIlocblob genrcexe.hIlocblob genrcfun.cIlocblob genrcfun.hIlocblobP genrcpsr.hIlocblob globlbin.cIlocblob globlbin.hIlocblob globlbsc.cIlocblob globlbsc.hIlocblob globlcmp.cIlocblob globlcmp.hIlocblob globlcom.cIlocblob globlcom.hIlocblob globldef.cIlocblob globldef.hIlocblob globlpsr.cIlocblob globlpsr.hIlocblob immthpsr.cIlocblob immthpsr.hIlocblob incrrset.cIlocblob incrrset.hIlocblob inherpsr.cIlocblob inherpsr.hIlocblobinscom.cIlocblobinscom.hIlocblob insfile.cIlocblob insfile.hIlocblobinsfun.cIlocblobinsfun.hIlocblob insmngr.cIlocblob insmngr.hIlocblob insmoddp.cIlocblob insmoddp.hIlocblob insmult.cIlocblob insmult.hIlocblobinspsr.cIlocblobinspsr.hIlocblob insquery.cIlocblob insquery.hIlocblob insqypsr.cIlocblob insqypsr.hIlocblobiofun.cIlocblobiofun.hIlocblob lgcldpnd.cIlocblob lgcldpnd.hIlocblobmain.cIlocblobmatch.hIlocblob memalloc.cIlocblob memalloc.hIlocblob miscfun.cIlocblob miscfun.hIlocblob modulbin.cIlocblob modulbin.hIlocblob modulbsc.cIlocblob modulbsc.hIlocblob modulcmp.cIlocblob modulcmp.hIlocblob moduldef.cIlocblob moduldef.hIlocblob modulpsr.cIlocblob modulpsr.hIlocblob modulutl.cIlocblob modulutl.hIlocblobmsgcom.cIlocblobmsgcom.hIlocblobmsgfun.cIlocblobmsgfun.hIlocblob msgpass.cIlocblob msgpass.hIlocblobmsgpsr.cIlocblobmsgpsr.hIlocblob multifld.cIlocblob multifld.hIlocblob multifun.cIlocblob multifun.hIlocblob network.hIlocblobobjbin.cIlocblobobjbin.hIlocblobobjcmp.cIlocblobobjcmp.hIlocblobobject.hIlocblob objrtbin.cIlocblob objrtbin.hIlocblob objrtbld.cIlocblob( objrtcmp.cIlocblob objrtcmp.hIlocblob objrtfnx.cIlocblob objrtfnx.hIlocblob objrtgen.cIlocblob objrtgen.hIlocblob objrtmch.cIlocblob objrtmch.hIlocblob parsefun.cIlocblob parsefun.hIlocblob pattern.cIlocblob pattern.hIlocblobpprint.cIlocblobpprint.hIlocblob prccode.cIlocblob prccode.hIlocblob prcdrfun.cIlocblob prcdrfun.hIlocblob prcdrpsr.cIlocblob prcdrpsr.hIlocblob prdctfun.cIlocblob prdctfun.hIlocblob prntutil.cIlocblob prntutil.hIlocblob proflfun.cIlocblob proflfun.hIlocblob reorder.cIlocblob reorder.hIlocblob reteutil.cIlocblob reteutil.hIlocblob retract.cIlocblob retract.hIlocblobrouter.cIlocblobrouter.hIlocblob rulebin.cIlocblob rulebin.hIlocblob rulebld.cIlocblob rulebld.hIlocblob rulebsc.cIlocblob rulebsc.hIlocbloblgX E  0 @ P DSDB `` @ @locblob proflfun.hIlocblob reorder.cIlocblob reorder.hIlocblob reteutil.cIlocblob reteutil.hIlocblob retract.cIlocblob retract.hIlocblobrouter.cIlocblobrouter.hIlocblob rulebin.cIlocblob rulebin.hIlocblob rulebld.cIlocblob rulebld.hIlocblob rulebsc.cIlocblob rulebsc.hIlocbloblgclips-6.24/clipssrc/._rulecom.h0000400000175000017500000000075410441163734014562 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z!" TTF/BFMPSRMWBBLclips-6.24/clipssrc/classpsr.h0000755000175000017500000000256707422634560014557 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_classpsr #define _H_classpsr #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDefclass(void *,char *); #endif #endif clips-6.24/clipssrc/cstrnchk.h0000755000175000017500000000654510441602117014530 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT CHECKING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for constraint checking of */ /* data types. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_cstrnchk #define _H_cstrnchk #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNCHK_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define NO_VIOLATION 0 #define TYPE_VIOLATION 1 #define RANGE_VIOLATION 2 #define ALLOWED_VALUES_VIOLATION 3 #define FUNCTION_RETURN_TYPE_VIOLATION 4 #define CARDINALITY_VIOLATION 5 #define ALLOWED_CLASSES_VIOLATION 6 LOCALE intBool CheckCardinalityConstraint(void *,long,CONSTRAINT_RECORD *); LOCALE intBool CheckAllowedValuesConstraint(int,void *,CONSTRAINT_RECORD *); LOCALE intBool CheckAllowedClassesConstraint(void *,int,void *,CONSTRAINT_RECORD *); LOCALE int ConstraintCheckExpressionChain(void *,struct expr *, CONSTRAINT_RECORD *); LOCALE void ConstraintViolationErrorMessage(void *,char *,char *,int,int, struct symbolHashNode *, int,int,CONSTRAINT_RECORD *, int); LOCALE int ConstraintCheckValue(void *,int,void *,CONSTRAINT_RECORD *); LOCALE int ConstraintCheckDataObject(void *,DATA_OBJECT *,CONSTRAINT_RECORD *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int ConstraintCheckExpression(void *,struct expr *, CONSTRAINT_RECORD *); #endif #if (! RUN_TIME) LOCALE intBool UnmatchableConstraint(struct constraintRecord *); #endif #endif clips-6.24/clipssrc/facthsh.c0000755000175000017500000002015010441143344014312 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* FACT HASHING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for maintaining a fact hash */ /* table so that duplication of facts can quickly be */ /* determined. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _FACTHSH_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include "constant.h" #include "memalloc.h" #include "router.h" #include "envrnmnt.h" #if DEFRULE_CONSTRUCT #include "lgcldpnd.h" #endif #include "facthsh.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct fact *FactExists(void *,struct fact *,int); /************************************************/ /* HashFact: Returns the hash value for a fact. */ /************************************************/ int HashFact( struct fact *theFact) { int count = 0; int hashValue; /*============================================*/ /* Get a hash value for the deftemplate name. */ /*============================================*/ count += (int) HashSymbol(ValueToString(theFact->whichDeftemplate->header.name), SIZE_FACT_HASH); /*=================================================*/ /* Add in the hash value for the rest of the fact. */ /*=================================================*/ count += (int) HashMultifield(&theFact->theProposition,SIZE_FACT_HASH); /*================================*/ /* Make sure the hash value falls */ /* in the appropriate range. */ /*================================*/ hashValue = (int) (count % SIZE_FACT_HASH); if (hashValue < 0) hashValue = - hashValue; /*========================*/ /* Return the hash value. */ /*========================*/ return(hashValue); } /**********************************************/ /* FactExists: Determines if a specified fact */ /* already exists in the fact hash table. */ /**********************************************/ static struct fact *FactExists( void *theEnv, struct fact *theFact, int hashValue) { struct factHashEntry *theFactHash; for (theFactHash = FactData(theEnv)->FactHashTable[hashValue]; theFactHash != NULL; theFactHash = theFactHash->next) { if ((theFact->whichDeftemplate == theFactHash->theFact->whichDeftemplate) ? MultifieldsEqual(&theFact->theProposition, &theFactHash->theFact->theProposition) : FALSE) { return(theFactHash->theFact); } } return(NULL); } /************************************************************/ /* AddHashedFact: Adds a fact entry to the fact hash table. */ /************************************************************/ globle void AddHashedFact( void *theEnv, struct fact *theFact, int hashValue) { struct factHashEntry *newhash, *temp; newhash = get_struct(theEnv,factHashEntry); newhash->theFact = theFact; temp = FactData(theEnv)->FactHashTable[hashValue]; FactData(theEnv)->FactHashTable[hashValue] = newhash; newhash->next = temp; } /******************************************/ /* RemoveHashedFact: Removes a fact entry */ /* from the fact hash table. */ /******************************************/ globle intBool RemoveHashedFact( void *theEnv, struct fact *theFact) { int hashValue; struct factHashEntry *hptr, *prev; hashValue = HashFact(theFact); for (hptr = FactData(theEnv)->FactHashTable[hashValue], prev = NULL; hptr != NULL; hptr = hptr->next) { if (hptr->theFact == theFact) { if (prev == NULL) { FactData(theEnv)->FactHashTable[hashValue] = hptr->next; rtn_struct(theEnv,factHashEntry,hptr); return(1); } else { prev->next = hptr->next; rtn_struct(theEnv,factHashEntry,hptr); return(1); } } prev = hptr; } return(0); } /*****************************************************/ /* HandleFactDuplication: Determines if a fact to be */ /* added to the fact-list is a duplicate entry and */ /* takes appropriate action based on the current */ /* setting of the fact-duplication flag. */ /*****************************************************/ globle int HandleFactDuplication( void *theEnv, void *theFact) { struct fact *tempPtr; int hashValue; hashValue = HashFact((struct fact *) theFact); if (FactData(theEnv)->FactDuplication) return(hashValue); tempPtr = FactExists(theEnv,(struct fact *) theFact,hashValue); if (tempPtr == NULL) return(hashValue); ReturnFact(theEnv,(struct fact *) theFact); #if DEFRULE_CONSTRUCT AddLogicalDependencies(theEnv,(struct patternEntity *) tempPtr,TRUE); #endif return(-1); } /*******************************************/ /* EnvGetFactDuplication: C access routine */ /* for the get-fact-duplication command. */ /*******************************************/ globle intBool EnvGetFactDuplication( void *theEnv) { return(FactData(theEnv)->FactDuplication); } /*******************************************/ /* EnvSetFactDuplication: C access routine */ /* for the set-fact-duplication command. */ /*******************************************/ globle intBool EnvSetFactDuplication( void *theEnv, int value) { int ov; ov = FactData(theEnv)->FactDuplication; FactData(theEnv)->FactDuplication = value; return(ov); } /**************************************************/ /* InitializeFactHashTable: Initializes the table */ /* entries in the fact hash table to NULL. */ /**************************************************/ globle void InitializeFactHashTable( void *theEnv) { int i; FactData(theEnv)->FactHashTable = (struct factHashEntry **) gm3(theEnv,sizeof (struct factHashEntry *) * SIZE_FACT_HASH); if (FactData(theEnv)->FactHashTable == NULL) EnvExitRouter(theEnv,EXIT_FAILURE); for (i = 0; i < SIZE_FACT_HASH; i++) FactData(theEnv)->FactHashTable[i] = NULL; } #if DEVELOPER /*****************************************************/ /* ShowFactHashTable: Displays the number of entries */ /* in each slot of the fact hash table. */ /*****************************************************/ globle void ShowFactHashTable( void *theEnv) { int i, count; struct factHashEntry *theEntry; char buffer[20]; for (i = 0; i < SIZE_FACT_HASH; i++) { for (theEntry = FactData(theEnv)->FactHashTable[i], count = 0; theEntry != NULL; theEntry = theEntry->next) { count++; } if (count != 0) { sprintf(buffer,"%4d: %4d\n",i,count); EnvPrintRouter(theEnv,WDISPLAY,buffer); } } } #endif /* DEVELOPER */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/cstrnbin.c0000755000175000017500000002673010253662516014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT BLOAD/BSAVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for */ /* constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.24: Added allowed-classes slot facet. */ /* */ /*************************************************************/ #define _CSTRNBIN_SOURCE_ #include "setup.h" #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "bload.h" #if BLOAD_AND_BSAVE #include "bsave.h" #endif #include "cstrnbin.h" /*******************/ /* DATA STRUCTURES */ /*******************/ struct bsaveConstraintRecord { unsigned int anyAllowed : 1; unsigned int symbolsAllowed : 1; unsigned int stringsAllowed : 1; unsigned int floatsAllowed : 1; unsigned int integersAllowed : 1; unsigned int instanceNamesAllowed : 1; unsigned int instanceAddressesAllowed : 1; unsigned int externalAddressesAllowed : 1; unsigned int factAddressesAllowed : 1; unsigned int anyRestriction : 1; unsigned int symbolRestriction : 1; unsigned int stringRestriction : 1; unsigned int numberRestriction : 1; unsigned int floatRestriction : 1; unsigned int integerRestriction : 1; unsigned int classRestriction : 1; unsigned int instanceNameRestriction : 1; unsigned int multifieldsAllowed : 1; unsigned int singlefieldsAllowed : 1; long classList; long restrictionList; long minValue; long maxValue; long minFields; long maxFields; }; typedef struct bsaveConstraintRecord BSAVE_CONSTRAINT_RECORD; /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void CopyToBsaveConstraintRecord(void *,CONSTRAINT_RECORD *,BSAVE_CONSTRAINT_RECORD *); #endif static void CopyFromBsaveConstraintRecord(void *,void *,long); #if BLOAD_AND_BSAVE /**************************************************/ /* WriteNeededConstraints: Writes the constraints */ /* in the constraint table to the binary image */ /* currently being saved. */ /**************************************************/ globle void WriteNeededConstraints( void *theEnv, FILE *fp) { int i; unsigned short theIndex = 0; unsigned long int numberOfUsedConstraints = 0; CONSTRAINT_RECORD *tmpPtr; BSAVE_CONSTRAINT_RECORD bsaveConstraints; /*================================*/ /* Get the number of constraints. */ /*================================*/ for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) { for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { tmpPtr->bsaveIndex = theIndex++; numberOfUsedConstraints++; } } /*=============================================*/ /* If dynamic constraint checking is disabled, */ /* then no constraints are saved. */ /*=============================================*/ if ((! EnvGetDynamicConstraintChecking(theEnv)) && (numberOfUsedConstraints != 0)) { numberOfUsedConstraints = 0; PrintWarningID(theEnv,"CSTRNBIN",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Constraints are not saved with a binary image\n"); EnvPrintRouter(theEnv,WWARNING," when dynamic constraint checking is disabled.\n"); } /*============================================*/ /* Write out the number of constraints in the */ /* constraint table followed by each of the */ /* constraints in the constraint table. */ /*============================================*/ GenWrite(&numberOfUsedConstraints,(unsigned long) sizeof(unsigned long int),fp); if (numberOfUsedConstraints == 0) return; for (i = 0 ; i < SIZE_CONSTRAINT_HASH; i++) { for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { CopyToBsaveConstraintRecord(theEnv,tmpPtr,&bsaveConstraints); GenWrite(&bsaveConstraints, (unsigned long) sizeof(BSAVE_CONSTRAINT_RECORD),fp); } } } /****************************************************/ /* CopyToBsaveConstraintRecord: Copies a constraint */ /* record to the data structure used for storing */ /* constraints in a binary image. */ /****************************************************/ static void CopyToBsaveConstraintRecord( void *theEnv, CONSTRAINT_RECORD *constraints, BSAVE_CONSTRAINT_RECORD *bsaveConstraints) { bsaveConstraints->anyAllowed = constraints->anyAllowed; bsaveConstraints->symbolsAllowed = constraints->symbolsAllowed; bsaveConstraints->stringsAllowed = constraints->stringsAllowed; bsaveConstraints->floatsAllowed = constraints->floatsAllowed; bsaveConstraints->integersAllowed = constraints->integersAllowed; bsaveConstraints->instanceNamesAllowed = constraints->instanceNamesAllowed; bsaveConstraints->instanceAddressesAllowed = constraints->instanceAddressesAllowed; bsaveConstraints->externalAddressesAllowed = constraints->externalAddressesAllowed; bsaveConstraints->multifieldsAllowed = constraints->multifieldsAllowed; bsaveConstraints->singlefieldsAllowed = constraints->singlefieldsAllowed; bsaveConstraints->factAddressesAllowed = constraints->factAddressesAllowed; bsaveConstraints->anyRestriction = constraints->anyRestriction; bsaveConstraints->symbolRestriction = constraints->symbolRestriction; bsaveConstraints->stringRestriction = constraints->stringRestriction; bsaveConstraints->floatRestriction = constraints->floatRestriction; bsaveConstraints->integerRestriction = constraints->integerRestriction; bsaveConstraints->classRestriction = constraints->classRestriction; bsaveConstraints->instanceNameRestriction = constraints->instanceNameRestriction; bsaveConstraints->restrictionList = HashedExpressionIndex(theEnv,constraints->restrictionList); bsaveConstraints->classList = HashedExpressionIndex(theEnv,constraints->classList); bsaveConstraints->minValue = HashedExpressionIndex(theEnv,constraints->minValue); bsaveConstraints->maxValue = HashedExpressionIndex(theEnv,constraints->maxValue); bsaveConstraints->minFields = HashedExpressionIndex(theEnv,constraints->minFields); bsaveConstraints->maxFields = HashedExpressionIndex(theEnv,constraints->maxFields); } #endif /* BLOAD_AND_BSAVE */ /********************************************************/ /* ReadNeededConstraints: Reads in the constraints used */ /* by the binary image currently being loaded. */ /********************************************************/ globle void ReadNeededConstraints( void *theEnv) { GenReadBinary(theEnv,(void *) &ConstraintData(theEnv)->NumberOfConstraints,(unsigned long) sizeof(unsigned long int)); if (ConstraintData(theEnv)->NumberOfConstraints == 0) return; ConstraintData(theEnv)->ConstraintArray = (CONSTRAINT_RECORD *) genlongalloc(theEnv,(unsigned long) (sizeof(CONSTRAINT_RECORD) * ConstraintData(theEnv)->NumberOfConstraints)); BloadandRefresh(theEnv,ConstraintData(theEnv)->NumberOfConstraints,sizeof(BSAVE_CONSTRAINT_RECORD), CopyFromBsaveConstraintRecord); } /*****************************************************/ /* CopyFromBsaveConstraintRecord: Copies values to a */ /* constraint record from the data structure used */ /* for storing constraints in a binary image. */ /*****************************************************/ static void CopyFromBsaveConstraintRecord( void *theEnv, void *buf, long theIndex) { BSAVE_CONSTRAINT_RECORD *bsaveConstraints; CONSTRAINT_RECORD *constraints; bsaveConstraints = (BSAVE_CONSTRAINT_RECORD *) buf; constraints = (CONSTRAINT_RECORD *) &ConstraintData(theEnv)->ConstraintArray[theIndex]; constraints->anyAllowed = bsaveConstraints->anyAllowed; constraints->symbolsAllowed = bsaveConstraints->symbolsAllowed; constraints->stringsAllowed = bsaveConstraints->stringsAllowed; constraints->floatsAllowed = bsaveConstraints->floatsAllowed; constraints->integersAllowed = bsaveConstraints->integersAllowed; constraints->instanceNamesAllowed = bsaveConstraints->instanceNamesAllowed; constraints->instanceAddressesAllowed = bsaveConstraints->instanceAddressesAllowed; constraints->externalAddressesAllowed = bsaveConstraints->externalAddressesAllowed; constraints->voidAllowed = FALSE; constraints->multifieldsAllowed = bsaveConstraints->multifieldsAllowed; constraints->singlefieldsAllowed = bsaveConstraints->singlefieldsAllowed; constraints->factAddressesAllowed = bsaveConstraints->factAddressesAllowed; constraints->anyRestriction = bsaveConstraints->anyRestriction; constraints->symbolRestriction = bsaveConstraints->symbolRestriction; constraints->stringRestriction = bsaveConstraints->stringRestriction; constraints->floatRestriction = bsaveConstraints->floatRestriction; constraints->integerRestriction = bsaveConstraints->integerRestriction; constraints->classRestriction = bsaveConstraints->classRestriction; constraints->instanceNameRestriction = bsaveConstraints->instanceNameRestriction; constraints->restrictionList = HashedExpressionPointer(bsaveConstraints->restrictionList); constraints->classList = HashedExpressionPointer(bsaveConstraints->classList); constraints->minValue = HashedExpressionPointer(bsaveConstraints->minValue); constraints->maxValue = HashedExpressionPointer(bsaveConstraints->maxValue); constraints->minFields = HashedExpressionPointer(bsaveConstraints->minFields); constraints->maxFields = HashedExpressionPointer(bsaveConstraints->maxFields); constraints->multifield = NULL; } /********************************************************/ /* ClearBloadedConstraints: Releases memory associated */ /* with constraints loaded from binary image */ /********************************************************/ globle void ClearBloadedConstraints( void *theEnv) { if (ConstraintData(theEnv)->NumberOfConstraints != 0) { genlongfree(theEnv,(void *) ConstraintData(theEnv)->ConstraintArray, (unsigned long) (sizeof(CONSTRAINT_RECORD) * ConstraintData(theEnv)->NumberOfConstraints)); ConstraintData(theEnv)->NumberOfConstraints = 0; } } #endif /* (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips-6.24/clipssrc/msgpass.c0000755000175000017500000014003110443377640014362 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* OBJECT MESSAGE DISPATCH CODE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #include #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "memalloc.h" #include "constrct.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "insfun.h" #include "msgcom.h" #include "msgfun.h" #include "multifld.h" #include "prcdrfun.h" #include "prccode.h" #include "proflfun.h" #include "router.h" #include "strngfun.h" #include "utility.h" #include "commline.h" #define _MSGPASS_SOURCE_ #include "msgpass.h" #include "inscom.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PerformMessage(void *,DATA_OBJECT *,EXPRESSION *,SYMBOL_HN *); static HANDLER_LINK *FindApplicableHandlers(void *,DEFCLASS *,SYMBOL_HN *); static void CallHandlers(void *,DATA_OBJECT *); static void EarlySlotBindError(void *,INSTANCE_TYPE *,DEFCLASS *,unsigned); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : DirectMessage DESCRIPTION : Plugs in given instance and performs specified message INPUTS : 1) Message symbolic name 2) The instance address 3) Address of DATA_OBJECT buffer (NULL if don't care) 4) Message argument expressions RETURNS : Nothing useful SIDE EFFECTS : Side effects of message execution NOTES : None *****************************************************/ globle void DirectMessage( void *theEnv, SYMBOL_HN *msg, INSTANCE_TYPE *ins, DATA_OBJECT *resultbuf, EXPRESSION *remargs) { EXPRESSION args; DATA_OBJECT temp; if (resultbuf == NULL) resultbuf = &temp; args.nextArg = remargs; args.argList = NULL; args.type = INSTANCE_ADDRESS; args.value = (void *) ins; PerformMessage(theEnv,resultbuf,&args,msg); } /*************************************************** NAME : EnvSend DESCRIPTION : C Interface for sending messages to instances INPUTS : 1) The data object of the instance 2) The message name-string 3) The message arguments string (Constants only) 4) Caller's buffer for result RETURNS : Nothing useful SIDE EFFECTS : Executes message and stores result caller's buffer NOTES : None ***************************************************/ globle void EnvSend( void *theEnv, DATA_OBJECT *idata, char *msg, char *args, DATA_OBJECT *result) { int error; EXPRESSION *iexp; SYMBOL_HN *msym; if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } SetEvaluationError(theEnv,FALSE); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); msym = FindSymbolHN(theEnv,msg); if (msym == NULL) { PrintNoHandlerError(theEnv,msg); SetEvaluationError(theEnv,TRUE); return; } iexp = GenConstant(theEnv,idata->type,idata->value); iexp->nextArg = ParseConstantArguments(theEnv,args,&error); if (error == TRUE) { ReturnExpression(theEnv,iexp); SetEvaluationError(theEnv,TRUE); return; } PerformMessage(theEnv,result,iexp,msym); ReturnExpression(theEnv,iexp); } /***************************************************** NAME : DestroyHandlerLinks DESCRIPTION : Iteratively deallocates handler-links INPUTS : The handler-link list RETURNS : Nothing useful SIDE EFFECTS : Deallocation of links NOTES : None *****************************************************/ globle void DestroyHandlerLinks( void *theEnv, HANDLER_LINK *mhead) { HANDLER_LINK *tmp; while (mhead != NULL) { tmp = mhead; mhead = mhead->nxt; tmp->hnd->busy--; DecrementDefclassBusyCount(theEnv,(void *) tmp->hnd->cls); rtn_struct(theEnv,messageHandlerLink,tmp); } } /*********************************************************************** NAME : SendCommand DESCRIPTION : Determines the applicable handler(s) and sets up the core calling frame. Then calls the core frame. INPUTS : Caller's space for storing the result of the handler(s) RETURNS : Nothing useful SIDE EFFECTS : Any side-effects caused by the execution of handlers in the core framework NOTES : H/L Syntax : (send *) ***********************************************************************/ globle void SendCommand( void *theEnv, DATA_OBJECT *result) { EXPRESSION args; SYMBOL_HN *msg; DATA_OBJECT temp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"send",2,SYMBOL,&temp) == FALSE) return; msg = (SYMBOL_HN *) temp.value; /* ============================================= Get the instance or primitive for the message ============================================= */ args.type = GetFirstArgument()->type; args.value = GetFirstArgument()->value; args.argList = GetFirstArgument()->argList; args.nextArg = GetFirstArgument()->nextArg->nextArg; PerformMessage(theEnv,result,&args,msg); } /*************************************************** NAME : GetNthMessageArgument DESCRIPTION : Returns the address of the nth (starting at 1) which is an argument of the current message dispatch INPUTS : None RETURNS : The message argument SIDE EFFECTS : None NOTES : The active instance is always stored as the first argument (0) in the call frame of the message ***************************************************/ globle DATA_OBJECT *GetNthMessageArgument( void *theEnv, int n) { return(&ProceduralPrimitiveData(theEnv)->ProcParamArray[n]); } /***************************************************** NAME : NextHandlerAvailable DESCRIPTION : Determines if there the currently executing handler can call a shadowed handler Used before calling call-next-handler INPUTS : None RETURNS : TRUE if shadow ready, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax: (next-handlerp) *****************************************************/ globle int NextHandlerAvailable( void *theEnv) { if (MessageHandlerData(theEnv)->CurrentCore == NULL) return(FALSE); if (MessageHandlerData(theEnv)->CurrentCore->hnd->type == MAROUND) return((MessageHandlerData(theEnv)->NextInCore != NULL) ? TRUE : FALSE); if ((MessageHandlerData(theEnv)->CurrentCore->hnd->type == MPRIMARY) && (MessageHandlerData(theEnv)->NextInCore != NULL)) return((MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY) ? TRUE : FALSE); return(FALSE); } /******************************************************** NAME : CallNextHandler DESCRIPTION : This function allows around-handlers to execute the rest of the core frame. It also allows primary handlers to execute shadowed primaries. The original handler arguments are left intact. INPUTS : The caller's result-value buffer RETURNS : Nothing useful SIDE EFFECTS : The core frame is called and any appropriate changes are made when used in an around handler See CallHandlers() But when call-next-handler is called from a primary, the same shadowed primary is called over and over again for repeated calls to call-next-handler. NOTES : H/L Syntax: (call-next-handler) OR (override-next-handler ...) ********************************************************/ globle void CallNextHandler( void *theEnv, DATA_OBJECT *result) { EXPRESSION args; int overridep; HANDLER_LINK *oldNext,*oldCurrent; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return; if (NextHandlerAvailable(theEnv) == FALSE) { PrintErrorID(theEnv,"MSGPASS",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Shadowed message-handlers not applicable in current context.\n"); SetEvaluationError(theEnv,TRUE); return; } if (EvaluationData(theEnv)->CurrentExpression->value == (void *) FindFunction(theEnv,"override-next-handler")) { overridep = 1; args.type = ProceduralPrimitiveData(theEnv)->ProcParamArray[0].type; if (args.type != MULTIFIELD) args.value = (void *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value; else args.value = (void *) &ProceduralPrimitiveData(theEnv)->ProcParamArray[0]; args.nextArg = GetFirstArgument(); args.argList = NULL; PushProcParameters(theEnv,&args,CountArguments(&args), ValueToString(MessageHandlerData(theEnv)->CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationData(theEnv)->EvaluationError) { ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; return; } } else overridep = 0; oldNext = MessageHandlerData(theEnv)->NextInCore; oldCurrent = MessageHandlerData(theEnv)->CurrentCore; if (MessageHandlerData(theEnv)->CurrentCore->hnd->type == MAROUND) { if (MessageHandlerData(theEnv)->NextInCore->hnd->type == MAROUND) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif } else CallHandlers(theEnv,result); } else { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif } MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; if (overridep) PopProcParameters(theEnv); ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; } /************************************************************************* NAME : FindApplicableOfName DESCRIPTION : Groups all handlers of all types of the specified class of the specified name into the applicable handler list INPUTS : 1) The class address 2-3) The tops and bottoms of the four handler type lists: around, before, primary and after 4) The message name symbol RETURNS : Nothing useful SIDE EFFECTS : Modifies the handler lists to include applicable handlers NOTES : None *************************************************************************/ globle void FindApplicableOfName( void *theEnv, DEFCLASS *cls, HANDLER_LINK *tops[4], HANDLER_LINK *bots[4], SYMBOL_HN *mname) { register int i; register int e; HANDLER *hnd; unsigned *arr; HANDLER_LINK *tmp; i = FindHandlerNameGroup(cls,mname); if (i == -1) return; e = ((int) cls->handlerCount) - 1; hnd = cls->handlers; arr = cls->handlerOrderMap; for ( ; i <= e ; i++) { if (hnd[arr[i]].name != mname) break; tmp = get_struct(theEnv,messageHandlerLink); hnd[arr[i]].busy++; IncrementDefclassBusyCount(theEnv,(void *) hnd[arr[i]].cls); tmp->hnd = &hnd[arr[i]]; if (tops[tmp->hnd->type] == NULL) { tmp->nxt = NULL; tops[tmp->hnd->type] = bots[tmp->hnd->type] = tmp; } else if (tmp->hnd->type == MAFTER) { tmp->nxt = tops[tmp->hnd->type]; tops[tmp->hnd->type] = tmp; } else { bots[tmp->hnd->type]->nxt = tmp; bots[tmp->hnd->type] = tmp; tmp->nxt = NULL; } } } /************************************************************************* NAME : JoinHandlerLinks DESCRIPTION : Joins the queues of different handlers together INPUTS : 1-2) The tops and bottoms of the four handler type lists: around, before, primary and after 3) The message name symbol RETURNS : The top of the joined lists, NULL on errors SIDE EFFECTS : Links all the handler type lists together, or all the lists are destroyed if there are no primary handlers NOTES : None *************************************************************************/ globle HANDLER_LINK *JoinHandlerLinks( void *theEnv, HANDLER_LINK *tops[4], HANDLER_LINK *bots[4], SYMBOL_HN *mname) { register int i; HANDLER_LINK *mlink; if (tops[MPRIMARY] == NULL) { PrintNoHandlerError(theEnv,ValueToString(mname)); for (i = MAROUND ; i <= MAFTER ; i++) DestroyHandlerLinks(theEnv,tops[i]); SetEvaluationError(theEnv,TRUE); return(NULL); } mlink = tops[MPRIMARY]; if (tops[MBEFORE] != NULL) { bots[MBEFORE]->nxt = mlink; mlink = tops[MBEFORE]; } if (tops[MAROUND] != NULL) { bots[MAROUND]->nxt = mlink; mlink = tops[MAROUND]; } bots[MPRIMARY]->nxt = tops[MAFTER]; return(mlink); } /*************************************************** NAME : PrintHandlerSlotGetFunction DESCRIPTION : Developer access function for printing direct slot references in message-handlers INPUTS : 1) The logical name of the output 2) The bitmap expression RETURNS : Nothing useful SIDE EFFECTS : Expression printed NOTES : None ***************************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintHandlerSlotGetFunction( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; SLOT_DESC *sd; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"?self:["); theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID]; EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name)); EnvPrintRouter(theEnv,logicalName,"]"); sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID] - 1]; EnvPrintRouter(theEnv,logicalName,ValueToString(sd->slotName->name)); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************************** NAME : HandlerSlotGetFunction DESCRIPTION : Access function for handling the statically-bound direct slot references in message-handlers INPUTS : 1) The bitmap expression 2) A data object buffer RETURNS : TRUE if OK, FALSE on errors SIDE EFFECTS : Data object buffer gets value of slot. On errors, buffer gets symbol FALSE, EvaluationError is set and error messages are printed NOTES : It is possible for a handler (attached to a superclass of the currently active instance) containing these static references to be called for an instance which does not contain the slots (e.g., an instance of a subclass where the original slot was no-inherit or the subclass overrode the original slot) ***************************************************/ globle intBool HandlerSlotGetFunction( void *theEnv, void *theValue, DATA_OBJECT *theResult) { HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; INSTANCE_TYPE *theInstance; INSTANCE_SLOT *sp; unsigned instanceSlotIndex; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); theInstance = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value; theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID]; if (theInstance->garbage) { StaleInstanceAddress(theEnv,"for slot get",0); theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (theInstance->cls == theDefclass) { instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; sp = theInstance->slotAddresses[instanceSlotIndex - 1]; } else { if (theReference->slotID > theInstance->cls->maxSlotNameID) goto HandlerGetError; instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; if (instanceSlotIndex == 0) goto HandlerGetError; instanceSlotIndex--; sp = theInstance->slotAddresses[instanceSlotIndex]; if (sp->desc->cls != theDefclass) goto HandlerGetError; } theResult->type = (unsigned short) sp->type; theResult->value = sp->value; if (sp->type == MULTIFIELD) { theResult->begin = 0; SetpDOEnd(theResult,GetInstanceSlotLength(sp)); } return(TRUE); HandlerGetError: EarlySlotBindError(theEnv,theInstance,theDefclass,theReference->slotID); theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*************************************************** NAME : PrintHandlerSlotPutFunction DESCRIPTION : Developer access function for printing direct slot bindings in message-handlers INPUTS : 1) The logical name of the output 2) The bitmap expression RETURNS : Nothing useful SIDE EFFECTS : Expression printed NOTES : None ***************************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintHandlerSlotPutFunction( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; SLOT_DESC *sd; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(bind ?self:["); theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID]; EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name)); EnvPrintRouter(theEnv,logicalName,"]"); sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID] - 1]; EnvPrintRouter(theEnv,logicalName,ValueToString(sd->slotName->name)); if (GetFirstArgument() != NULL) { EnvPrintRouter(theEnv,logicalName," "); PrintExpression(theEnv,logicalName,GetFirstArgument()); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************************** NAME : HandlerSlotPutFunction DESCRIPTION : Access function for handling the statically-bound direct slot bindings in message-handlers INPUTS : 1) The bitmap expression 2) A data object buffer RETURNS : TRUE if OK, FALSE on errors SIDE EFFECTS : Data object buffer gets symbol TRUE and slot is set. On errors, buffer gets symbol FALSE, EvaluationError is set and error messages are printed NOTES : It is possible for a handler (attached to a superclass of the currently active instance) containing these static references to be called for an instance which does not contain the slots (e.g., an instance of a subclass where the original slot was no-inherit or the subclass overrode the original slot) ***************************************************/ globle intBool HandlerSlotPutFunction( void *theEnv, void *theValue, DATA_OBJECT *theResult) { HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; INSTANCE_TYPE *theInstance; INSTANCE_SLOT *sp; unsigned instanceSlotIndex; DATA_OBJECT theSetVal; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); theInstance = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray[0].value; theDefclass = DefclassData(theEnv)->ClassIDMap[theReference->classID]; if (theInstance->garbage) { StaleInstanceAddress(theEnv,"for slot put",0); theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (theInstance->cls == theDefclass) { instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; sp = theInstance->slotAddresses[instanceSlotIndex - 1]; } else { if (theReference->slotID > theInstance->cls->maxSlotNameID) goto HandlerPutError; instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; if (instanceSlotIndex == 0) goto HandlerPutError; instanceSlotIndex--; sp = theInstance->slotAddresses[instanceSlotIndex]; if (sp->desc->cls != theDefclass) goto HandlerPutError; } /* ======================================================= The slot has already been verified not to be read-only. However, if it is initialize-only, we need to make sure that we are initializing the instance (something we could not verify at parse-time) ======================================================= */ if (sp->desc->initializeOnly && (!theInstance->initializeInProgress)) { SlotAccessViolationError(theEnv,ValueToString(sp->desc->slotName->name), TRUE,(void *) theInstance); goto HandlerPutError2; } /* ====================================== No arguments means to use the special NoParamValue to reset the slot to its default value ====================================== */ if (GetFirstArgument()) { if (EvaluateAndStoreInDataObject(theEnv,(int) sp->desc->multiple, GetFirstArgument(),&theSetVal,TRUE) == FALSE) goto HandlerPutError2; } else { SetDOBegin(theSetVal,1); SetDOEnd(theSetVal,0); SetType(theSetVal,MULTIFIELD); SetValue(theSetVal,ProceduralPrimitiveData(theEnv)->NoParamValue); } if (PutSlotValue(theEnv,theInstance,sp,&theSetVal,theResult,NULL) == FALSE) goto HandlerPutError2; return(TRUE); HandlerPutError: EarlySlotBindError(theEnv,theInstance,theDefclass,theReference->slotID); HandlerPutError2: theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } /***************************************************** NAME : DynamicHandlerGetSlot DESCRIPTION : Directly references a slot's value (uses dynamic binding to lookup slot) INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set NOTES : H/L Syntax: (get ) *****************************************************/ globle void DynamicHandlerGetSlot( void *theEnv, DATA_OBJECT *result) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; DATA_OBJECT temp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (CheckCurrentMessage(theEnv,"dynamic-get",TRUE) == FALSE) return; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"dynamic-get",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } ins = GetActiveInstance(theEnv); sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"dynamic-get"); return; } if ((sp->desc->publicVisibility == 0) && (MessageHandlerData(theEnv)->CurrentCore->hnd->cls != sp->desc->cls)) { SlotVisibilityViolationError(theEnv,sp->desc,MessageHandlerData(theEnv)->CurrentCore->hnd->cls); SetEvaluationError(theEnv,TRUE); return; } result->type = (unsigned short) sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetInstanceSlotLength(sp)); } } /*********************************************************** NAME : DynamicHandlerPutSlot DESCRIPTION : Directly puts a slot's value (uses dynamic binding to lookup slot) INPUTS : Data obejct buffer for holding slot value RETURNS : Nothing useful SIDE EFFECTS : Slot modified - and caller's buffer set to value (or symbol FALSE on errors) NOTES : H/L Syntax: (put *) ***********************************************************/ globle void DynamicHandlerPutSlot( void *theEnv, DATA_OBJECT *theResult) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; DATA_OBJECT temp; theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); if (CheckCurrentMessage(theEnv,"dynamic-put",TRUE) == FALSE) return; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"dynamic-put",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } ins = GetActiveInstance(theEnv); sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"dynamic-put"); return; } if ((sp->desc->noWrite == 0) ? FALSE : ((sp->desc->initializeOnly == 0) || (!ins->initializeInProgress))) { SlotAccessViolationError(theEnv,ValueToString(sp->desc->slotName->name), TRUE,(void *) ins); SetEvaluationError(theEnv,TRUE); return; } if ((sp->desc->publicVisibility == 0) && (MessageHandlerData(theEnv)->CurrentCore->hnd->cls != sp->desc->cls)) { SlotVisibilityViolationError(theEnv,sp->desc,MessageHandlerData(theEnv)->CurrentCore->hnd->cls); SetEvaluationError(theEnv,TRUE); return; } if (GetFirstArgument()->nextArg) { if (EvaluateAndStoreInDataObject(theEnv,(int) sp->desc->multiple, GetFirstArgument()->nextArg,&temp,TRUE) == FALSE) return; } else { SetpDOBegin(&temp,1); SetpDOEnd(&temp,0); SetpType(&temp,MULTIFIELD); SetpValue(&temp,ProceduralPrimitiveData(theEnv)->NoParamValue); } PutSlotValue(theEnv,ins,sp,&temp,theResult,NULL); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : PerformMessage DESCRIPTION : Calls core framework for a message INPUTS : 1) Caller's result buffer 2) Message argument expressions (including implicit object) 3) Message name RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of message execution and caller's result buffer set NOTES : None *****************************************************/ static void PerformMessage( void *theEnv, DATA_OBJECT *result, EXPRESSION *args, SYMBOL_HN *mname) { int oldce; HANDLER_LINK *oldCore; DEFCLASS *cls = NULL; INSTANCE_TYPE *ins = NULL; SYMBOL_HN *oldName; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return; oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); oldName = MessageHandlerData(theEnv)->CurrentMessageName; MessageHandlerData(theEnv)->CurrentMessageName = mname; EvaluationData(theEnv)->CurrentEvaluationDepth++; PushProcParameters(theEnv,args,CountArguments(args), ValueToString(MessageHandlerData(theEnv)->CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationData(theEnv)->EvaluationError) { EvaluationData(theEnv)->CurrentEvaluationDepth--; MessageHandlerData(theEnv)->CurrentMessageName = oldName; PeriodicCleanup(theEnv,FALSE,TRUE); SetExecutingConstruct(theEnv,oldce); return; } if (ProceduralPrimitiveData(theEnv)->ProcParamArray->type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,"send",0); SetEvaluationError(theEnv,TRUE); } else if (DefclassInScope(theEnv,ins->cls,(struct defmodule *) EnvGetCurrentModule(theEnv)) == FALSE) NoInstanceError(theEnv,ValueToString(ins->name),"send"); else { cls = ins->cls; ins->busy++; } } else if (ProceduralPrimitiveData(theEnv)->ProcParamArray->type == INSTANCE_NAME) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value); if (ins == NULL) { PrintErrorID(theEnv,"MSGPASS",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No such instance "); EnvPrintRouter(theEnv,WERROR,ValueToString((SYMBOL_HN *) ProceduralPrimitiveData(theEnv)->ProcParamArray->value)); EnvPrintRouter(theEnv,WERROR," in function send.\n"); SetEvaluationError(theEnv,TRUE); } else { ProceduralPrimitiveData(theEnv)->ProcParamArray->value = (void *) ins; ProceduralPrimitiveData(theEnv)->ProcParamArray->type = INSTANCE_ADDRESS; cls = ins->cls; ins->busy++; } } else if ((cls = DefclassData(theEnv)->PrimitiveClassMap[ProceduralPrimitiveData(theEnv)->ProcParamArray->type]) == NULL) { SystemError(theEnv,"MSGPASS",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (EvaluationData(theEnv)->EvaluationError) { PopProcParameters(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth--; MessageHandlerData(theEnv)->CurrentMessageName = oldName; PeriodicCleanup(theEnv,FALSE,TRUE); SetExecutingConstruct(theEnv,oldce); return; } oldCore = MessageHandlerData(theEnv)->TopOfCore; MessageHandlerData(theEnv)->TopOfCore = FindApplicableHandlers(theEnv,cls,mname); if (MessageHandlerData(theEnv)->TopOfCore != NULL) { HANDLER_LINK *oldCurrent,*oldNext; oldCurrent = MessageHandlerData(theEnv)->CurrentCore; oldNext = MessageHandlerData(theEnv)->NextInCore; if (MessageHandlerData(theEnv)->TopOfCore->hnd->type == MAROUND) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->TopOfCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->TopOfCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->WatchMessages) WatchMessage(theEnv,WTRACE,BEGIN_TRACE); if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); if (MessageHandlerData(theEnv)->WatchMessages) WatchMessage(theEnv,WTRACE,END_TRACE); #endif } else { MessageHandlerData(theEnv)->CurrentCore = NULL; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->TopOfCore; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->WatchMessages) WatchMessage(theEnv,WTRACE,BEGIN_TRACE); #endif CallHandlers(theEnv,result); #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->WatchMessages) WatchMessage(theEnv,WTRACE,END_TRACE); #endif } DestroyHandlerLinks(theEnv,MessageHandlerData(theEnv)->TopOfCore); MessageHandlerData(theEnv)->CurrentCore = oldCurrent; MessageHandlerData(theEnv)->NextInCore = oldNext; } MessageHandlerData(theEnv)->TopOfCore = oldCore; ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; if (ins != NULL) ins->busy--; /* ================================== Restore the original calling frame ================================== */ PopProcParameters(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth--; MessageHandlerData(theEnv)->CurrentMessageName = oldName; PropagateReturnValue(theEnv,result); PeriodicCleanup(theEnv,FALSE,TRUE); SetExecutingConstruct(theEnv,oldce); if (EvaluationData(theEnv)->EvaluationError) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); } } /***************************************************************************** NAME : FindApplicableHandlers DESCRIPTION : Given a message name, this routine forms the "core frame" for the message : a list of all applicable class handlers. An applicable class handler is one whose name matches the message and whose class matches the instance. The list is in the following order : All around handlers (from most specific to most general) All before handlers (from most specific to most general) All primary handlers (from most specific to most general) All after handlers (from most general to most specific) INPUTS : 1) The class of the instance (or primitive) for the message 2) The message name RETURNS : NULL if no applicable handlers or errors, the list of handlers otherwise SIDE EFFECTS : Links are allocated for the list NOTES : The instance is the first thing on the ProcParamArray The number of arguments is in ProcParamArraySize *****************************************************************************/ static HANDLER_LINK *FindApplicableHandlers( void *theEnv, DEFCLASS *cls, SYMBOL_HN *mname) { register int i; HANDLER_LINK *tops[4],*bots[4]; for (i = MAROUND ; i <= MAFTER ; i++) tops[i] = bots[i] = NULL; for (i = 0 ; i < cls->allSuperclasses.classCount ; i++) FindApplicableOfName(theEnv,cls->allSuperclasses.classArray[i],tops,bots,mname); return(JoinHandlerLinks(theEnv,tops,bots,mname)); } /*************************************************************** NAME : CallHandlers DESCRIPTION : Moves though the current message frame for a send-message as follows : Call all before handlers and ignore their return values. Call the first primary handler and ignore the rest. The return value of the handler frame is this message's value. Call all after handlers and ignore their return values. INPUTS : Caller's buffer for the return value of the message RETURNS : Nothing useful SIDE EFFECTS : The handlers are evaluated. NOTES : IMPORTANT : The global NextInCore should be pointing to the first handler to be executed. ***************************************************************/ static void CallHandlers( void *theEnv, DATA_OBJECT *result) { #if IBM_TBC HANDLER_LINK *oldCurrent,*oldNext; /* prevents warning */ #else HANDLER_LINK *oldCurrent = NULL,*oldNext = NULL; /* prevents warning */ #endif DATA_OBJECT temp; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif if (EvaluationData(theEnv)->HaltExecution) return; oldCurrent = MessageHandlerData(theEnv)->CurrentCore; oldNext = MessageHandlerData(theEnv)->NextInCore; while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MBEFORE) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, &temp,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution) { MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; return; } } if (MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution) { MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; return; } while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MPRIMARY) { MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; if (MessageHandlerData(theEnv)->NextInCore == NULL) { MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; return; } } } while (MessageHandlerData(theEnv)->NextInCore->hnd->type == MAFTER) { MessageHandlerData(theEnv)->CurrentCore = MessageHandlerData(theEnv)->NextInCore; MessageHandlerData(theEnv)->NextInCore = MessageHandlerData(theEnv)->NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount(theEnv)) { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &MessageHandlerData(theEnv)->CurrentCore->hnd->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,MessageHandlerData(theEnv)->CurrentCore->hnd->cls->header.whichModule->theModule, MessageHandlerData(theEnv)->CurrentCore->hnd->actions, MessageHandlerData(theEnv)->CurrentCore->hnd->localVarCount, &temp,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (MessageHandlerData(theEnv)->CurrentCore->hnd->trace) WatchHandler(theEnv,WTRACE,MessageHandlerData(theEnv)->CurrentCore,END_TRACE); #endif ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; if ((MessageHandlerData(theEnv)->NextInCore == NULL) || EvaluationData(theEnv)->HaltExecution) { MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; return; } } MessageHandlerData(theEnv)->NextInCore = oldNext; MessageHandlerData(theEnv)->CurrentCore = oldCurrent; } /******************************************************** NAME : EarlySlotBindError DESCRIPTION : Prints out an error message when a message-handler from a superclass which contains a static-bind slot access is not valid for the currently active instance (i.e. the instance is not using the superclass's slot) INPUTS : 1) The currently active instance 2) The defclass holding the invalid slot 3) The canonical id of the slot RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ********************************************************/ static void EarlySlotBindError( void *theEnv, INSTANCE_TYPE *theInstance, DEFCLASS *theDefclass, unsigned slotID) { SLOT_DESC *sd; sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[slotID] - 1]; PrintErrorID(theEnv,"MSGPASS",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Static reference to slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sd->slotName->name)); EnvPrintRouter(theEnv,WERROR," of class "); PrintClassName(theEnv,WERROR,theDefclass,FALSE); EnvPrintRouter(theEnv,WERROR," does not apply to "); PrintInstanceNameAndClass(theEnv,WERROR,theInstance,TRUE); } #endif clips-6.24/clipssrc/._modulbin.h0000400000175000017500000000012207422635020014707 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._classinf.c0000400000175000017500000000075410441130151014674 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco@@BTTFSFMWBBMPSRclips-6.24/clipssrc/._classexm.c0000400000175000017500000000075410441602055014720 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoWg"Wg"<<TTFL'FMPSRMWBBLclips-6.24/clipssrc/developr.c0000755000175000017500000004166410441072315014526 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* DEVELOPER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines useful for browsing various */ /* data structures. The functions are provided for */ /* development use. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /*************************************************************/ #define _DEVELOPR_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "argacces.h" #include "envrnmnt.h" #include "extnfunc.h" #include "inscom.h" #include "modulutl.h" #include "router.h" #include "utility.h" #if DEFRULE_CONSTRUCT && DEFTEMPLATE_CONSTRUCT #include "tmpltdef.h" #include "factbld.h" #include "facthsh.h" #endif #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #include "objrtmch.h" #endif #if OBJECT_SYSTEM #include "insfun.h" #endif #include "developr.h" #if DEVELOPER #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM static void PrintOPNLevel(void *theEnv,OBJECT_PATTERN_NODE *,char *,int); #endif /**************************************************/ /* DeveloperCommands: Sets up developer commands. */ /**************************************************/ globle void DeveloperCommands( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"primitives-info",'v', PTIEF PrimitiveTablesInfo,"PrimitiveTablesInfo","00"); EnvDefineFunction2(theEnv,"primitives-usage",'v', PTIEF PrimitiveTablesUsage,"PrimitiveTablesUsage","00"); EnvDefineFunction2(theEnv,"enable-gc-heuristics",'v', PTIEF EnableGCHeuristics,"EnableGCHeuristics","00"); EnvDefineFunction2(theEnv,"disable-gc-heuristics",'v', PTIEF DisableGCHeuristics,"DisableGCHeuristics","00"); #if DEFRULE_CONSTRUCT && DEFTEMPLATE_CONSTRUCT EnvDefineFunction2(theEnv,"show-fpn",'v', PTIEF ShowFactPatternNetwork,"ShowFactPatternNetwork","11w"); EnvDefineFunction2(theEnv,"show-fht",'v', PTIEF ShowFactHashTable,"ShowFactHashTable","00"); #endif #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM EnvDefineFunction2(theEnv,"show-opn",'v',PTIEF PrintObjectPatternNetwork, "PrintObjectPatternNetwork","00"); #endif #if OBJECT_SYSTEM EnvDefineFunction2(theEnv,"instance-table-usage",'v', PTIEF InstanceTableUsage,"InstanceTableUsage","00"); #endif #endif } /******************************************************/ /* EnableGCHeuristics: */ /******************************************************/ globle void EnableGCHeuristics( void *theEnv) { EnvArgCountCheck(theEnv,"enable-gc-heuristics",EXACTLY,0); SetGarbageCollectionHeuristics(theEnv,TRUE); } /******************************************************/ /* DisableGCHeuristics: */ /******************************************************/ globle void DisableGCHeuristics( void *theEnv) { EnvArgCountCheck(theEnv,"disable-gc-heuristics",EXACTLY,0); SetGarbageCollectionHeuristics(theEnv,FALSE); } /******************************************************/ /* PrimitiveTablesInfo: Prints information about the */ /* symbol, float, integer, and bitmap tables. */ /******************************************************/ globle void PrimitiveTablesInfo( void *theEnv) { unsigned long i; SYMBOL_HN **symbolArray, *symbolPtr; FLOAT_HN **floatArray, *floatPtr; INTEGER_HN **integerArray, *integerPtr; BITMAP_HN **bitMapArray, *bitMapPtr; unsigned long int symbolCount = 0, integerCount = 0; unsigned long int floatCount = 0, bitMapCount = 0; EnvArgCountCheck(theEnv,"primitives-info",EXACTLY,0); /*====================================*/ /* Count entries in the symbol table. */ /*====================================*/ symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { symbolCount++; } } /*====================================*/ /* Count entries in the integer table. */ /*====================================*/ integerArray = GetIntegerTable(theEnv); for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { integerCount++; } } /*====================================*/ /* Count entries in the float table. */ /*====================================*/ floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { floatCount++; } } /*====================================*/ /* Count entries in the bitmap table. */ /*====================================*/ bitMapArray = GetBitMapTable(theEnv); for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { bitMapCount++; } } /*========================*/ /* Print the information. */ /*========================*/ EnvPrintRouter(theEnv,WDISPLAY,"Symbols: "); PrintLongInteger(theEnv,WDISPLAY,(long) symbolCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"Integers: "); PrintLongInteger(theEnv,WDISPLAY,(long) integerCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"Floats: "); PrintLongInteger(theEnv,WDISPLAY,(long) floatCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"BitMaps: "); PrintLongInteger(theEnv,WDISPLAY,(long) bitMapCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); //EnvPrintRouter(theEnv,WDISPLAY,"Ephemerals: "); //PrintLongInteger(theEnv,WDISPLAY,(long) EphemeralSymbolCount()); //EnvPrintRouter(theEnv,WDISPLAY,"\n"); } #define COUNT_SIZE 21 /******************************************************/ /* PrimitiveTablesUsage: Prints information about the */ /* symbol, float, integer, and bitmap tables. */ /******************************************************/ globle void PrimitiveTablesUsage( void *theEnv) { unsigned long i; int symbolCounts[COUNT_SIZE], floatCounts[COUNT_SIZE]; SYMBOL_HN **symbolArray, *symbolPtr; FLOAT_HN **floatArray, *floatPtr; unsigned long int symbolCount, totalSymbolCount = 0; unsigned long int floatCount, totalFloatCount = 0; EnvArgCountCheck(theEnv,"primitives-usage",EXACTLY,0); for (i = 0; i < 21; i++) { symbolCounts[i] = 0; floatCounts[i] = 0; } /*====================================*/ /* Count entries in the symbol table. */ /*====================================*/ symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { symbolCount = 0; for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { symbolCount++; totalSymbolCount++; } if (symbolCount < (COUNT_SIZE - 1)) { symbolCounts[symbolCount]++; } else { symbolCounts[COUNT_SIZE - 1]++; } } /*===================================*/ /* Count entries in the float table. */ /*===================================*/ floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { floatCount = 0; for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { floatCount++; totalFloatCount++; } if (floatCount < (COUNT_SIZE - 1)) { floatCounts[floatCount]++; } else { floatCounts[COUNT_SIZE - 1]++; } } /*========================*/ /* Print the information. */ /*========================*/ EnvPrintRouter(theEnv,WDISPLAY,"Total Symbols: "); PrintLongInteger(theEnv,WDISPLAY,(long) totalSymbolCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (i = 0; i < COUNT_SIZE; i++) { PrintLongInteger(theEnv,WDISPLAY,(long) i); EnvPrintRouter(theEnv,WDISPLAY," "); PrintLongInteger(theEnv,WDISPLAY,(long) symbolCounts[i]); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } EnvPrintRouter(theEnv,WDISPLAY,"\nTotal Floats: "); PrintLongInteger(theEnv,WDISPLAY,(long) totalFloatCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (i = 0; i < COUNT_SIZE; i++) { PrintLongInteger(theEnv,WDISPLAY,(long) i); EnvPrintRouter(theEnv,WDISPLAY," "); PrintLongInteger(theEnv,WDISPLAY,(long) floatCounts[i]); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } #if DEFRULE_CONSTRUCT && DEFTEMPLATE_CONSTRUCT /*******************************************************/ /* ShowFactPatternNetwork: Command for displaying the */ /* fact pattern network for a specified deftemplate. */ /*******************************************************/ globle void ShowFactPatternNetwork( void *theEnv) { struct factPatternNode *patternPtr; struct deftemplate *theDeftemplate; char *theName; int depth = 0, i; theName = GetConstructName(theEnv,"show-fpn","template name"); if (theName == NULL) return; theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,theName); if (theDeftemplate == NULL) return; patternPtr = theDeftemplate->patternNetwork; while (patternPtr != NULL) { for (i = 0; i < depth; i++) EnvPrintRouter(theEnv,WDISPLAY," "); if (patternPtr->header.singlefieldNode) EnvPrintRouter(theEnv,WDISPLAY,"SF "); else if (patternPtr->header.multifieldNode) { EnvPrintRouter(theEnv,WDISPLAY,"MF"); if (patternPtr->header.endSlot) EnvPrintRouter(theEnv,WDISPLAY,")"); else EnvPrintRouter(theEnv,WDISPLAY,"*"); PrintLongInteger(theEnv,WDISPLAY,(long) patternPtr->leaveFields); EnvPrintRouter(theEnv,WDISPLAY," "); } EnvPrintRouter(theEnv,WDISPLAY,"Slot: "); PrintLongInteger(theEnv,WDISPLAY,(long) patternPtr->whichSlot); EnvPrintRouter(theEnv,WDISPLAY," Field: "); PrintLongInteger(theEnv,WDISPLAY,(long) patternPtr->whichField); EnvPrintRouter(theEnv,WDISPLAY," Expression: "); if (patternPtr->networkTest == NULL) EnvPrintRouter(theEnv,WDISPLAY,"None"); else PrintExpression(theEnv,WDISPLAY,patternPtr->networkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); if (patternPtr->nextLevel == NULL) { while (patternPtr->rightNode == NULL) { patternPtr = patternPtr->lastLevel; depth--; if (patternPtr == NULL) return; } patternPtr = patternPtr->rightNode; } else { patternPtr = patternPtr->nextLevel; depth++; } } } #endif #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM /*************************************************** NAME : PrintObjectPatternNetwork DESCRIPTION : Displays an indented printout of the object pattern network INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Object pattern network displayed NOTES : None ***************************************************/ globle void PrintObjectPatternNetwork( void *theEnv) { char indentbuf[80]; indentbuf[0] = '\0'; PrintOPNLevel(theEnv,ObjectNetworkPointer(theEnv),indentbuf,0); } /********************************************************** NAME : PrintOPNLevel DESCRIPTION : Recursivley prints object pattern network INPUTS : 1) The current object pattern network node 2) A buffer holding preceding indentation text showing the level in the tree 3) The length of the indentation text RETURNS : Nothing useful SIDE EFFECTS : Pattern nodes recursively printed NOTES : None **********************************************************/ static void PrintOPNLevel( void *theEnv, OBJECT_PATTERN_NODE *pptr, char *indentbuf, int ilen) { CLASS_BITMAP *cbmp; SLOT_BITMAP *sbmp; register unsigned i; OBJECT_PATTERN_NODE *uptr; OBJECT_ALPHA_NODE *alphaPtr; while (pptr != NULL) { EnvPrintRouter(theEnv,WDISPLAY,indentbuf); if (pptr->alphaNode != NULL) EnvPrintRouter(theEnv,WDISPLAY,"+"); EnvPrintRouter(theEnv,WDISPLAY,ValueToString(FindIDSlotName(theEnv,pptr->slotNameID))); EnvPrintRouter(theEnv,WDISPLAY," ("); PrintLongInteger(theEnv,WDISPLAY,(long) pptr->slotNameID); EnvPrintRouter(theEnv,WDISPLAY,") "); EnvPrintRouter(theEnv,WDISPLAY,pptr->endSlot ? "EPF#" : "PF#"); PrintLongInteger(theEnv,WDISPLAY,(long) pptr->whichField); EnvPrintRouter(theEnv,WDISPLAY," "); EnvPrintRouter(theEnv,WDISPLAY,pptr->multifieldNode ? "$? " : "? "); if (pptr->networkTest != NULL) PrintExpression(theEnv,WDISPLAY,pptr->networkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); alphaPtr = pptr->alphaNode; while (alphaPtr != NULL) { EnvPrintRouter(theEnv,WDISPLAY,indentbuf); EnvPrintRouter(theEnv,WDISPLAY," Classes:"); cbmp = (CLASS_BITMAP *) ValueToBitMap(alphaPtr->classbmp); for (i = 0 ; i <= cbmp->maxid ; i++) if (TestBitMap(cbmp->map,i)) { EnvPrintRouter(theEnv,WDISPLAY," "); EnvPrintRouter(theEnv,WDISPLAY,EnvGetDefclassName(theEnv,(void *) DefclassData(theEnv)->ClassIDMap[i])); } if (alphaPtr->slotbmp != NULL) { sbmp = (SLOT_BITMAP *) ValueToBitMap(pptr->alphaNode->slotbmp); EnvPrintRouter(theEnv,WDISPLAY," *** Slots:"); for (i = NAME_ID ; i <= sbmp->maxid ; i++) if (TestBitMap(sbmp->map,i)) { for (uptr = pptr ; uptr != NULL ; uptr = uptr->lastLevel) if (uptr->slotNameID == i) break; if (uptr == NULL) { EnvPrintRouter(theEnv,WDISPLAY," "); EnvPrintRouter(theEnv,WDISPLAY,ValueToString(FindIDSlotName(theEnv,i))); } } } EnvPrintRouter(theEnv,WDISPLAY,"\n"); alphaPtr = alphaPtr->nxtInGroup; } indentbuf[ilen++] = (char) ((pptr->rightNode != NULL) ? '|' : ' '); indentbuf[ilen++] = ' '; indentbuf[ilen++] = ' '; indentbuf[ilen] = '\0'; PrintOPNLevel(theEnv,pptr->nextLevel,indentbuf,ilen); ilen -= 3; indentbuf[ilen] = '\0'; pptr = pptr->rightNode; } } #endif #if OBJECT_SYSTEM /******************************************************/ /* InstanceTableUsage: Prints information about the */ /* instances in the instance hash table. */ /******************************************************/ globle void InstanceTableUsage( void *theEnv) { unsigned long i; int instanceCounts[COUNT_SIZE]; INSTANCE_TYPE *ins; unsigned long int instanceCount, totalInstanceCount = 0; EnvArgCountCheck(theEnv,"instance-table-usage",EXACTLY,0); for (i = 0; i < COUNT_SIZE; i++) { instanceCounts[i] = 0; } /*======================================*/ /* Count entries in the instance table. */ /*======================================*/ for (i = 0; i < INSTANCE_TABLE_HASH_SIZE; i++) { instanceCount = 0; for (ins = InstanceData(theEnv)->InstanceTable[i]; ins != NULL; ins = ins->nxtHash) { instanceCount++; totalInstanceCount++; } if (instanceCount < (COUNT_SIZE - 1)) { instanceCounts[instanceCount]++; } else { instanceCounts[COUNT_SIZE - 1]++; } } /*========================*/ /* Print the information. */ /*========================*/ EnvPrintRouter(theEnv,WDISPLAY,"Total Instances: "); PrintLongInteger(theEnv,WDISPLAY,(long) totalInstanceCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (i = 0; i < COUNT_SIZE; i++) { PrintLongInteger(theEnv,WDISPLAY,(long) i); EnvPrintRouter(theEnv,WDISPLAY," "); PrintLongInteger(theEnv,WDISPLAY,(long) instanceCounts[i]); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } #endif #endif clips-6.24/clipssrc/._reteutil.h0000400000175000017500000000075410441162461014745 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0l0lQE ,TTF/BFMPSRMWBBLclips-6.24/clipssrc/._classcom.c0000400000175000017500000000075410441602050014700 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoJ >/J >/666TTFL'FMPSRMWBBLclips-6.24/clipssrc/genrccmp.c0000755000175000017500000005621510253662740014512 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Function Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added pragmas to remove unused parameter */ /* warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #if DEFRULE_CONSTRUCT #include "network.h" #endif #include "genrccom.h" #include "conscomp.h" #include "envrnmnt.h" #if OBJECT_SYSTEM #include "objcmp.h" #endif #define _GENRCCMP_SOURCE_ #include "genrccmp.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MODULEI 0 #define GENERICI 1 #define METHODI 2 #define RESTRICTIONI 3 #define TYPEI 4 #define SAVE_ITEMS 5 /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define MethodPrefix() ArbitraryPrefix(DefgenericData(theEnv)->DefgenericCodeItem,2) #define RestrictionPrefix() ArbitraryPrefix(DefgenericData(theEnv)->DefgenericCodeItem,3) #define TypePrefix() ArbitraryPrefix(DefgenericData(theEnv)->DefgenericCodeItem,4) /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void ReadyDefgenericsForCode(void *); static int DefgenericsToCode(void *,char *,int,FILE *,int,int); static void CloseDefgenericFiles(void *,FILE *[SAVE_ITEMS],int [SAVE_ITEMS], struct CodeGeneratorFile [SAVE_ITEMS],int); static void DefgenericModuleToCode(void *,FILE *,struct defmodule *,int,int); static void SingleDefgenericToCode(void *,FILE *,int,int,DEFGENERIC *,int,int,int); static void MethodToCode(void *,FILE *,int,DEFMETHOD *,int,int); static void RestrictionToCode(void *,FILE *,int,RESTRICTION *,int,int); static void TypeToCode(void *,FILE *,int,void *,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupGenericsCompiler DESCRIPTION : Initializes the construct compiler item for generic functions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item initialized NOTES : None ***************************************************/ globle void SetupGenericsCompiler( void *theEnv) { DefgenericData(theEnv)->DefgenericCodeItem = AddCodeGeneratorItem(theEnv,"generics",0,ReadyDefgenericsForCode, NULL,DefgenericsToCode,5); } /*************************************************** NAME : PrintGenericFunctionReference DESCRIPTION : Prints a reference to the run-time generic array for the construct compiler INPUTS : 1) The file output destination 2) A pointer to the generic 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 ***************************************************/ globle void PrintGenericFunctionReference( void *theEnv, FILE *fp, DEFGENERIC *gfunc, int imageID, int maxIndices) { if (gfunc == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&%s%d_%d[%d]",ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem),imageID, (int) ((gfunc->header.bsaveID / maxIndices) + 1), (int) (gfunc->header.bsaveID % maxIndices)); } /**************************************************** NAME : DefgenericCModuleReference DESCRIPTION : Prints out a reference to a defgeneric 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 : Defgeneric module reference printed NOTES : None ****************************************************/ globle void DefgenericCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ReadyDefgenericsForCode DESCRIPTION : Sets index of generic-functions for use in compiled expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : BsaveIndices set NOTES : None ***************************************************/ static void ReadyDefgenericsForCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DefgenericData(theEnv)->DefgenericModuleIndex); } /******************************************************* NAME : DefgenericsToCode DESCRIPTION : Writes out static array code for generic functions, methods, etc. 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 : -1 if no generic functions, 0 on errors, 1 if generic functions written SIDE EFFECTS : Code written to files NOTES : None *******************************************************/ static int DefgenericsToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; DEFGENERIC *theDefgeneric; DEFMETHOD *theMethod; RESTRICTION *theRestriction; register unsigned i,j,k; int moduleCount = 0; int itemArrayCounts[SAVE_ITEMS]; int itemArrayVersions[SAVE_ITEMS]; FILE *itemFiles[SAVE_ITEMS]; int itemReopenFlags[SAVE_ITEMS]; struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS]; for (i = 0 ; i < SAVE_ITEMS ; i++) { itemArrayCounts[i] = 0; itemArrayVersions[i] = 1; itemFiles[i] = NULL; itemReopenFlags[i] = FALSE; itemCodeFiles[i].filePrefix = NULL; } /* =========================================== Include the appropriate generic header file =========================================== */ fprintf(headerFP,"#include \"genrcfun.h\"\n"); /* ============================================================= Loop through all the modules and all the defgenerics writing their C code representation to the file as they are traversed ============================================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); itemFiles[MODULEI] = OpenFileIfNeeded(theEnv,itemFiles[MODULEI],fileName,fileID,imageID,&fileCount, itemArrayVersions[MODULEI],headerFP, "DEFGENERIC_MODULE",ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem), itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]); if (itemFiles[MODULEI] == NULL) goto GenericCodeError; DefgenericModuleToCode(theEnv,itemFiles[MODULEI],theModule,imageID,maxIndices); itemFiles[MODULEI] = CloseFileIfNeeded(theEnv,itemFiles[MODULEI],&itemArrayCounts[MODULEI], &itemArrayVersions[MODULEI],maxIndices, &itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]); theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); while (theDefgeneric != NULL) { itemFiles[GENERICI] = OpenFileIfNeeded(theEnv,itemFiles[GENERICI],fileName,fileID,imageID,&fileCount, itemArrayVersions[GENERICI],headerFP, "DEFGENERIC",ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem), itemReopenFlags[GENERICI],&itemCodeFiles[GENERICI]); if (itemFiles[GENERICI] == NULL) goto GenericCodeError; SingleDefgenericToCode(theEnv,itemFiles[GENERICI],imageID,maxIndices,theDefgeneric, moduleCount,itemArrayVersions[METHODI], itemArrayCounts[METHODI]); itemArrayCounts[GENERICI]++; itemFiles[GENERICI] = CloseFileIfNeeded(theEnv,itemFiles[GENERICI],&itemArrayCounts[GENERICI], &itemArrayVersions[GENERICI],maxIndices, &itemReopenFlags[GENERICI],&itemCodeFiles[GENERICI]); if (theDefgeneric->mcnt > 0) { /* =========================================== Make sure that all methods for a particular generic function go into the same array =========================================== */ itemFiles[METHODI] = OpenFileIfNeeded(theEnv,itemFiles[METHODI],fileName,fileID,imageID,&fileCount, itemArrayVersions[METHODI],headerFP, "DEFMETHOD",MethodPrefix(), itemReopenFlags[METHODI],&itemCodeFiles[METHODI]); if (itemFiles[METHODI] == NULL) goto GenericCodeError; for (i = 0 ; i < theDefgeneric->mcnt ; i++) { theMethod = &theDefgeneric->methods[i]; if (i > 0) fprintf(itemFiles[METHODI],",\n"); MethodToCode(theEnv,itemFiles[METHODI],imageID,theMethod, itemArrayVersions[RESTRICTIONI],itemArrayCounts[RESTRICTIONI]); if (theMethod->restrictionCount > 0) { /* ======================================== Make sure that all restrictions for a particular method go into the same array ======================================== */ itemFiles[RESTRICTIONI] = OpenFileIfNeeded(theEnv,itemFiles[RESTRICTIONI],fileName,fileID, imageID,&fileCount, itemArrayVersions[RESTRICTIONI],headerFP, "RESTRICTION",RestrictionPrefix(), itemReopenFlags[RESTRICTIONI],&itemCodeFiles[RESTRICTIONI]); if (itemFiles[RESTRICTIONI] == NULL) goto GenericCodeError; for (j = 0 ; j < (unsigned) theMethod->restrictionCount ; j++) { theRestriction = &theMethod->restrictions[j]; if (j > 0) fprintf(itemFiles[RESTRICTIONI],",\n"); RestrictionToCode(theEnv,itemFiles[RESTRICTIONI],imageID,theRestriction, itemArrayVersions[TYPEI],itemArrayCounts[TYPEI]); if (theRestriction->tcnt > 0) { /* ========================================= Make sure that all types for a particular restriction go into the same array ========================================= */ itemFiles[TYPEI] = OpenFileIfNeeded(theEnv,itemFiles[TYPEI],fileName,fileID, imageID,&fileCount, itemArrayVersions[TYPEI],headerFP, "void *",TypePrefix(), itemReopenFlags[TYPEI],&itemCodeFiles[TYPEI]); if (itemFiles[TYPEI] == NULL) goto GenericCodeError; for (k = 0 ; k < theRestriction->tcnt ; k++) { if (k > 0) fprintf(itemFiles[TYPEI],",\n"); TypeToCode(theEnv,itemFiles[TYPEI],imageID, theRestriction->types[k],maxIndices); } itemArrayCounts[TYPEI] += (int) theRestriction->tcnt; itemFiles[TYPEI] = CloseFileIfNeeded(theEnv,itemFiles[TYPEI],&itemArrayCounts[TYPEI], &itemArrayVersions[TYPEI],maxIndices, &itemReopenFlags[TYPEI],&itemCodeFiles[TYPEI]); } } itemArrayCounts[RESTRICTIONI] += theMethod->restrictionCount; itemFiles[RESTRICTIONI] = CloseFileIfNeeded(theEnv,itemFiles[RESTRICTIONI],&itemArrayCounts[RESTRICTIONI], &itemArrayVersions[RESTRICTIONI],maxIndices, &itemReopenFlags[RESTRICTIONI],&itemCodeFiles[RESTRICTIONI]); } } itemArrayCounts[METHODI] += (int) theDefgeneric->mcnt; itemFiles[METHODI] = CloseFileIfNeeded(theEnv,itemFiles[METHODI],&itemArrayCounts[METHODI], &itemArrayVersions[METHODI],maxIndices, &itemReopenFlags[METHODI],&itemCodeFiles[METHODI]); } theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; itemArrayCounts[MODULEI]++; } CloseDefgenericFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices); return(1); GenericCodeError: CloseDefgenericFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices); return(0); } /****************************************************** NAME : CloseDefgenericFiles DESCRIPTION : Closes construct compiler files for defgeneric structures INPUTS : 1) An array containing all the pertinent file pointers 2) An array containing all the pertinent file reopen flags 3) An array containing all the pertinent file name/id/version info 4) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Files closed NOTES : None *****************************************************/ static void CloseDefgenericFiles( void *theEnv, FILE *itemFiles[SAVE_ITEMS], int itemReopenFlags[SAVE_ITEMS], struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS], int maxIndices) { int count = maxIndices; int arrayVersion = 0; register int i; for (i = 0 ; i < SAVE_ITEMS ; i++) { count = maxIndices; itemFiles[i] = CloseFileIfNeeded(theEnv,itemFiles[i],&count,&arrayVersion, maxIndices,&itemReopenFlags[i], &itemCodeFiles[i]); } } /*************************************************** NAME : DefgenericModuleToCode DESCRIPTION : Writes out the C values for a defgeneric module item INPUTS : 1) The output file 2) The module for the defgenerics 3) The compile image id 4) The maximum number of elements in an array RETURNS : Nothing useful SIDE EFFECTS : Defgeneric module item written NOTES : None ***************************************************/ static void DefgenericModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices) { fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefgenericData(theEnv)->DefgenericModuleIndex,ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem)); fprintf(theFile,"}"); } /**************************************************************** NAME : SingleDefgenericToCode DESCRIPTION : Writes out a single defgeneric's data to the file INPUTS : 1) The output file 2) The compile image id 3) The maximum number of elements in an array 4) The defgeneric 5) The module index 6) The partition holding the generic methods 7) The relative index of the generics methods in the partition RETURNS : Nothing useful SIDE EFFECTS : Defgeneric data written NOTES : None ***************************************************************/ static void SingleDefgenericToCode( void *theEnv, FILE *theFile, int imageID, int maxIndices, DEFGENERIC *theDefgeneric, int moduleCount, int methodArrayVersion, int methodArrayCount) { /* ================== Defgeneric Header ================== */ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefgeneric->header,imageID,maxIndices,moduleCount, ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem), ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem)); /* ========================= Defgeneric specific data ========================= */ fprintf(theFile,",0,0,"); if (theDefgeneric->methods == NULL) fprintf(theFile,"NULL"); else { fprintf(theFile,"&%s%d_%d[%d]",MethodPrefix(),imageID, methodArrayVersion,methodArrayCount); } fprintf(theFile,",%u,0}",theDefgeneric->mcnt); } /**************************************************************** NAME : MethodToCode DESCRIPTION : Writes out a single method's data to the file INPUTS : 1) The output file 2) The compile image id 3) The method 4) The partition holding the method restrictions 5) The relative index of the method restrictions in the partition RETURNS : Nothing useful SIDE EFFECTS : Method data written NOTES : None ***************************************************************/ static void MethodToCode( void *theEnv, FILE *theFile, int imageID, DEFMETHOD *theMethod, int restrictionArrayVersion, int restrictionArrayCount) { fprintf(theFile,"{%u,0,%d,%d,%d,%d,%u,0,", theMethod->index,theMethod->restrictionCount, theMethod->minRestrictions,theMethod->maxRestrictions, theMethod->localVarCount,theMethod->system); if (theMethod->restrictions == NULL) fprintf(theFile,"NULL,"); else fprintf(theFile,"&%s%d_%d[%d],",RestrictionPrefix(),imageID, restrictionArrayVersion,restrictionArrayCount); ExpressionToCode(theEnv,theFile,theMethod->actions); fprintf(theFile,",NULL}"); } /**************************************************************** NAME : RestrictionToCode DESCRIPTION : Writes out a single restriction's data to the file INPUTS : 1) The output file 2) The compile image id 3) The restriction 4) The partition holding the restriction types 5) The relative index of the restriction types in the partition RETURNS : Nothing useful SIDE EFFECTS : Restriction data written NOTES : None ***************************************************************/ static void RestrictionToCode( void *theEnv, FILE *theFile, int imageID, RESTRICTION *theRestriction, int typeArrayVersion, int typeArrayCount) { fprintf(theFile,"{"); if (theRestriction->types == NULL) fprintf(theFile,"NULL,"); else fprintf(theFile,"&%s%d_%d[%d],",TypePrefix(),imageID, typeArrayVersion,typeArrayCount); ExpressionToCode(theEnv,theFile,theRestriction->query); fprintf(theFile,",%u}",theRestriction->tcnt); } /**************************************************************** NAME : TypeToCode DESCRIPTION : Writes out a single type's data to the file INPUTS : 1) The output file 2) The compile image id 3) The type RETURNS : Nothing useful SIDE EFFECTS : Type data written NOTES : None ***************************************************************/ static void TypeToCode( void *theEnv, FILE *theFile, int imageID, void *theType, int maxIndices) { #if OBJECT_SYSTEM fprintf(theFile,"VS "); PrintClassReference(theEnv,theFile,(DEFCLASS *) theType,imageID,maxIndices); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(imageID) #pragma unused(maxIndices) #endif PrintIntegerReference(theEnv,theFile,(INTEGER_HN *) theType); #endif } #endif clips-6.24/clipssrc/default.h0000755000175000017500000000361710441166600014334 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFAULT ATTRIBUTE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for parsing the default */ /* attribute and determining default values based on */ /* slot constraints. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Support for deftemplate-slot-default-value */ /* function. */ /* */ /*************************************************************/ #ifndef _H_default #define _H_default #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DEFAULT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeriveDefaultFromConstraints(void *,CONSTRAINT_RECORD *,DATA_OBJECT *,int,int); LOCALE struct expr *ParseDefault(void *,char *,int,int,int,int *,int *,int *); #endif clips-6.24/clipssrc/._reorder.h0000400000175000017500000000012207422634701014545 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._engine.c0000400000175000017500000000075410443656416014362 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco||,TTFHOFMPSRMWBBLclips-6.24/clipssrc/tmpltlhs.c0000755000175000017500000002731710441151234014552 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFTEMPLATE LHS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses LHS deftemplate patterns. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _TMPLTLHS_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "symbol.h" #include "scanner.h" #include "exprnpsr.h" #include "router.h" #include "constrnt.h" #include "constrct.h" #include "reorder.h" #include "pattern.h" #include "factrhs.h" #include "modulutl.h" #include "tmpltutl.h" #include "tmpltdef.h" #include "tmpltlhs.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct lhsParseNode *GetLHSSlots(void *,char *,struct token *,struct deftemplate *,int *); static struct lhsParseNode *GetSingleLHSSlot(void *,char *,struct token *, struct templateSlot *,int *,short); static intBool MultiplyDefinedLHSSlots(void *,struct lhsParseNode *,SYMBOL_HN *); /*********************************************/ /* DeftemplateLHSParse: Parses a LHS pattern */ /* that uses the deftemplate format. */ /*********************************************/ globle struct lhsParseNode *DeftemplateLHSParse( void *theEnv, char *readSource, struct deftemplate *theDeftemplate) { struct lhsParseNode *head, *firstSlot; struct token theToken; int error; /*===============================================================*/ /* Make sure the deftemplate name is not connected to subfields. */ /*===============================================================*/ GetToken(theEnv,readSource,&theToken); if ((theToken.type == OR_CONSTRAINT) || (theToken.type == AND_CONSTRAINT)) { SyntaxErrorMessage(theEnv,"deftemplate patterns"); return(NULL); } /*===================================================*/ /* Create the pattern node for the deftemplate name. */ /*===================================================*/ head = GetLHSParseNode(theEnv); head->type = SF_WILDCARD; head->negated = FALSE; head->index = 0; head->slotNumber = 1; head->bottom = GetLHSParseNode(theEnv); head->bottom->type = SYMBOL; head->bottom->negated = FALSE; head->bottom->value = (void *) theDeftemplate->header.name; /*==========================================*/ /* Get the other fields in the deftemplate. */ /*==========================================*/ error = FALSE; firstSlot = GetLHSSlots(theEnv,readSource,&theToken,theDeftemplate,&error); if (error) { ReturnLHSParseNodes(theEnv,firstSlot); ReturnLHSParseNodes(theEnv,head); return(NULL); } /*=========================*/ /* Return the LHS pattern. */ /*=========================*/ head->right = firstSlot; return(head); } /******************************************/ /* GetLHSSlots: Retrieves all of the slot */ /* values used in a LHS pattern. */ /******************************************/ static struct lhsParseNode *GetLHSSlots( void *theEnv, char *readSource, struct token *tempToken, struct deftemplate *theDeftemplate, int *error) { struct lhsParseNode *firstSlot = NULL, *nextSlot, *lastSlot = NULL; struct templateSlot *slotPtr; short position; /*=======================================================*/ /* Continue parsing slot definitions until the pattern's */ /* closing right parenthesis is encountered. */ /*=======================================================*/ while (tempToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,tempToken->printForm); /*=================================================*/ /* Slot definitions begin with a left parenthesis. */ /*=================================================*/ if (tempToken->type != LPAREN) { *error = TRUE; SyntaxErrorMessage(theEnv,"deftemplate patterns"); ReturnLHSParseNodes(theEnv,firstSlot); return(NULL); } /*====================*/ /* Get the slot name. */ /*====================*/ GetToken(theEnv,readSource,tempToken); if (tempToken->type != SYMBOL) { *error = TRUE; SyntaxErrorMessage(theEnv,"deftemplate patterns"); ReturnLHSParseNodes(theEnv,firstSlot); return(NULL); } /*==========================================================*/ /* Determine if the slot name is valid for the deftemplate. */ /*==========================================================*/ if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempToken->value,&position)) == NULL) { *error = TRUE; InvalidDeftemplateSlotMessage(theEnv,ValueToString(tempToken->value), ValueToString(theDeftemplate->header.name),TRUE); ReturnLHSParseNodes(theEnv,firstSlot); return(NULL); } /*============================================*/ /* Determine if the slot is multiply defined. */ /*============================================*/ if (MultiplyDefinedLHSSlots(theEnv,firstSlot,(SYMBOL_HN *) tempToken->value) == TRUE) { *error = TRUE; ReturnLHSParseNodes(theEnv,firstSlot); return(NULL); } /*==============================================================*/ /* Get the pattern matching values used in the slot definition. */ /*==============================================================*/ nextSlot = GetSingleLHSSlot(theEnv,readSource,tempToken,slotPtr,error,(short) (position+1)); if (*error) { ReturnLHSParseNodes(theEnv,firstSlot); ReturnLHSParseNodes(theEnv,nextSlot); return(NULL); } /*=====================================*/ /* Add the slot definition to the list */ /* of slot definitions already parsed. */ /*=====================================*/ if (lastSlot == NULL) { firstSlot = nextSlot; } else { lastSlot->right = nextSlot; } while (nextSlot->right != NULL) nextSlot = nextSlot->right; lastSlot = nextSlot; /*==============================*/ /* Begin parsing the next slot. */ /*==============================*/ GetToken(theEnv,readSource,tempToken); } /*===========================================================*/ /* Return all the slot definitions found in the lhs pattern. */ /*===========================================================*/ return(firstSlot); } /*****************************************************/ /* GetSingleLHSSlot: Get the pattern matching values */ /* to be associated with a slot name. */ /*****************************************************/ static struct lhsParseNode *GetSingleLHSSlot( void *theEnv, char *readSource, struct token *tempToken, struct templateSlot *slotPtr, int *error, short position) { struct lhsParseNode *nextSlot; SYMBOL_HN *slotName; /*================================================*/ /* Get the slot name and read in the first token. */ /*================================================*/ slotName = (SYMBOL_HN *) tempToken->value; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,tempToken); /*====================================*/ /* Get value for a single field slot. */ /*====================================*/ if (slotPtr->multislot == FALSE) { /*=======================*/ /* Get the single value. */ /*=======================*/ nextSlot = RestrictionParse(theEnv,readSource,tempToken,FALSE, slotPtr->slotName,(short) (position - 1), slotPtr->constraints,0); if (nextSlot == NULL) { *error = TRUE; return(NULL); } /*======================================*/ /* Multi field wildcards and variables */ /* not allowed in a single field slot. */ /*======================================*/ if ((nextSlot->type == MF_VARIABLE) || (nextSlot->type == MULTIFIELD)) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); *error = TRUE; ReturnLHSParseNodes(theEnv,nextSlot); return(NULL); } } /*===================================*/ /* Get values for a multifield slot. */ /*===================================*/ else { nextSlot = RestrictionParse(theEnv,readSource,tempToken,TRUE,slotName,(short) (position - 1), slotPtr->constraints,1); if (nextSlot == NULL) { *error = TRUE; return(NULL); } } /*========================================================*/ /* The slot definition must end with a right parenthesis. */ /*========================================================*/ if (tempToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,tempToken->printForm); SyntaxErrorMessage(theEnv,"deftemplate patterns"); *error = TRUE; ReturnLHSParseNodes(theEnv,nextSlot); return(NULL); } /*===============================================*/ /* Fix the pretty print output if the multifield */ /* slot contained no restrictions. */ /*===============================================*/ if ((nextSlot->bottom == NULL) && slotPtr->multislot) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } /*=================================*/ /* Add the slot values to the slot */ /* structure and return it. */ /*=================================*/ return(nextSlot); } /******************************************************/ /* MultiplyDefinedLHSSlots: Determines if a slot name */ /* was used more than once in a LHS pattern. */ /******************************************************/ static intBool MultiplyDefinedLHSSlots( void *theEnv, struct lhsParseNode *theSlots, SYMBOL_HN *slotName) { for (; theSlots != NULL; theSlots = theSlots->right) { if (theSlots->slot == slotName) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(slotName)); return(TRUE); } } return(FALSE); } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) */ clips-6.24/clipssrc/._prcdrfun.h0000400000175000017500000000075410441150542014730 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z;TTFS bFMWBBMPSRclips-6.24/clipssrc/genrcpsr.c0000755000175000017500000015470610441165573014544 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Functions Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* If the last construct in a loaded file is a */ /* deffunction or defmethod with no closing right */ /* parenthesis, an error should be issued, but is */ /* not. DR0872 */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if OBJECT_SYSTEM #include "classfun.h" #include "classcom.h" #endif #include "memalloc.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "genrccom.h" #include "immthpsr.h" #include "modulutl.h" #include "prcdrpsr.h" #include "prccode.h" #include "router.h" #include "scanner.h" #define _GENRCPSR_SOURCE_ #include "genrcpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define HIGHER_PRECEDENCE -1 #define IDENTICAL 0 #define LOWER_PRECEDENCE 1 #define CURR_ARG_VAR "current-argument" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool ValidGenericName(void *,char *); static SYMBOL_HN *ParseMethodNameAndIndex(void *,char *,unsigned *); #if DEBUGGING_FUNCTIONS static void CreateDefaultGenericPPForm(void *,DEFGENERIC *); #endif static int ParseMethodParameters(void *,char *,EXPRESSION **,SYMBOL_HN **); static RESTRICTION *ParseRestriction(void *,char *); static void ReplaceCurrentArgRefs(void *,EXPRESSION *); static int DuplicateParameters(void *,EXPRESSION *,EXPRESSION **,SYMBOL_HN *); static EXPRESSION *AddParameter(void *,EXPRESSION *,EXPRESSION *,SYMBOL_HN *,RESTRICTION *); static EXPRESSION *ValidType(void *,SYMBOL_HN *); static intBool RedundantClasses(void *,void *,void *); static DEFGENERIC *AddGeneric(void *,SYMBOL_HN *,int *); static DEFMETHOD *AddGenericMethod(void *,DEFGENERIC *,int,unsigned); static int RestrictionsCompare(EXPRESSION *,int,int,int,DEFMETHOD *); static int TypeListCompare(RESTRICTION *,RESTRICTION *); static DEFGENERIC *NewGeneric(void *,SYMBOL_HN *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************************** NAME : ParseDefgeneric DESCRIPTION : Parses the defgeneric construct INPUTS : The input logical name RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Inserts valid generic function defn into generic entry NOTES : H/L Syntax : (defgeneric []) ***************************************************************************/ globle intBool ParseDefgeneric( void *theEnv, char *readSource) { SYMBOL_HN *gname; DEFGENERIC *gfunc; int newGeneric; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SavePPBuffer(theEnv,"(defgeneric "); SetIndentDepth(theEnv,3); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defgeneric"); return(TRUE); } #endif gname = GetConstructNameAndComment(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken,"defgeneric", EnvFindDefgeneric,NULL,"^",TRUE, TRUE,TRUE); if (gname == NULL) return(TRUE); if (ValidGenericName(theEnv,ValueToString(gname)) == FALSE) return(TRUE); if (DefgenericData(theEnv)->GenericInputToken.type != RPAREN) { PrintErrorID(theEnv,"GENRCPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected ')' to complete defgeneric.\n"); 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) { return(FALSE); } gfunc = AddGeneric(theEnv,gname,&newGeneric); #if DEBUGGING_FUNCTIONS SetDefgenericPPForm((void *) gfunc,EnvGetConserveMemory(theEnv) ? NULL : CopyPPBuffer(theEnv)); #endif return(FALSE); } /*************************************************************************** NAME : ParseDefmethod DESCRIPTION : Parses the defmethod construct INPUTS : The input logical name RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Inserts valid method definition into generic entry NOTES : H/L Syntax : (defmethod [] [] (* []) *) :== ? | (? * []) :== $? | ($? * []) ***************************************************************************/ globle intBool ParseDefmethod( void *theEnv, char *readSource) { SYMBOL_HN *gname; int rcnt,mposn,mi,newMethod,mnew = FALSE,lvars,error; EXPRESSION *params,*actions,*tmp; SYMBOL_HN *wildcard; DEFMETHOD *meth; DEFGENERIC *gfunc; unsigned theIndex; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmethod "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmethod"); return(TRUE); } #endif gname = ParseMethodNameAndIndex(theEnv,readSource,&theIndex); if (gname == NULL) return(TRUE); if (ValidGenericName(theEnv,ValueToString(gname)) == FALSE) return(TRUE); /* ======================================================== Go ahead and add the header so that the generic function can be called recursively ======================================================== */ gfunc = AddGeneric(theEnv,gname,&newMethod); #if DEBUGGING_FUNCTIONS if (newMethod && (! ConstructData(theEnv)->CheckSyntaxMode)) CreateDefaultGenericPPForm(theEnv,gfunc); #endif IncrementIndentDepth(theEnv,1); rcnt = ParseMethodParameters(theEnv,readSource,¶ms,&wildcard); DecrementIndentDepth(theEnv,1); if (rcnt == -1) goto DefmethodParseError; PPCRAndIndent(theEnv); for (tmp = params ; tmp != NULL ; tmp = tmp->nextArg) { ReplaceCurrentArgRefs(theEnv,((RESTRICTION *) tmp->argList)->query); if (ReplaceProcVars(theEnv,"method",((RESTRICTION *) tmp->argList)->query, params,wildcard,NULL,NULL)) { DeleteTempRestricts(theEnv,params); goto DefmethodParseError; } } meth = FindMethodByRestrictions(gfunc,params,rcnt,wildcard,&mposn); error = FALSE; if (meth != NULL) { if (meth->system) { PrintErrorID(theEnv,"GENRCPSR",17,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot replace the implicit system method #"); PrintLongInteger(theEnv,WERROR,(long) meth->index); EnvPrintRouter(theEnv,WERROR,".\n"); error = TRUE; } else if ((theIndex != 0) && (theIndex != meth->index)) { PrintErrorID(theEnv,"GENRCPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"New method #"); PrintLongInteger(theEnv,WERROR,(long) theIndex); EnvPrintRouter(theEnv,WERROR," would be indistinguishable from method #"); PrintLongInteger(theEnv,WERROR,(long) meth->index); EnvPrintRouter(theEnv,WERROR,".\n"); error = TRUE; } } else if (theIndex != 0) { mi = FindMethodByIndex(gfunc,theIndex); if (mi == -1) mnew = TRUE; else if (gfunc->methods[mi].system) { PrintErrorID(theEnv,"GENRCPSR",17,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot replace the implicit system method #"); PrintLongInteger(theEnv,WERROR,(long) theIndex); EnvPrintRouter(theEnv,WERROR,".\n"); error = TRUE; } } else mnew = TRUE; if (error) { DeleteTempRestricts(theEnv,params); goto DefmethodParseError; } ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"method",readSource, &DefgenericData(theEnv)->GenericInputToken,params,wildcard, NULL,NULL,&lvars,NULL); /*===========================================================*/ /* Check for the closing right parenthesis of the defmethod. */ /*===========================================================*/ if ((DefgenericData(theEnv)->GenericInputToken.type != RPAREN) && /* DR0872 */ (actions != NULL)) { DeleteTempRestricts(theEnv,params); ReturnPackedExpression(theEnv,actions); goto DefmethodParseError; } if (actions == NULL) { DeleteTempRestricts(theEnv,params); goto DefmethodParseError; } /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deffunction to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { DeleteTempRestricts(theEnv,params); ReturnPackedExpression(theEnv,actions); if (newMethod) { RemoveConstructFromModule(theEnv,(struct constructHeader *) gfunc); RemoveDefgeneric(theEnv,(struct constructHeader *) gfunc); } return(FALSE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm); SavePPBuffer(theEnv,"\n"); #if DEBUGGING_FUNCTIONS meth = AddMethod(theEnv,gfunc,meth,mposn,theIndex,params,rcnt,lvars,wildcard,actions, EnvGetConserveMemory(theEnv) ? NULL : CopyPPBuffer(theEnv),FALSE); #else meth = AddMethod(theEnv,gfunc,meth,mposn,theIndex,params,rcnt,lvars,wildcard,actions,NULL,FALSE); #endif DeleteTempRestricts(theEnv,params); if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv)) { EnvPrintRouter(theEnv,WDIALOG," Method #"); PrintLongInteger(theEnv,WDIALOG,(long) meth->index); EnvPrintRouter(theEnv,WDIALOG,(char *) (mnew ? " defined.\n" : " redefined.\n")); } return(FALSE); DefmethodParseError: if (newMethod) { RemoveConstructFromModule(theEnv,(struct constructHeader *) gfunc); RemoveDefgeneric(theEnv,(void *) gfunc); } return(TRUE); } /************************************************************************ NAME : AddMethod DESCRIPTION : (Re)defines a new method for a generic If method already exists, deletes old information before proceeding. INPUTS : 1) The generic address 2) The old method address (can be NULL) 3) The old method array position (can be -1) 4) The method index to assign (0 if don't care) 5) The parameter expression-list (restrictions attached to argList pointers) 6) The number of restrictions 7) The number of locals vars reqd 8) The wildcard symbol (NULL if none) 9) Method actions 10) Method pretty-print form 11) A flag indicating whether to copy the restriction types or just use the pointers RETURNS : The new (old) method address SIDE EFFECTS : Method added to (or changed in) method array for generic Restrictions repacked into new method Actions and pretty-print form attached NOTES : Assumes if a method is being redefined, its busy count is 0!! IMPORTANT: Expects that FindMethodByRestrictions() has previously been called to determine if this method is already present or not. Arguments #1 and #2 should be the values obtained from FindMethod...(). ************************************************************************/ globle DEFMETHOD *AddMethod( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *meth, int mposn, unsigned mi, EXPRESSION *params, int rcnt, int lvars, SYMBOL_HN *wildcard, EXPRESSION *actions, char *ppForm, int copyRestricts) { RESTRICTION *rptr,*rtmp; register int i,j; int mai; SaveBusyCount(gfunc); if (meth == NULL) { mai = (mi != 0) ? FindMethodByIndex(gfunc,mi) : -1; if (mai == -1) meth = AddGenericMethod(theEnv,gfunc,mposn,mi); else { DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[mai]); if (mai < mposn) { mposn--; for (i = mai+1 ; i <= mposn ; i++) GenCopyMemory(DEFMETHOD,1,&gfunc->methods[i-1],&gfunc->methods[i]); } else { for (i = mai-1 ; i >= mposn ; i--) GenCopyMemory(DEFMETHOD,1,&gfunc->methods[i+1],&gfunc->methods[i]); } meth = &gfunc->methods[mposn]; meth->index = mi; } } else { /* ================================ The old trace state is preserved ================================ */ ExpressionDeinstall(theEnv,meth->actions); ReturnPackedExpression(theEnv,meth->actions); if (meth->ppForm != NULL) rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1))); } meth->system = 0; meth->actions = actions; ExpressionInstall(theEnv,meth->actions); meth->ppForm = ppForm; if (mposn == -1) { RestoreBusyCount(gfunc); return(meth); } meth->localVarCount = lvars; meth->restrictionCount = rcnt; if (wildcard != NULL) { meth->minRestrictions = rcnt-1; meth->maxRestrictions = -1; } else meth->minRestrictions = meth->maxRestrictions = rcnt; if (rcnt != 0) meth->restrictions = (RESTRICTION *) gm2(theEnv,(sizeof(RESTRICTION) * rcnt)); else meth->restrictions = NULL; for (i = 0 ; i < rcnt ; i++) { rptr = &meth->restrictions[i]; rtmp = (RESTRICTION *) params->argList; rptr->query = PackExpression(theEnv,rtmp->query); rptr->tcnt = rtmp->tcnt; if (copyRestricts) { if (rtmp->types != NULL) { rptr->types = (void **) gm2(theEnv,(rptr->tcnt * sizeof(void *))); GenCopyMemory(void *,rptr->tcnt,rptr->types,rtmp->types); } else rptr->types = NULL; } else { rptr->types = rtmp->types; /* ===================================================== Make sure the types-array is not deallocated when the temporary restriction nodes are ===================================================== */ rtmp->tcnt = 0; rtmp->types = NULL; } ExpressionInstall(theEnv,rptr->query); for (j = 0 ; (unsigned) j < rptr->tcnt ; j++) #if OBJECT_SYSTEM IncrementDefclassBusyCount(theEnv,rptr->types[j]); #else IncrementIntegerCount((INTEGER_HN *) rptr->types[j]); #endif params = params->nextArg; } RestoreBusyCount(gfunc); return(meth); } /***************************************************** NAME : PackRestrictionTypes DESCRIPTION : Takes the restriction type list and packs it into a contiguous array of void *. INPUTS : 1) The restriction structure 2) The types expression list RETURNS : Nothing useful SIDE EFFECTS : Array allocated & expressions freed NOTES : None *****************************************************/ globle void PackRestrictionTypes( void *theEnv, RESTRICTION *rptr, EXPRESSION *types) { EXPRESSION *tmp; register unsigned i; rptr->tcnt = 0; for (tmp = types ; tmp != NULL ; tmp = tmp->nextArg) rptr->tcnt++; if (rptr->tcnt != 0) rptr->types = (void **) gm2(theEnv,(sizeof(void *) * rptr->tcnt)); else rptr->types = NULL; for (i = 0 , tmp = types ; i < rptr->tcnt ; i++ , tmp = tmp->nextArg) rptr->types[i] = (void *) tmp->value; ReturnExpression(theEnv,types); } /*************************************************** NAME : DeleteTempRestricts DESCRIPTION : Deallocates the method temporary parameter list INPUTS : The head of the list RETURNS : Nothing useful SIDE EFFECTS : List deallocated NOTES : None ***************************************************/ globle void DeleteTempRestricts( void *theEnv, EXPRESSION *phead) { EXPRESSION *ptmp; RESTRICTION *rtmp; while (phead != NULL) { ptmp = phead; phead = phead->nextArg; rtmp = (RESTRICTION *) ptmp->argList; rtn_struct(theEnv,expr,ptmp); ReturnExpression(theEnv,rtmp->query); if (rtmp->tcnt != 0) rm(theEnv,(void *) rtmp->types,(sizeof(void *) * rtmp->tcnt)); rtn_struct(theEnv,restriction,rtmp); } } /********************************************************** NAME : FindMethodByRestrictions DESCRIPTION : See if a method for the specified generic satsifies the given restrictions INPUTS : 1) Generic function 2) Parameter/restriction expression list 3) Number of restrictions 4) Wildcard symbol (can be NULL) 5) Caller's buffer for holding array posn of where to add new generic method (-1 if method already present) RETURNS : The address of the found method, NULL if not found SIDE EFFECTS : Sets the caller's buffer to the index of where to place the new method, -1 if already present NOTES : None **********************************************************/ globle DEFMETHOD *FindMethodByRestrictions( DEFGENERIC *gfunc, EXPRESSION *params, int rcnt, SYMBOL_HN *wildcard, int *posn) { register int i,cmp; int min,max; if (wildcard != NULL) { min = rcnt-1; max = -1; } else min = max = rcnt; for (i = 0 ; (unsigned) i < gfunc->mcnt ; i++) { cmp = RestrictionsCompare(params,rcnt,min,max,&gfunc->methods[i]); if (cmp == IDENTICAL) { *posn = -1; return(&gfunc->methods[i]); } else if (cmp == HIGHER_PRECEDENCE) { *posn = i; return(NULL); } } *posn = i; return(NULL); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : ValidGenericName DESCRIPTION : Determines if a particular function name can be overloaded INPUTS : The name RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Error message printed NOTES : GetConstructNameAndComment() (called before this function) ensures that the defgeneric name does not conflict with one from another module ***********************************************************/ static intBool ValidGenericName( void *theEnv, char *theDefgenericName) { struct constructHeader *theDefgeneric; #if DEFFUNCTION_CONSTRUCT struct defmodule *theModule; struct constructHeader *theDeffunction; #endif struct FunctionDefinition *systemFunction; /* ============================================ A defgeneric cannot be named the same as a construct type, e.g, defclass, defrule, etc. ============================================ */ if (FindConstruct(theEnv,theDefgenericName) != NULL) { PrintErrorID(theEnv,"GENRCPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgenerics are not allowed to replace constructs.\n"); return(FALSE); } #if DEFFUNCTION_CONSTRUCT /* ======================================== A defgeneric cannot be named the same as a defffunction (either in this module or imported from another) ======================================== */ theDeffunction = (struct constructHeader *) LookupDeffunctionInScope(theEnv,theDefgenericName); if (theDeffunction != NULL) { theModule = GetConstructModuleItem(theDeffunction)->theModule; if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { PrintErrorID(theEnv,"GENRCPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction)); EnvPrintRouter(theEnv,WERROR," imported from module "); EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,WERROR," conflicts with this defgeneric.\n"); return(FALSE); } else { PrintErrorID(theEnv,"GENRCPSR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgenerics are not allowed to replace deffunctions.\n"); } return(FALSE); } #endif /* ========================================= See if the defgeneric already exists in this module (or is imported from another) ========================================= */ theDefgeneric = (struct constructHeader *) EnvFindDefgeneric(theEnv,theDefgenericName); if (theDefgeneric != NULL) { /* =========================================== And the redefinition of a defgeneric in the current module is only valid if none of its methods are executing =========================================== */ if (MethodsExecuting((DEFGENERIC *) theDefgeneric)) { MethodAlterError(theEnv,(DEFGENERIC *) theDefgeneric); return(FALSE); } } /* ======================================= Only certain specific system functions may be overloaded by generic functions ======================================= */ systemFunction = FindFunction(theEnv,theDefgenericName); if ((systemFunction != NULL) ? (systemFunction->overloadable == FALSE) : FALSE) { PrintErrorID(theEnv,"GENRCPSR",16,FALSE); EnvPrintRouter(theEnv,WERROR,"The system function "); EnvPrintRouter(theEnv,WERROR,theDefgenericName); EnvPrintRouter(theEnv,WERROR," cannot be overloaded.\n"); return(FALSE); } return(TRUE); } #if DEBUGGING_FUNCTIONS /*************************************************** NAME : CreateDefaultGenericPPForm DESCRIPTION : Adds a default pretty-print form for a gneric function when it is impliciylt created by the defn of its first method INPUTS : The generic function RETURNS : Nothing useful SIDE EFFECTS : Pretty-print form created and attached. NOTES : None ***************************************************/ static void CreateDefaultGenericPPForm( void *theEnv, DEFGENERIC *gfunc) { char *moduleName,*genericName,*buf; moduleName = EnvGetDefmoduleName(theEnv,(void *) ((struct defmodule *) EnvGetCurrentModule(theEnv))); genericName = EnvGetDefgenericName(theEnv,(void *) gfunc); buf = (char *) gm2(theEnv,(sizeof(char) * (strlen(moduleName) + strlen(genericName) + 17))); sprintf(buf,"(defgeneric %s::%s)\n",moduleName,genericName); SetDefgenericPPForm((void *) gfunc,buf); } #endif /******************************************************* NAME : ParseMethodNameAndIndex DESCRIPTION : Parses the name of the method and optional method index INPUTS : 1) The logical name of the input source 2) Caller's buffer for method index (0 if not specified) RETURNS : The symbolic name of the method SIDE EFFECTS : None NOTES : Assumes "(defmethod " already parsed *******************************************************/ static SYMBOL_HN *ParseMethodNameAndIndex( void *theEnv, char *readSource, unsigned *theIndex) { SYMBOL_HN *gname; *theIndex = 0; gname = GetConstructNameAndComment(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken,"defgeneric", EnvFindDefgeneric,NULL,"&",TRUE,FALSE,TRUE); if (gname == NULL) return(NULL); if (GetType(DefgenericData(theEnv)->GenericInputToken) == INTEGER) { int tmp; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm); tmp = (int) ValueToLong(GetValue(DefgenericData(theEnv)->GenericInputToken)); if (tmp < 1) { PrintErrorID(theEnv,"GENRCPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Method index out of range.\n"); return(NULL); } *theIndex = (unsigned) tmp; PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); } if (GetType(DefgenericData(theEnv)->GenericInputToken) == STRING) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm); PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); } return(gname); } /************************************************************************ NAME : ParseMethodParameters DESCRIPTION : Parses method restrictions (parameter names with class and expression specifiers) INPUTS : 1) The logical name of the input source 2) Caller's buffer for the parameter name list (Restriction structures are attached to argList pointers of parameter nodes) 3) Caller's buffer for wildcard symbol (if any) RETURNS : The number of parameters, or -1 on errors SIDE EFFECTS : Memory allocated for parameters and restrictions Parameter names stored in expression list Parameter restrictions stored in contiguous array NOTES : Any memory allocated is freed on errors Assumes first opening parenthesis has been scanned ************************************************************************/ static int ParseMethodParameters( void *theEnv, char *readSource, EXPRESSION **params, SYMBOL_HN **wildcard) { EXPRESSION *phead = NULL,*pprv; SYMBOL_HN *pname; RESTRICTION *rtmp; int rcnt = 0; *wildcard = NULL; *params = NULL; if (GetType(DefgenericData(theEnv)->GenericInputToken) != LPAREN) { PrintErrorID(theEnv,"GENRCPSR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a '(' to begin method parameter restrictions.\n"); return(-1); } GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); while (DefgenericData(theEnv)->GenericInputToken.type != RPAREN) { if (*wildcard != NULL) { DeleteTempRestricts(theEnv,phead); PrintErrorID(theEnv,"PRCCODE",8,FALSE); EnvPrintRouter(theEnv,WERROR,"No parameters allowed after wildcard parameter.\n"); return(-1); } if ((DefgenericData(theEnv)->GenericInputToken.type == SF_VARIABLE) || (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE)) { pname = (SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value; if (DuplicateParameters(theEnv,phead,&pprv,pname)) { DeleteTempRestricts(theEnv,phead); return(-1); } if (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE) *wildcard = pname; rtmp = get_struct(theEnv,restriction); PackRestrictionTypes(theEnv,rtmp,NULL); rtmp->query = NULL; phead = AddParameter(theEnv,phead,pprv,pname,rtmp); rcnt++; } else if (DefgenericData(theEnv)->GenericInputToken.type == LPAREN) { GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); if ((DefgenericData(theEnv)->GenericInputToken.type != SF_VARIABLE) && (DefgenericData(theEnv)->GenericInputToken.type != MF_VARIABLE)) { DeleteTempRestricts(theEnv,phead); PrintErrorID(theEnv,"GENRCPSR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a variable for parameter specification.\n"); return(-1); } pname = (SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value; if (DuplicateParameters(theEnv,phead,&pprv,pname)) { DeleteTempRestricts(theEnv,phead); return(-1); } if (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE) *wildcard = pname; SavePPBuffer(theEnv," "); rtmp = ParseRestriction(theEnv,readSource); if (rtmp == NULL) { DeleteTempRestricts(theEnv,phead); return(-1); } phead = AddParameter(theEnv,phead,pprv,pname,rtmp); rcnt++; } else { DeleteTempRestricts(theEnv,phead); PrintErrorID(theEnv,"GENRCPSR",9,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a variable or '(' for parameter specification.\n"); return(-1); } PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); } if (rcnt != 0) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } *params = phead; return(rcnt); } /************************************************************ NAME : ParseRestriction DESCRIPTION : Parses the restriction for a parameter of a method This restriction is comprised of: 1) A list of classes (or types) that are allowed for the parameter (None if no type restriction) 2) And an optional restriction-query expression INPUTS : The logical name of the input source RETURNS : The address of a RESTRICTION node, NULL on errors SIDE EFFECTS : RESTRICTION node allocated Types are in a contiguous array of void * Query is an expression NOTES : Assumes "(? " has already been parsed H/L Syntax: * []) ************************************************************/ static RESTRICTION *ParseRestriction( void *theEnv, char *readSource) { EXPRESSION *types = NULL,*new_types, *typesbot,*tmp,*tmp2, *query = NULL; RESTRICTION *rptr; GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); while (DefgenericData(theEnv)->GenericInputToken.type != RPAREN) { if (query != NULL) { PrintErrorID(theEnv,"GENRCPSR",10,FALSE); EnvPrintRouter(theEnv,WERROR,"Query must be last in parameter restriction.\n"); ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); return(NULL); } if (DefgenericData(theEnv)->GenericInputToken.type == SYMBOL) { new_types = ValidType(theEnv,(SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value); if (new_types == NULL) { ReturnExpression(theEnv,types); ReturnExpression(theEnv,query); return(NULL); } if (types == NULL) types = new_types; else { for (typesbot = tmp = types ; tmp != NULL ; tmp = tmp->nextArg) { for (tmp2 = new_types ; tmp2 != NULL ; tmp2 = tmp2->nextArg) { if (tmp->value == tmp2->value) { PrintErrorID(theEnv,"GENRCPSR",11,FALSE); #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WERROR,"Duplicate classes not allowed in parameter restriction.\n"); #else EnvPrintRouter(theEnv,WERROR,"Duplicate types not allowed in parameter restriction.\n"); #endif ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); ReturnExpression(theEnv,new_types); return(NULL); } if (RedundantClasses(theEnv,tmp->value,tmp2->value)) { ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); ReturnExpression(theEnv,new_types); return(NULL); } } typesbot = tmp; } typesbot->nextArg = new_types; } } else if (DefgenericData(theEnv)->GenericInputToken.type == LPAREN) { query = Function1Parse(theEnv,readSource); if (query == NULL) { ReturnExpression(theEnv,types); return(NULL); } if (GetParsedBindNames(theEnv) != NULL) { PrintErrorID(theEnv,"GENRCPSR",12,FALSE); EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in query expressions.\n"); ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); return(NULL); } } #if DEFGLOBAL_CONSTRUCT else if (DefgenericData(theEnv)->GenericInputToken.type == GBL_VARIABLE) query = GenConstant(theEnv,GBL_VARIABLE,DefgenericData(theEnv)->GenericInputToken.value); #endif else { PrintErrorID(theEnv,"GENRCPSR",13,FALSE); #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WERROR,"Expected a valid class name or query.\n"); #else EnvPrintRouter(theEnv,WERROR,"Expected a valid type name or query.\n"); #endif ReturnExpression(theEnv,query); ReturnExpression(theEnv,types); return(NULL); } SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); if ((types == NULL) && (query == NULL)) { PrintErrorID(theEnv,"GENRCPSR",13,FALSE); #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WERROR,"Expected a valid class name or query.\n"); #else EnvPrintRouter(theEnv,WERROR,"Expected a valid type name or query.\n"); #endif return(NULL); } rptr = get_struct(theEnv,restriction); rptr->query = query; PackRestrictionTypes(theEnv,rptr,types); return(rptr); } /***************************************************************** NAME : ReplaceCurrentArgRefs DESCRIPTION : Replaces all references to ?current-argument in method parameter queries with special calls to (gnrc-current-arg) INPUTS : The query expression RETURNS : Nothing useful SIDE EFFECTS : Variable references to ?current-argument replaced NOTES : None *****************************************************************/ static void ReplaceCurrentArgRefs( void *theEnv, EXPRESSION *query) { while (query != NULL) { if ((query->type != SF_VARIABLE) ? FALSE : (strcmp(ValueToString(query->value),CURR_ARG_VAR) == 0)) { query->type = FCALL; query->value = (void *) FindFunction(theEnv,"(gnrc-current-arg)"); } if (query->argList != NULL) ReplaceCurrentArgRefs(theEnv,query->argList); query = query->nextArg; } } /********************************************************** NAME : DuplicateParameters DESCRIPTION : Examines the parameter expression chain for a method looking duplicates. INPUTS : 1) The parameter chain (can be NULL) 2) Caller's buffer for address of last node searched (can be used to later attach new parameter) 3) The name of the parameter being checked RETURNS : TRUE if duplicates found, FALSE otherwise SIDE EFFECTS : Caller's prv address set NOTES : Assumes all parameter list nodes are WORDS **********************************************************/ static int DuplicateParameters( void *theEnv, EXPRESSION *head, EXPRESSION **prv, SYMBOL_HN *name) { *prv = NULL; while (head != NULL) { if (head->value == (void *) name) { PrintErrorID(theEnv,"PRCCODE",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate parameter names not allowed.\n"); return(TRUE); } *prv = head; head = head->nextArg; } return(FALSE); } /***************************************************************** NAME : AddParameter DESCRIPTION : Shoves a new paramter with its restriction onto the list for a method The parameter list is a list of expressions linked by neext_arg pointers, and the argList pointers are used for the restrictions INPUTS : 1) The head of the list 2) The bottom of the list 3) The parameter name 4) The parameter restriction RETURNS : The (new) head of the list SIDE EFFECTS : New parameter expression node allocated, set, and attached NOTES : None *****************************************************************/ static EXPRESSION *AddParameter( void *theEnv, EXPRESSION *phead, EXPRESSION *pprv, SYMBOL_HN *pname, RESTRICTION *rptr) { EXPRESSION *ptmp; ptmp = GenConstant(theEnv,SYMBOL,(void *) pname); if (phead == NULL) phead = ptmp; else pprv->nextArg = ptmp; ptmp->argList = (EXPRESSION *) rptr; return(phead); } /************************************************************** NAME : ValidType DESCRIPTION : Examines the name of a restriction type and forms a list of integer-code expressions corresponding to the primitive types (or a Class address if COOL is installed) INPUTS : The type name RETURNS : The expression chain (NULL on errors) SIDE EFFECTS : Expression type chain allocated one or more nodes holding codes for types (or class addresses) NOTES : None *************************************************************/ static EXPRESSION *ValidType( void *theEnv, SYMBOL_HN *tname) { #if OBJECT_SYSTEM DEFCLASS *cls; if (FindModuleSeparator(ValueToString(tname))) IllegalModuleSpecifierMessage(theEnv); else { cls = LookupDefclassInScope(theEnv,ValueToString(tname)); if (cls == NULL) { PrintErrorID(theEnv,"GENRCPSR",14,FALSE); EnvPrintRouter(theEnv,WERROR,"Unknown class in method.\n"); return(NULL); } return(GenConstant(theEnv,EXTERNAL_ADDRESS,(void *) cls)); } #else if (strcmp(ValueToString(tname),INTEGER_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) INTEGER))); if (strcmp(ValueToString(tname),FLOAT_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) FLOAT))); if (strcmp(ValueToString(tname),SYMBOL_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) SYMBOL))); if (strcmp(ValueToString(tname),STRING_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) STRING))); if (strcmp(ValueToString(tname),MULTIFIELD_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) MULTIFIELD))); if (strcmp(ValueToString(tname),EXTERNAL_ADDRESS_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) EXTERNAL_ADDRESS))); if (strcmp(ValueToString(tname),FACT_ADDRESS_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) FACT_ADDRESS))); if (strcmp(ValueToString(tname),NUMBER_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) NUMBER_TYPE_CODE))); if (strcmp(ValueToString(tname),LEXEME_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) LEXEME_TYPE_CODE))); if (strcmp(ValueToString(tname),ADDRESS_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) ADDRESS_TYPE_CODE))); if (strcmp(ValueToString(tname),PRIMITIVE_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) PRIMITIVE_TYPE_CODE))); if (strcmp(ValueToString(tname),OBJECT_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) OBJECT_TYPE_CODE))); if (strcmp(ValueToString(tname),INSTANCE_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) INSTANCE_TYPE_CODE))); if (strcmp(ValueToString(tname),INSTANCE_NAME_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) INSTANCE_NAME))); if (strcmp(ValueToString(tname),INSTANCE_ADDRESS_TYPE_NAME) == 0) return(GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) INSTANCE_ADDRESS))); PrintErrorID(theEnv,"GENRCPSR",14,FALSE); EnvPrintRouter(theEnv,WERROR,"Unknown type in method.\n"); #endif return(NULL); } /************************************************************* NAME : RedundantClasses DESCRIPTION : Determines if one class (type) is subsumes (or is subsumed by) another. INPUTS : Two void pointers which are class pointers if COOL is installed or integer hash nodes for type codes otherwise. RETURNS : TRUE if there is subsumption, FALSE otherwise SIDE EFFECTS : An error message is printed, if appropriate. NOTES : None *************************************************************/ static intBool RedundantClasses( void *theEnv, void *c1, void *c2) { char *tname; #if OBJECT_SYSTEM if (HasSuperclass((DEFCLASS *) c1,(DEFCLASS *) c2)) tname = EnvGetDefclassName(theEnv,c1); else if (HasSuperclass((DEFCLASS *) c2,(DEFCLASS *) c1)) tname = EnvGetDefclassName(theEnv,c2); #else if (SubsumeType(ValueToInteger(c1),ValueToInteger(c2))) tname = TypeName(theEnv,ValueToInteger(c1)); else if (SubsumeType(ValueToInteger(c2),ValueToInteger(c1))) tname = TypeName(theEnv,ValueToInteger(c2)); #endif else return(FALSE); PrintErrorID(theEnv,"GENRCPSR",15,FALSE); EnvPrintRouter(theEnv,WERROR,tname); EnvPrintRouter(theEnv,WERROR," class is redundant.\n"); return(TRUE); } /********************************************************* NAME : AddGeneric DESCRIPTION : Inserts a new generic function header into the generic list INPUTS : 1) Symbolic name of the new generic 2) Caller's input buffer for flag if added generic is new or not RETURNS : The address of the new node, or address of old node if already present SIDE EFFECTS : Generic header inserted If the node is already present, it is moved to the end of the list, otherwise the new node is inserted at the end NOTES : None *********************************************************/ static DEFGENERIC *AddGeneric( void *theEnv, SYMBOL_HN *name, int *newGeneric) { DEFGENERIC *gfunc; gfunc = (DEFGENERIC *) EnvFindDefgeneric(theEnv,ValueToString(name)); if (gfunc != NULL) { *newGeneric = FALSE; if (ConstructData(theEnv)->CheckSyntaxMode) { return(gfunc); } /* ================================ The old trace state is preserved ================================ */ RemoveConstructFromModule(theEnv,(struct constructHeader *) gfunc); } else { *newGeneric = TRUE; gfunc = NewGeneric(theEnv,name); IncrementSymbolCount(name); AddImplicitMethods(theEnv,gfunc); } AddConstructToModule((struct constructHeader *) gfunc); return(gfunc); } /********************************************************************** NAME : AddGenericMethod DESCRIPTION : Inserts a blank method (with the method-index set) into the specified position of the generic method array INPUTS : 1) The generic function 2) The index where to add the method in the array 3) The method user-index (0 if don't care) RETURNS : The address of the new method SIDE EFFECTS : Fields initialized (index set) and new method inserted Generic function new method-index set to specified by user-index if > current new method-index NOTES : None **********************************************************************/ static DEFMETHOD *AddGenericMethod( void *theEnv, DEFGENERIC *gfunc, int mposn, unsigned mi) { DEFMETHOD *narr; register unsigned b, e; narr = (DEFMETHOD *) gm2(theEnv,(sizeof(DEFMETHOD) * (gfunc->mcnt+1))); for (b = e = 0 ; b < gfunc->mcnt ; b++ , e++) { if (b == (unsigned) mposn) e++; GenCopyMemory(DEFMETHOD,1,&narr[e],&gfunc->methods[b]); } if (mi == 0) narr[mposn].index = gfunc->new_index++; else { narr[mposn].index = mi; if (mi >= gfunc->new_index) gfunc->new_index = mi+1; } narr[mposn].busy = 0; #if DEBUGGING_FUNCTIONS narr[mposn].trace = DefgenericData(theEnv)->WatchMethods; #endif narr[mposn].minRestrictions = 0; narr[mposn].maxRestrictions = 0; narr[mposn].restrictionCount = 0; narr[mposn].localVarCount = 0; narr[mposn].system = 0; narr[mposn].restrictions = NULL; narr[mposn].actions = NULL; narr[mposn].ppForm = NULL; narr[mposn].usrData = NULL; if (gfunc->mcnt != 0) rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt)); gfunc->mcnt++; gfunc->methods = narr; return(&narr[mposn]); } /**************************************************************** NAME : RestrictionsCompare DESCRIPTION : Compares the restriction-expression list with an existing methods restrictions to determine an ordering INPUTS : 1) The parameter/restriction expression list 2) The total number of restrictions 3) The number of minimum restrictions 4) The number of maximum restrictions (-1 if unlimited) 5) The method with which to compare restrictions RETURNS : A code representing how the method restrictions -1 : New restrictions have higher precedence 0 : New restrictions are identical 1 : New restrictions have lower precedence SIDE EFFECTS : None NOTES : The new restrictions are stored in the argList pointers of the parameter expressions ****************************************************************/ static int RestrictionsCompare( EXPRESSION *params, int rcnt, int min, int max, DEFMETHOD *meth) { register int i; register RESTRICTION *r1,*r2; int diff = FALSE,rtn; for (i = 0 ; (i < rcnt) && (i < meth->restrictionCount) ; i++) { /* ============================================================= A wildcard parameter always has lower precedence than a regular parameter, regardless of the class restriction list ============================================================= */ if ((i == rcnt-1) && (max == -1) && (meth->maxRestrictions != -1)) return(LOWER_PRECEDENCE); if ((i == meth->restrictionCount-1) && (max != -1) && (meth->maxRestrictions == -1)) return(HIGHER_PRECEDENCE); /* ============================================================= The parameter with the most specific type list has precedence ============================================================= */ r1 = (RESTRICTION *) params->argList; r2 = &meth->restrictions[i]; rtn = TypeListCompare(r1,r2); if (rtn != IDENTICAL) return(rtn); /* ===================================================== The parameter with a query restriction has precedence ===================================================== */ if ((r1->query == NULL) && (r2->query != NULL)) return(LOWER_PRECEDENCE); if ((r1->query != NULL) && (r2->query == NULL)) return(HIGHER_PRECEDENCE); /* ========================================================== Remember if the method restrictions differ at all - query expressions must be identical as well for the restrictions to be the same ========================================================== */ if (IdenticalExpression(r1->query,r2->query) == FALSE) diff = TRUE; params = params->nextArg; } /* ============================================================= If the methods have the same number of parameters here, they are either the same restrictions, or they differ only in the query restrictions ============================================================= */ if (rcnt == meth->restrictionCount) return(diff ? LOWER_PRECEDENCE : IDENTICAL); /* ============================================= The method with the greater number of regular parameters has precedence If they require the smae # of reg params, then one without a wildcard has precedence ============================================= */ if (min > meth->minRestrictions) return(HIGHER_PRECEDENCE); if (meth->minRestrictions < min) return(LOWER_PRECEDENCE); return((max == - 1) ? LOWER_PRECEDENCE : HIGHER_PRECEDENCE); } /***************************************************** NAME : TypeListCompare DESCRIPTION : Determines the precedence between the class lists on two restrictions INPUTS : 1) Restriction address #1 2) Restriction address #2 RETURNS : -1 : r1 precedes r2 0 : Identical classes 1 : r2 precedes r1 SIDE EFFECTS : None NOTES : None *****************************************************/ static int TypeListCompare( RESTRICTION *r1, RESTRICTION *r2) { register int i,diff = FALSE; if ((r1->tcnt == 0) && (r2->tcnt == 0)) return(IDENTICAL); if (r1->tcnt == 0) return(LOWER_PRECEDENCE); if (r2->tcnt == 0) return(HIGHER_PRECEDENCE); for (i = 0 ; ((unsigned) i < r1->tcnt) && ((unsigned) i < r2->tcnt) ; i++) { if (r1->types[i] != r2->types[i]) { diff = TRUE; #if OBJECT_SYSTEM if (HasSuperclass((DEFCLASS *) r1->types[i],(DEFCLASS *) r2->types[i])) return(HIGHER_PRECEDENCE); if (HasSuperclass((DEFCLASS *) r2->types[i],(DEFCLASS *) r1->types[i])) return(LOWER_PRECEDENCE); #else if (SubsumeType(ValueToInteger(r1->types[i]),ValueToInteger(r2->types[i]))) return(HIGHER_PRECEDENCE); if (SubsumeType(ValueToInteger(r2->types[i]),ValueToInteger(r1->types[i]))) return(LOWER_PRECEDENCE); #endif } } if (r1->tcnt < r2->tcnt) return(HIGHER_PRECEDENCE); if (r1->tcnt > r2->tcnt) return(LOWER_PRECEDENCE); if (diff) return(LOWER_PRECEDENCE); return(IDENTICAL); } /*************************************************** NAME : NewGeneric DESCRIPTION : Allocates and initializes a new generic function header INPUTS : The name of the new generic RETURNS : The address of the new generic SIDE EFFECTS : Generic function header created NOTES : None ***************************************************/ static DEFGENERIC *NewGeneric( void *theEnv, SYMBOL_HN *gname) { DEFGENERIC *ngen; ngen = get_struct(theEnv,defgeneric); InitializeConstructHeader(theEnv,"defgeneric",(struct constructHeader *) ngen,gname); ngen->busy = 0; ngen->new_index = 1; ngen->methods = NULL; ngen->mcnt = 0; #if DEBUGGING_FUNCTIONS ngen->trace = DefgenericData(theEnv)->WatchGenerics; #endif return(ngen); } #endif /* DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips-6.24/clipssrc/retract.c0000755000175000017500000011424010441162477014352 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* RETRACT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Handles join network activity associated with */ /* with the removal of a data entity such as a fact or */ /* instance. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /*************************************************************/ #define _RETRACT_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "agenda.h" #include "argacces.h" #include "constant.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "lgcldpnd.h" #include "match.h" #include "memalloc.h" #include "network.h" #include "reteutil.h" #include "router.h" #include "symbol.h" #include "retract.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct partialMatch *RemovePartialMatches(void *,struct alphaMatch *, struct partialMatch *, struct partialMatch **,int, struct partialMatch **); static void DeletePartialMatches(void *,struct partialMatch *,int); static void ReturnMarkers(void *,struct multifieldMarker *); static void DriveRetractions(void *); static intBool FindNextConflictingAlphaMatch(void *,struct partialMatch *, struct partialMatch *, struct joinNode *); static intBool PartialMatchDefunct(void *,struct partialMatch *); /************************************************************/ /* NetworkRetract: Retracts a data entity (such as a fact */ /* or instance) from the pattern and join networks given */ /* a pointer to the list of patterns which the data */ /* entity matched. The data entity is first removed from */ /* the join network through patterns not directly */ /* enclosed within a not CE and then through patterns */ /* enclosed by a not CE. Any new partial matches created */ /* by the removal are then filtered through the join */ /* network. This ordering prevents partial matches from */ /* being generated that contain the data entity which was */ /* removed. */ /************************************************************/ globle void NetworkRetract( void *theEnv, struct patternMatch *listOfMatchedPatterns) { struct patternMatch *tempMatch; struct partialMatch *deletedMatches, *theLast; struct joinNode *joinPtr; /*===============================*/ /* Remember the beginning of the */ /* list of matched patterns. */ /*===============================*/ tempMatch = listOfMatchedPatterns; /*============================================*/ /* Remove the data entity from all joins that */ /* aren't directly enclosed by a not CE. */ /*============================================*/ for (; listOfMatchedPatterns != NULL; listOfMatchedPatterns = listOfMatchedPatterns->next) { /*====================================*/ /* Loop through the list of all joins */ /* attached to this pattern. */ /*====================================*/ for (joinPtr = listOfMatchedPatterns->matchingPattern->entryJoin; joinPtr != NULL; joinPtr = joinPtr->rightMatchNode) { if (joinPtr->patternIsNegated == FALSE) { PosEntryRetract(theEnv,joinPtr, listOfMatchedPatterns->theMatch->binds[0].gm.theMatch, listOfMatchedPatterns->theMatch, (int) joinPtr->depth - 1,listOfMatchedPatterns->theMatch->binds[0].gm.theMatch->matchingItem); } } } /*============================================*/ /* Remove the data entity from all joins that */ /* are directly enclosed by a not CE. */ /*============================================*/ listOfMatchedPatterns = tempMatch; while (listOfMatchedPatterns != NULL) { /*====================================*/ /* Loop through the list of all joins */ /* attached to this pattern. */ /*====================================*/ for (joinPtr = listOfMatchedPatterns->matchingPattern->entryJoin; joinPtr != NULL; joinPtr = joinPtr->rightMatchNode) { if (joinPtr->patternIsNegated == TRUE) { if (joinPtr->firstJoin == TRUE) { SystemError(theEnv,"RETRACT",3); EnvExitRouter(theEnv,EXIT_FAILURE); } else { NegEntryRetract(theEnv,joinPtr,listOfMatchedPatterns->theMatch,listOfMatchedPatterns->theMatch->binds[0].gm.theMatch->matchingItem); } } } /*===================================================*/ /* Remove from the alpha memory of the pattern node. */ /*===================================================*/ theLast = NULL; listOfMatchedPatterns->matchingPattern->alphaMemory = RemovePartialMatches(theEnv,listOfMatchedPatterns->theMatch->binds[0].gm.theMatch, listOfMatchedPatterns->matchingPattern->alphaMemory, &deletedMatches,0,&theLast); listOfMatchedPatterns->matchingPattern->endOfQueue = theLast; DeletePartialMatches(theEnv,deletedMatches,0); tempMatch = listOfMatchedPatterns->next; rtn_struct(theEnv,patternMatch,listOfMatchedPatterns); listOfMatchedPatterns = tempMatch; } /*=========================================*/ /* Filter new partial matches generated by */ /* retraction through the join network. */ /*=========================================*/ DriveRetractions(theEnv); } /***************************************************************/ /* PosEntryRetract: Handles retract for a join of a rule with */ /* a positive pattern when the retraction is starting from */ /* the RHS of that join (empty or positive LHS entry, */ /* positive RHS entry), or the LHS of that join (positive */ /* LHS entry, negative or positive RHS entry). */ /***************************************************************/ globle void PosEntryRetract( void *theEnv, struct joinNode *join, struct alphaMatch *theAlphaNode, struct partialMatch *theMatch, int position, void *duringRetract) { struct partialMatch *deletedMatches; struct joinNode *joinPtr; struct partialMatch *theLast; while (join != NULL) { /*=========================================*/ /* Remove the bindings from this join that */ /* contain the fact to be retracted. */ /*=========================================*/ if (join->beta == NULL) return; /* optimize */ join->beta = RemovePartialMatches(theEnv,theAlphaNode,join->beta,&deletedMatches, position,&theLast); /*===================================================*/ /* If no facts were deleted at this join, then there */ /* is no need to check joins at a lower level. */ /*===================================================*/ if (deletedMatches == NULL) return; /*==================================================*/ /* If there is more than one join below this join, */ /* then recursively remove fact bindings from all */ /* but one of the lower joins. Remove the bindings */ /* from the other join through this loop. */ /*==================================================*/ joinPtr = join->nextLevel; if (joinPtr == NULL) { DeletePartialMatches(theEnv,deletedMatches,1); return; } if (((struct joinNode *) (joinPtr->rightSideEntryStructure)) == join) { theMatch = deletedMatches; while (theMatch != NULL) { NegEntryRetract(theEnv,joinPtr,theMatch,duringRetract); theMatch = theMatch->next; } DeletePartialMatches(theEnv,deletedMatches,1); return; } DeletePartialMatches(theEnv,deletedMatches,1); while (joinPtr->rightDriveNode != NULL) { PosEntryRetract(theEnv,joinPtr,theAlphaNode,theMatch,position,duringRetract); joinPtr = joinPtr->rightDriveNode; } join = joinPtr; } } /*****************************************************************/ /* NegEntryRetract: Handles retract for a join of a rule with a */ /* not CE when the retraction is process from the RHS of that */ /* join. */ /*****************************************************************/ void NegEntryRetract( void *theEnv, struct joinNode *theJoin, struct partialMatch *theMatch, void *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(theEnv,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(theEnv,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(theEnv,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(theEnv,theLHS,listOfJoins,RHS); } else { if (duringRetract != NULL) { if (FindEntityInPartialMatch((struct patternEntity *) duringRetract,theLHS) == FALSE) { tempDR = get_struct(theEnv,rdriveinfo); tempDR->link = theLHS; tempDR->jlist = theJoin->nextLevel; tempDR->next = EngineData(theEnv)->DriveRetractionList; EngineData(theEnv)->DriveRetractionList = tempDR; } } else while (listOfJoins != NULL) { NetworkAssert(theEnv,theLHS,listOfJoins,LHS); listOfJoins = listOfJoins->rightDriveNode; } } } } } } /**************************************************************/ /* FindNextConflictingAlphaMatch: Finds the next conflicting */ /* partial match in the alpha memory of a join (or the beta */ /* memory of a join from the right) that prevents a partial */ /* match in the beta memory of the join from being */ /* satisfied. */ /**************************************************************/ static intBool FindNextConflictingAlphaMatch( void *theEnv, struct partialMatch *theBind, struct partialMatch *possibleConflicts, struct joinNode *theJoin) { int i, result; /*=====================================================*/ /* If we're dealing with a join from the right, then */ /* we need to check the entire beta memory of the join */ /* from the right (a join doesn't have an end of queue */ /* pointer like a pattern data structure has). */ /*=====================================================*/ if (theJoin->joinFromTheRight) { possibleConflicts = ((struct joinNode *) theJoin->rightSideEntryStructure)->beta; } /*====================================*/ /* Check each of the possible partial */ /* matches which could conflict. */ /*====================================*/ for (; possibleConflicts != NULL; possibleConflicts = possibleConflicts->next) { /*=====================================*/ /* Initially indicate that the partial */ /* match doesn't conflict. */ /*=====================================*/ result = FALSE; /*====================================================*/ /* A partial match with the counterf flag set is not */ /* yet a "real" partial match, so ignore it. When the */ /* counterf flag is set that means that the partial */ /* match is associated with a not CE that has a data */ /* entity preventing it from being satsified. */ /*====================================================*/ if (possibleConflicts->counterf) { /* Do Nothing */ } /*======================================================*/ /* 6.05 Bug Fix. It is possible that a pattern entity */ /* (e.g., instance) in a partial match is 'out of date' */ /* with respect to the lazy evaluation scheme use by */ /* negated patterns. In other words, the object may */ /* have changed since it was last pushed through the */ /* network, and thus the partial match may be invalid. */ /* If so, the partial match must be ignored here. */ /*======================================================*/ else if (PartialMatchDefunct(theEnv,possibleConflicts)) { /* Do Nothing */ } /*==================================================*/ /* If the join doesn't have a network expression to */ /* be evaluated, then partial match conflicts. If */ /* the partial match is retrieved from a join from */ /* the right, the RHS partial match must correspond */ /* to the partial match in the beta memory of the */ /* join being examined (in a join associated with a */ /* not CE, each partial match in the beta memory of */ /* the join corresponds uniquely to a partial match */ /* in either the alpha memory from the RHS or in */ /* the beta memory of a join from the right). */ /*==================================================*/ else if (theJoin->networkTest == NULL) { result = TRUE; if (theJoin->joinFromTheRight) { for (i = 0; i < (int) (theBind->bcount - 1); i++) { if (possibleConflicts->binds[i].gm.theMatch != theBind->binds[i].gm.theMatch) { result = FALSE; break; } } } } /*=================================================*/ /* Otherwise, if the join has a network expression */ /* to evaluate, then evaluate it. */ /*=================================================*/ else { result = EvaluateJoinExpression(theEnv,theJoin->networkTest,theBind, possibleConflicts,theJoin); if (EvaluationData(theEnv)->EvaluationError) { result = TRUE; EvaluationData(theEnv)->EvaluationError = FALSE; } } /*==============================================*/ /* If the network expression evaluated to TRUE, */ /* then partial match being examined conflicts. */ /* Point the beta memory partial match to the */ /* conflicting partial match and return TRUE to */ /* indicate a conflict was found. */ /*==============================================*/ if (result != FALSE) { theBind->binds[theBind->bcount - 1].gm.theValue = (void *) possibleConflicts; return(TRUE); } } /*========================*/ /* No conflict was found. */ /*========================*/ return(FALSE); } /***********************************************************/ /* PartialMatchDefunct: Determines if any pattern entities */ /* contained within the partial match have changed since */ /* this partial match was generated. Assumes counterf is */ /* FALSE. */ /***********************************************************/ static intBool PartialMatchDefunct( void *theEnv, struct partialMatch *thePM) { register unsigned i; register struct patternEntity * thePE; for (i = 0 ; i < thePM->bcount ; i++) { thePE = thePM->binds[i].gm.theMatch->matchingItem; if (thePE && thePE->theInfo->synchronized && !(*thePE->theInfo->synchronized)(theEnv,thePE)) return(TRUE); } return(FALSE); } /*************************************************************/ /* RemovePartialMatches: Searches through a list of partial */ /* matches and removes any partial match that contains the */ /* specified data entity. */ /*************************************************************/ static struct partialMatch *RemovePartialMatches( void *theEnv, struct alphaMatch *theAlphaNode, struct partialMatch *listOfPMs, struct partialMatch **deleteHead, int position, struct partialMatch **returnLast) { struct partialMatch *head, *lastPM, *nextPM; struct partialMatch *lastDelete = NULL; /*====================================================*/ /* Initialize pointers used for creating the new list */ /* of partial matches and the list of partial matches */ /* to be deleted. */ /*====================================================*/ head = listOfPMs; lastPM = listOfPMs; *deleteHead = NULL; /*==========================================*/ /* Loop through each of the partial matches */ /* and determine if it needs to be deleted. */ /*==========================================*/ while (listOfPMs != NULL) { if ((listOfPMs->counterf == TRUE) && (position == ((int) (listOfPMs->bcount - 1)))) { lastPM = listOfPMs; listOfPMs = listOfPMs->next; } /*=====================================================*/ /* Otherwise, if the specified position in the partial */ /* match contains the specified data entity, then */ /* remove the partial match from the list and add it */ /* to a deletion list. */ /*=====================================================*/ else if (listOfPMs->binds[position].gm.theMatch == theAlphaNode) { /*===================================================*/ /* If the partial match has an activation associated */ /* with it, then return the activation. */ /*===================================================*/ if ((listOfPMs->activationf) ? (listOfPMs->binds[listOfPMs->bcount].gm.theValue != NULL) : FALSE) { RemoveActivation(theEnv,(struct activation *) listOfPMs->binds[listOfPMs->bcount].gm.theValue,TRUE,TRUE); } /*==================================================*/ /* If the partial match is at the head of the list */ /* of matches, then use the following deletion code */ /* for the head of the list. */ /*==================================================*/ if (listOfPMs == head) { /*===================================*/ /* Remember the new beginning of the */ /* new list of partial matches. */ /*===================================*/ nextPM = listOfPMs->next; /*=============================================*/ /* Add the partial match to the deletion list. */ /*=============================================*/ if (*deleteHead == NULL) { *deleteHead = listOfPMs; } else { lastDelete->next = listOfPMs; } listOfPMs->next = NULL; lastDelete = listOfPMs; /*================================================*/ /* Update the head and tail pointers for the new */ /* list of partial matches as well as the pointer */ /* to the next partial match to be examined. */ /*================================================*/ listOfPMs = nextPM; head = listOfPMs; lastPM = head; } /*======================================*/ /* Otherwise, use the following code to */ /* delete the partial match. */ /*======================================*/ else { /*========================================*/ /* Detach the partial match being deleted */ /* from the new list of partial matches. */ /*========================================*/ lastPM->next = listOfPMs->next; /*=============================================*/ /* Add the partial match to the deletion list. */ /*=============================================*/ if (*deleteHead == NULL) { *deleteHead = listOfPMs; } else { lastDelete->next = listOfPMs; } listOfPMs->next = NULL; lastDelete = listOfPMs; /*=============================*/ /* Move on to the next partial */ /* match to be examined. */ /*=============================*/ listOfPMs = lastPM->next; } } /*==============================================*/ /* Otherwise, the partial match should be added */ /* to the new list of partial matches. */ /*==============================================*/ else { lastPM = listOfPMs; listOfPMs = listOfPMs->next; } } /*===============================================*/ /* Return the last partial match in the new list */ /* of partial matches via one of the function's */ /* parameters. */ /*===============================================*/ *returnLast = lastPM; /*=====================================================*/ /* Return the head of the new list of partial matches. */ /*=====================================================*/ return(head); } /***************************************************/ /* DeletePartialMatches: Returns a list of partial */ /* matches to the pool of free memory. */ /***************************************************/ static void DeletePartialMatches( void *theEnv, struct partialMatch *listOfPMs, int betaDelete) { struct partialMatch *nextPM; while (listOfPMs != NULL) { /*============================================*/ /* Remember the next partial match to delete. */ /*============================================*/ nextPM = listOfPMs->next; /*================================================*/ /* Remove the links between the partial match and */ /* any data entities that it is attached to as a */ /* result of a logical CE. */ /*================================================*/ if (listOfPMs->dependentsf) RemoveLogicalSupport(theEnv,listOfPMs); /*==========================================================*/ /* If the partial match is being deleted from a beta memory */ /* and the partial match isn't associated with a satisfied */ /* not CE, then it can be immediately returned to the pool */ /* of free memory. Otherwise, it's could be in use (either */ /* to retrieve variables from the LHS or by the activation */ /* of the rule). Since a not CE creates a "pseudo" data */ /* entity, the beta partial match which stores this pseudo */ /* data entity can not be deleted immediately (for the same */ /* reason an alpha memory partial match can't be deleted */ /* immediately). */ /*==========================================================*/ if (betaDelete && ((listOfPMs->notOriginf == FALSE) || (listOfPMs->counterf))) { ReturnPartialMatch(theEnv,listOfPMs); } else { listOfPMs->next = EngineData(theEnv)->GarbagePartialMatches; EngineData(theEnv)->GarbagePartialMatches = listOfPMs; } /*====================================*/ /* Move on to the next partial match. */ /*====================================*/ listOfPMs = nextPM; } } /**************************************************************/ /* ReturnPartialMatch: Returns the data structures associated */ /* with a partial match to the pool of free memory. */ /**************************************************************/ globle void ReturnPartialMatch( void *theEnv, struct partialMatch *waste) { /*==============================================*/ /* If the partial match is in use, then put it */ /* on a garbage list to be processed later when */ /* the partial match is not in use. */ /*==============================================*/ if (waste->busy) { waste->next = EngineData(theEnv)->GarbagePartialMatches; EngineData(theEnv)->GarbagePartialMatches = waste; return; } /*======================================================*/ /* If we're dealing with an alpha memory partial match, */ /* then return the multifield markers associated with */ /* the partial match (if any) along with the alphaMatch */ /* data structure. */ /*======================================================*/ if (waste->betaMemory == FALSE) { if (waste->binds[0].gm.theMatch->markers != NULL) { ReturnMarkers(theEnv,waste->binds[0].gm.theMatch->markers); } rm(theEnv,waste->binds[0].gm.theMatch,(int) sizeof(struct alphaMatch)); } /*=================================================*/ /* Remove any links between the partial match and */ /* a data entity that were created with the use of */ /* the logical CE. */ /*=================================================*/ if (waste->dependentsf) RemovePMDependencies(theEnv,waste); /*======================================================*/ /* Return the partial match to the pool of free memory. */ /*======================================================*/ rtn_var_struct(theEnv,partialMatch,(int) sizeof(struct genericMatch *) * (waste->bcount + waste->activationf + waste->dependentsf - 1), waste); } /***************************************************************/ /* DestroyPartialMatch: Returns the data structures associated */ /* with a partial match to the pool of free memory. */ /***************************************************************/ globle void DestroyPartialMatch( void *theEnv, struct partialMatch *waste) { /*======================================================*/ /* If we're dealing with an alpha memory partial match, */ /* then return the multifield markers associated with */ /* the partial match (if any) along with the alphaMatch */ /* data structure. */ /*======================================================*/ if (waste->betaMemory == FALSE) { if (waste->binds[0].gm.theMatch->markers != NULL) { ReturnMarkers(theEnv,waste->binds[0].gm.theMatch->markers); } rm(theEnv,waste->binds[0].gm.theMatch,(int) sizeof(struct alphaMatch)); } /*================================================*/ /* Remove the alpha match used to represent a not */ /* CE match in a beta memory partial match. */ /*================================================*/ if ((waste->notOriginf) && (waste->counterf == FALSE)) { if (waste->binds[waste->bcount - 1].gm.theMatch != NULL) { rtn_struct(theEnv,alphaMatch, waste->binds[waste->bcount - 1].gm.theMatch); } } /*=================================================*/ /* Remove any links between the partial match and */ /* a data entity that were created with the use of */ /* the logical CE. */ /*=================================================*/ if (waste->dependentsf) DestroyPMDependencies(theEnv,waste); /*======================================================*/ /* Return the partial match to the pool of free memory. */ /*======================================================*/ rtn_var_struct(theEnv,partialMatch,(int) sizeof(struct genericMatch *) * (waste->bcount + waste->activationf + waste->dependentsf - 1), waste); } /******************************************************/ /* ReturnMarkers: Returns a linked list of multifield */ /* markers associated with a data entity matching a */ /* pattern to the pool of free memory. */ /******************************************************/ static void ReturnMarkers( void *theEnv, struct multifieldMarker *waste) { struct multifieldMarker *temp; while (waste != NULL) { temp = waste->next; rtn_struct(theEnv,multifieldMarker,waste); waste = temp; } } /*************************************************/ /* DriveRetractions: Filters the list of partial */ /* matches created as a result of removing a */ /* data entity through the join network. */ /*************************************************/ static void DriveRetractions( void *theEnv) { struct rdriveinfo *tempDR; struct joinNode *joinPtr; while (EngineData(theEnv)->DriveRetractionList != NULL) { for (joinPtr = EngineData(theEnv)->DriveRetractionList->jlist; joinPtr != NULL; joinPtr = joinPtr->rightDriveNode) { NetworkAssert(theEnv,EngineData(theEnv)->DriveRetractionList->link,joinPtr,LHS); } tempDR = EngineData(theEnv)->DriveRetractionList->next; rtn_struct(theEnv,rdriveinfo,EngineData(theEnv)->DriveRetractionList); EngineData(theEnv)->DriveRetractionList = tempDR; } } /*************************************************/ /* RetractCheckDriveRetractions: */ /*************************************************/ globle void RetractCheckDriveRetractions( /* GDR 111599 #834 Begin */ void *theEnv, struct alphaMatch *theAlphaNode, int position) { struct rdriveinfo *tempDR, *theDR, *lastDR = NULL; theDR = EngineData(theEnv)->DriveRetractionList; while (theDR != NULL) { if ((position < (int) theDR->link->bcount) && (theDR->link->binds[position].gm.theMatch == theAlphaNode)) { tempDR = theDR->next; rtn_struct(theEnv,rdriveinfo,theDR); if (lastDR == NULL) { EngineData(theEnv)->DriveRetractionList = tempDR; } else { lastDR->next = tempDR; } theDR = tempDR; } else { lastDR = theDR; theDR = theDR->next; } } } /* GDR 111599 #834 End */ /*************************************************************/ /* FlushGarbagePartialMatches: Returns partial matches and */ /* associated structures that were removed as part of a */ /* retraction. It is necessary to postpone returning these */ /* structures to memory because RHS actions retrieve their */ /* variable bindings directly from the fact and instance */ /* data structures through the alpha memory bindings. */ /*************************************************************/ globle void FlushGarbagePartialMatches( void *theEnv) { struct partialMatch *pmPtr; struct alphaMatch *amPtr; /*===================================================*/ /* Return the garbage partial matches collected from */ /* the alpha memories of the pattern networks. */ /*===================================================*/ while (EngineData(theEnv)->GarbageAlphaMatches != NULL) { amPtr = EngineData(theEnv)->GarbageAlphaMatches->next; rtn_struct(theEnv,alphaMatch,EngineData(theEnv)->GarbageAlphaMatches); EngineData(theEnv)->GarbageAlphaMatches = amPtr; } /*==============================================*/ /* Return the garbage partial matches collected */ /* from the beta memories of the join networks. */ /*==============================================*/ while (EngineData(theEnv)->GarbagePartialMatches != NULL) { /*=====================================================*/ /* Remember the next garbage partial match to process. */ /*=====================================================*/ pmPtr = EngineData(theEnv)->GarbagePartialMatches->next; /*=======================================================*/ /* If a "pseudo" data entity was created for the partial */ /* match (i.e. a not CE was satisfied), then dispose of */ /* the pseudo data entity. */ /*=======================================================*/ if ((EngineData(theEnv)->GarbagePartialMatches->notOriginf) && (EngineData(theEnv)->GarbagePartialMatches->counterf == FALSE)) { if (EngineData(theEnv)->GarbagePartialMatches->binds[EngineData(theEnv)->GarbagePartialMatches->bcount - 1].gm.theMatch != NULL) { rtn_struct(theEnv,alphaMatch, EngineData(theEnv)->GarbagePartialMatches->binds[EngineData(theEnv)->GarbagePartialMatches->bcount - 1].gm.theMatch); } } /*============================================*/ /* Dispose of the garbage partial match being */ /* examined and move on to the next one. */ /*============================================*/ EngineData(theEnv)->GarbagePartialMatches->busy = FALSE; ReturnPartialMatch(theEnv,EngineData(theEnv)->GarbagePartialMatches); EngineData(theEnv)->GarbagePartialMatches = pmPtr; } } #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/developr.h0000755000175000017500000000420710441071241014520 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* DEVELOPER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /*************************************************************/ #ifndef _H_developr #define _H_developr #ifdef LOCALE #undef LOCALE #endif #ifdef _DEVELOPR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeveloperCommands(void *); LOCALE void PrimitiveTablesInfo(void *); LOCALE void PrimitiveTablesUsage(void *); LOCALE void EnableGCHeuristics(void *); LOCALE void DisableGCHeuristics(void *); #if DEFRULE_CONSTRUCT && DEFTEMPLATE_CONSTRUCT LOCALE void ShowFactPatternNetwork(void *); #endif #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM LOCALE void PrintObjectPatternNetwork(void *); #endif #if OBJECT_SYSTEM LOCALE void InstanceTableUsage(void *); #endif #endif clips-6.24/clipssrc/._userdata.h0000400000175000017500000000012207422634713014716 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._insfun.h0000400000175000017500000000075410441602232014405 0ustar jfsjfsMac OS X  2 RTEXT???? aTTFH MonacoYY9TTFL,<FMPSRMWBBLclips-6.24/clipssrc/objcmp.h0000755000175000017500000000357007422634676014202 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Object System Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_objcmp #define _H_objcmp #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_object #include "object.h" #endif #define OBJECT_COMPILER_DATA 36 struct objectCompilerData { #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *ObjectCodeItem; #endif }; #define ObjectCompilerData(theEnv) ((struct objectCompilerData *) GetEnvironmentData(theEnv,OBJECT_COMPILER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectsCompiler(void *); LOCALE void PrintClassReference(void *,FILE *,DEFCLASS *,int,int); LOCALE void DefclassCModuleReference(void *,FILE *,int,int,int); #endif clips-6.24/clipssrc/._modulbsc.c0000400000175000017500000000075410177533450014721 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z$H TTFT"FMWBBMPSRclips-6.24/clipssrc/globldef.h0000755000175000017500000001357310441143651014471 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFGLOBAL HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_globldef #define _H_globldef #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #define DEFGLOBAL_DATA 1 struct defglobalData { struct construct *DefglobalConstruct; int DefglobalModuleIndex; int ChangeToGlobals; intBool ResetGlobals; struct entityRecord GlobalInfo; struct entityRecord DefglobalPtrRecord; long LastModuleIndex; struct defmodule *TheDefmodule; #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefglobalCodeItem; #endif }; struct defglobal { struct constructHeader header; unsigned int watch : 1; unsigned int inScope : 1; long busyCount; DATA_OBJECT current; struct expr *initial; }; struct defglobalModule { struct defmoduleItemHeader header; }; #define EnvGetDefglobalName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define EnvGetDefglobalPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define EnvDefglobalModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define DefglobalData(theEnv) ((struct defglobalData *) GetEnvironmentData(theEnv,DEFGLOBAL_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DefglobalModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define FindDefglobal(theEnv,a) EnvFindDefglobal(theEnv,a) #define GetDefglobalName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define GetDefglobalPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetDefglobalValue(theEnv,a,b) EnvGetDefglobalValue(theEnv,a,b) #define GetDefglobalValueForm(theEnv,a,b,c) EnvGetDefglobalValueForm(theEnv,a,b,c) #define GetGlobalsChanged(theEnv) EnvGetGlobalsChanged(theEnv) #define GetNextDefglobal(theEnv,a) EnvGetNextDefglobal(theEnv,a) #define IsDefglobalDeletable(theEnv,a) EnvIsDefglobalDeletable(theEnv,a) #define SetDefglobalValue(theEnv,a,b) EnvSetDefglobalValue(theEnv,a,b) #define SetGlobalsChanged(theEnv,a) EnvSetGlobalsChanged(theEnv,a) #else #define DefglobalModule(x) GetConstructModuleName((struct constructHeader *) x) #define FindDefglobal(a) EnvFindDefglobal(GetCurrentEnvironment(),a) #define GetDefglobalName(x) GetConstructNameString((struct constructHeader *) x) #define GetDefglobalPPForm(x) GetConstructPPForm(GetCurrentEnvironment(),(struct constructHeader *) x) #define GetDefglobalValue(a,b) EnvGetDefglobalValue(GetCurrentEnvironment(),a,b) #define GetDefglobalValueForm(a,b,c) EnvGetDefglobalValueForm(GetCurrentEnvironment(),a,b,c) #define GetGlobalsChanged() EnvGetGlobalsChanged(GetCurrentEnvironment()) #define GetNextDefglobal(a) EnvGetNextDefglobal(GetCurrentEnvironment(),a) #define IsDefglobalDeletable(a) EnvIsDefglobalDeletable(GetCurrentEnvironment(),a) #define SetDefglobalValue(a,b) EnvSetDefglobalValue(GetCurrentEnvironment(),a,b) #define SetGlobalsChanged(a) EnvSetGlobalsChanged(GetCurrentEnvironment(),a) #endif LOCALE void InitializeDefglobals(void *); LOCALE void *EnvFindDefglobal(void *,char *); LOCALE void *EnvGetNextDefglobal(void *,void *); LOCALE void CreateInitialFactDefglobal(void); LOCALE intBool EnvIsDefglobalDeletable(void *,void *); LOCALE struct defglobalModule *GetDefglobalModuleItem(void *,struct defmodule *); LOCALE void QSetDefglobalValue(void *,struct defglobal *,DATA_OBJECT_PTR,int); LOCALE struct defglobal *QFindDefglobal(void *,struct symbolHashNode *); LOCALE void EnvGetDefglobalValueForm(void *,char *,unsigned,void *); LOCALE int EnvGetGlobalsChanged(void *); LOCALE void EnvSetGlobalsChanged(void *,int); LOCALE intBool EnvGetDefglobalValue(void *,char *,DATA_OBJECT_PTR); LOCALE intBool EnvSetDefglobalValue(void *,char *,DATA_OBJECT_PTR); LOCALE void UpdateDefglobalScope(void *); LOCALE void *GetNextDefglobalInScope(void *,void *); LOCALE int QGetDefglobalValue(void *,void *,DATA_OBJECT_PTR); #ifndef _GLOBLDEF_SOURCE_ #endif #endif clips-6.24/clipssrc/symblbin.c0000755000175000017500000004722707422634602014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* SYMBOL BSAVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for */ /* atomic data values. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _BSAVE_SOURCE_ #include "setup.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE || BLOAD_INSTANCES || BSAVE_INSTANCES #include "argacces.h" #include "bload.h" #include "bsave.h" #include "cstrnbin.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "moduldef.h" #include "router.h" #include "symblbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ReadNeededBitMaps(void *); #if BLOAD_AND_BSAVE || BSAVE_INSTANCES static void WriteNeededBitMaps(void *,FILE *); #endif #if BLOAD_AND_BSAVE || BSAVE_INSTANCES /**********************************************/ /* WriteNeededAtomicValues: Save all symbols, */ /* floats, integers, and bitmaps needed by */ /* this binary image to the binary file. */ /**********************************************/ globle void WriteNeededAtomicValues( void *theEnv, FILE *fp) { WriteNeededSymbols(theEnv,fp); WriteNeededFloats(theEnv,fp); WriteNeededIntegers(theEnv,fp); WriteNeededBitMaps(theEnv,fp); } /********************************************************/ /* InitAtomicValueNeededFlags: Initializes all symbols, */ /* floats, integers, and bitmaps as being unneeded by */ /* the binary image being saved. */ /********************************************************/ globle void InitAtomicValueNeededFlags( void *theEnv) { unsigned long i; SYMBOL_HN *symbolPtr, **symbolArray; FLOAT_HN *floatPtr, **floatArray; INTEGER_HN *integerPtr, **integerArray; BITMAP_HN *bitMapPtr, **bitMapArray; /*===============*/ /* Mark symbols. */ /*===============*/ symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { symbolPtr = symbolArray[i]; while (symbolPtr != NULL) { symbolPtr->neededSymbol = FALSE; symbolPtr = symbolPtr->next; } } /*==============*/ /* Mark floats. */ /*==============*/ floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { floatPtr = floatArray[i]; while (floatPtr != NULL) { floatPtr->neededFloat = FALSE; floatPtr = floatPtr->next; } } /*================*/ /* Mark integers. */ /*================*/ integerArray = GetIntegerTable(theEnv); for (i = 0; i < INTEGER_HASH_SIZE; i++) { integerPtr = integerArray[i]; while (integerPtr != NULL) { integerPtr->neededInteger = FALSE; integerPtr = integerPtr->next; } } /*===============*/ /* Mark bitmaps. */ /*===============*/ bitMapArray = GetBitMapTable(theEnv); for (i = 0; i < BITMAP_HASH_SIZE; i++) { bitMapPtr = bitMapArray[i]; while (bitMapPtr != NULL) { bitMapPtr->neededBitMap = FALSE; bitMapPtr = bitMapPtr->next; } } } /*****************************************************************/ /* WriteNeededSymbols: Stores all of the symbols in the symbol */ /* table needed for this binary image in the binary save file. */ /*****************************************************************/ globle void WriteNeededSymbols( void *theEnv, FILE *fp) { unsigned long i; unsigned length; SYMBOL_HN **symbolArray; SYMBOL_HN *symbolPtr; unsigned long int numberOfUsedSymbols = 0, size = 0; /*=================================*/ /* Get a copy of the symbol table. */ /*=================================*/ symbolArray = GetSymbolTable(theEnv); /*======================================================*/ /* Get the number of symbols and the total string size. */ /*======================================================*/ for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { if (symbolPtr->neededSymbol) { numberOfUsedSymbols++; size += strlen(symbolPtr->contents) + 1; } } } /*=============================================*/ /* Write out the symbols and the string sizes. */ /*=============================================*/ GenWrite((void *) &numberOfUsedSymbols,(unsigned long) sizeof(unsigned long int),fp); GenWrite((void *) &size,(unsigned long) sizeof(unsigned long int),fp); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { if (symbolPtr->neededSymbol) { length = strlen(symbolPtr->contents) + 1; GenWrite((void *) symbolPtr->contents,(unsigned long) length,fp); } } } } /*****************************************************************/ /* WriteNeededFloats: Stores all of the floats in the float */ /* table needed for this binary image in the binary save file. */ /*****************************************************************/ globle void WriteNeededFloats( void *theEnv, FILE *fp) { int i; FLOAT_HN **floatArray; FLOAT_HN *floatPtr; unsigned long int numberOfUsedFloats = 0; /*================================*/ /* Get a copy of the float table. */ /*================================*/ floatArray = GetFloatTable(theEnv); /*===========================*/ /* Get the number of floats. */ /*===========================*/ for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { if (floatPtr->neededFloat) numberOfUsedFloats++; } } /*======================================================*/ /* Write out the number of floats and the float values. */ /*======================================================*/ GenWrite(&numberOfUsedFloats,(unsigned long) sizeof(unsigned long int),fp); for (i = 0 ; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { if (floatPtr->neededFloat) { GenWrite(&floatPtr->contents, (unsigned long) sizeof(floatPtr->contents),fp); } } } } /******************************************************************/ /* WriteNeededIntegers: Stores all of the integers in the integer */ /* table needed for this binary image in the binary save file. */ /******************************************************************/ globle void WriteNeededIntegers( void *theEnv, FILE *fp) { int i; INTEGER_HN **integerArray; INTEGER_HN *integerPtr; unsigned long int numberOfUsedIntegers = 0; /*==================================*/ /* Get a copy of the integer table. */ /*==================================*/ integerArray = GetIntegerTable(theEnv); /*=============================*/ /* Get the number of integers. */ /*=============================*/ for (i = 0 ; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { if (integerPtr->neededInteger) numberOfUsedIntegers++; } } /*==========================================================*/ /* Write out the number of integers and the integer values. */ /*==========================================================*/ GenWrite(&numberOfUsedIntegers,(unsigned long) sizeof(unsigned long int),fp); for (i = 0 ; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { if (integerPtr->neededInteger) { GenWrite(&integerPtr->contents, (unsigned long) sizeof(integerPtr->contents),fp); } } } } /*****************************************************************/ /* WriteNeededBitMaps: Stores all of the bitmaps in the bitmap */ /* table needed for this binary image in the binary save file. */ /*****************************************************************/ static void WriteNeededBitMaps( void *theEnv, FILE *fp) { int i; BITMAP_HN **bitMapArray; BITMAP_HN *bitMapPtr; unsigned long int numberOfUsedBitMaps = 0, size = 0; char tempSize; /*=================================*/ /* Get a copy of the bitmap table. */ /*=================================*/ bitMapArray = GetBitMapTable(theEnv); /*======================================================*/ /* Get the number of bitmaps and the total bitmap size. */ /*======================================================*/ for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { if (bitMapPtr->neededBitMap) { numberOfUsedBitMaps++; size += (unsigned long) (bitMapPtr->size + 1); } } } /*========================================*/ /* Write out the bitmaps and their sizes. */ /*========================================*/ GenWrite((void *) &numberOfUsedBitMaps,(unsigned long) sizeof(unsigned long int),fp); GenWrite((void *) &size,(unsigned long) sizeof(unsigned long int),fp); for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { if (bitMapPtr->neededBitMap) { tempSize = (char) bitMapPtr->size; GenWrite((void *) &tempSize,(unsigned long) sizeof(char),fp); GenWrite((void *) bitMapPtr->contents,(unsigned long) bitMapPtr->size,fp); } } } } #endif /* BLOAD_AND_BSAVE || BSAVE_INSTANCES */ /*********************************************/ /* ReadNeededAtomicValues: Read all symbols, */ /* floats, integers, and bitmaps needed by */ /* this binary image from the binary file. */ /*********************************************/ globle void ReadNeededAtomicValues( void *theEnv) { ReadNeededSymbols(theEnv); ReadNeededFloats(theEnv); ReadNeededIntegers(theEnv); ReadNeededBitMaps(theEnv); } /*******************************************/ /* ReadNeededSymbols: Reads in the symbols */ /* used by the binary image. */ /*******************************************/ globle void ReadNeededSymbols( void *theEnv) { char *symbolNames, *namePtr; unsigned long space; long i; /*=================================================*/ /* Determine the number of symbol names to be read */ /* and space required for them. */ /*=================================================*/ GenReadBinary(theEnv,(void *) &SymbolData(theEnv)->NumberOfSymbols,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); if (SymbolData(theEnv)->NumberOfSymbols == 0) { SymbolData(theEnv)->SymbolArray = NULL; return; } /*=======================================*/ /* Allocate area for strings to be read. */ /*=======================================*/ symbolNames = (char *) gm3(theEnv,(long) space); GenReadBinary(theEnv,(void *) symbolNames,space); /*================================================*/ /* Store the symbol pointers in the symbol array. */ /*================================================*/ SymbolData(theEnv)->SymbolArray = (SYMBOL_HN **) gm3(theEnv,(long) sizeof(SYMBOL_HN *) * SymbolData(theEnv)->NumberOfSymbols); namePtr = symbolNames; for (i = 0; i < SymbolData(theEnv)->NumberOfSymbols; i++) { SymbolData(theEnv)->SymbolArray[i] = (SYMBOL_HN *) EnvAddSymbol(theEnv,namePtr); namePtr += strlen(namePtr) + 1; } /*=======================*/ /* Free the name buffer. */ /*=======================*/ rm3(theEnv,(void *) symbolNames,(long) space); } /*****************************************/ /* ReadNeededFloats: Reads in the floats */ /* used by the binary image. */ /*****************************************/ globle void ReadNeededFloats( void *theEnv) { double *floatValues; long i; /*============================================*/ /* Determine the number of floats to be read. */ /*============================================*/ GenReadBinary(theEnv,&SymbolData(theEnv)->NumberOfFloats,(unsigned long) sizeof(long int)); if (SymbolData(theEnv)->NumberOfFloats == 0) { SymbolData(theEnv)->FloatArray = NULL; return; } /*===============================*/ /* Allocate area for the floats. */ /*===============================*/ floatValues = (double *) gm3(theEnv,(long) sizeof(double) * SymbolData(theEnv)->NumberOfFloats); GenReadBinary(theEnv,(void *) floatValues,(unsigned long) (sizeof(double) * SymbolData(theEnv)->NumberOfFloats)); /*======================================*/ /* Store the floats in the float array. */ /*======================================*/ SymbolData(theEnv)->FloatArray = (FLOAT_HN **) gm3(theEnv,(long) sizeof(FLOAT_HN *) * SymbolData(theEnv)->NumberOfFloats); for (i = 0; i < SymbolData(theEnv)->NumberOfFloats; i++) { SymbolData(theEnv)->FloatArray[i] = (FLOAT_HN *) EnvAddDouble(theEnv,floatValues[i]); } /*========================*/ /* Free the float buffer. */ /*========================*/ rm3(theEnv,(void *) floatValues,(long) (sizeof(double) * SymbolData(theEnv)->NumberOfFloats)); } /*********************************************/ /* ReadNeededIntegers: Reads in the integers */ /* used by the binary image. */ /*********************************************/ globle void ReadNeededIntegers( void *theEnv) { long int *integerValues; long i; /*==============================================*/ /* Determine the number of integers to be read. */ /*==============================================*/ GenReadBinary(theEnv,&SymbolData(theEnv)->NumberOfIntegers,(unsigned long) sizeof(unsigned long int)); if (SymbolData(theEnv)->NumberOfIntegers == 0) { SymbolData(theEnv)->IntegerArray = NULL; return; } /*=================================*/ /* Allocate area for the integers. */ /*=================================*/ integerValues = (long *) gm3(theEnv,(long) (sizeof(long) * SymbolData(theEnv)->NumberOfIntegers)); GenReadBinary(theEnv,(void *) integerValues,(unsigned long) (sizeof(long) * SymbolData(theEnv)->NumberOfIntegers)); /*==========================================*/ /* Store the integers in the integer array. */ /*==========================================*/ SymbolData(theEnv)->IntegerArray = (INTEGER_HN **) gm3(theEnv,(long) (sizeof(INTEGER_HN *) * SymbolData(theEnv)->NumberOfIntegers)); for (i = 0; i < SymbolData(theEnv)->NumberOfIntegers; i++) { SymbolData(theEnv)->IntegerArray[i] = (INTEGER_HN *) EnvAddLong(theEnv,integerValues[i]); } /*==========================*/ /* Free the integer buffer. */ /*==========================*/ rm3(theEnv,(void *) integerValues,(long) (sizeof(long int) * SymbolData(theEnv)->NumberOfIntegers)); } /*******************************************/ /* ReadNeededBitMaps: Reads in the bitmaps */ /* used by the binary image. */ /*******************************************/ static void ReadNeededBitMaps( void *theEnv) { char *bitMapStorage, *bitMapPtr; unsigned long space; long i; /*=======================================*/ /* Determine the number of bitmaps to be */ /* read and space required for them. */ /*=======================================*/ GenReadBinary(theEnv,(void *) &SymbolData(theEnv)->NumberOfBitMaps,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); if (SymbolData(theEnv)->NumberOfBitMaps == 0) { SymbolData(theEnv)->BitMapArray = NULL; return; } /*=======================================*/ /* Allocate area for bitmaps to be read. */ /*=======================================*/ bitMapStorage = (char *) gm3(theEnv,(long) space); GenReadBinary(theEnv,(void *) bitMapStorage,space); /*================================================*/ /* Store the bitMap pointers in the bitmap array. */ /*================================================*/ SymbolData(theEnv)->BitMapArray = (BITMAP_HN **) gm3(theEnv,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps); bitMapPtr = bitMapStorage; for (i = 0; i < SymbolData(theEnv)->NumberOfBitMaps; i++) { SymbolData(theEnv)->BitMapArray[i] = (BITMAP_HN *) AddBitMap(theEnv,bitMapPtr+1,*bitMapPtr); bitMapPtr += *bitMapPtr + 1; } /*=========================*/ /* Free the bitmap buffer. */ /*=========================*/ rm3(theEnv,(void *) bitMapStorage,(long) space); } /**********************************************************/ /* FreeAtomicValueStorage: Returns the memory allocated */ /* for storing the pointers to atomic data values used */ /* in refreshing expressions and other data structures. */ /**********************************************************/ globle void FreeAtomicValueStorage( void *theEnv) { if (SymbolData(theEnv)->SymbolArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->SymbolArray,(long) sizeof(SYMBOL_HN *) * SymbolData(theEnv)->NumberOfSymbols); if (SymbolData(theEnv)->FloatArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->FloatArray,(long) sizeof(FLOAT_HN *) * SymbolData(theEnv)->NumberOfFloats); if (SymbolData(theEnv)->IntegerArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->IntegerArray,(long) sizeof(INTEGER_HN *) * SymbolData(theEnv)->NumberOfIntegers); if (SymbolData(theEnv)->BitMapArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->BitMapArray,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps); SymbolData(theEnv)->SymbolArray = NULL; SymbolData(theEnv)->FloatArray = NULL; SymbolData(theEnv)->IntegerArray = NULL; SymbolData(theEnv)->BitMapArray = NULL; SymbolData(theEnv)->NumberOfSymbols = 0; SymbolData(theEnv)->NumberOfFloats = 0; SymbolData(theEnv)->NumberOfIntegers = 0; SymbolData(theEnv)->NumberOfBitMaps = 0; } #endif /* BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE || BLOAD_INSTANCES || BSAVE_INSTANCES */ clips-6.24/clipssrc/router.c0000755000175000017500000005512710441602316014225 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* I/O ROUTER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a centralized mechanism for handling */ /* input and output requests. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.24: Removed conversion of '\r' to '\n' from the */ /* EnvGetcRouter function. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added support for passing context information */ /* to the router functions. */ /* */ /*************************************************************/ #define _ROUTER_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "argacces.h" #include "constant.h" #include "envrnmnt.h" #include "extnfunc.h" #include "filertr.h" #include "memalloc.h" #include "strngrtr.h" #include "sysdep.h" #include "router.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int QueryRouter(void *,char *,struct router *); static void DeallocateRouterData(void *); /*********************************************************/ /* InitializeDefaultRouters: Initializes output streams. */ /*********************************************************/ globle void InitializeDefaultRouters( void *theEnv) { AllocateEnvironmentData(theEnv,ROUTER_DATA,sizeof(struct routerData),DeallocateRouterData); RouterData(theEnv)->CommandBufferInputCount = -1; #if (! RUN_TIME) EnvDefineFunction2(theEnv,"exit", 'v', PTIEF ExitCommand, "ExitCommand", "*1i"); #endif InitializeFileRouter(theEnv); InitializeStringRouter(theEnv); } /*************************************************/ /* DeallocateRouterData: Deallocates environment */ /* data for I/O routers. */ /*************************************************/ static void DeallocateRouterData( void *theEnv) { struct router *tmpPtr, *nextPtr; tmpPtr = RouterData(theEnv)->ListOfRouters; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,router,tmpPtr); tmpPtr = nextPtr; } } /*******************************************/ /* EnvPrintRouter: Generic print function. */ /*******************************************/ globle int EnvPrintRouter( void *theEnv, char *logicalName, char *str) { struct router *currentPtr; /*===================================================*/ /* If the "fast save" option is being used, then the */ /* logical name is actually a pointer to a file and */ /* fprintf can be called directly to bypass querying */ /* all of the routers. */ /*===================================================*/ if (((char *) RouterData(theEnv)->FastSaveFilePtr) == logicalName) { fprintf(RouterData(theEnv)->FastSaveFilePtr,"%s",str); return(2); } /*==============================================*/ /* Search through the list of routers until one */ /* is found that will handle the print request. */ /*==============================================*/ currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { SetEnvironmentRouterContext(theEnv,currentPtr->context); if ((currentPtr->printer != NULL) ? QueryRouter(theEnv,logicalName,currentPtr) : FALSE) { if (currentPtr->environmentAware) { (*currentPtr->printer)(theEnv,logicalName,str); } else { ((int (*)(char *,char *)) (*currentPtr->printer))(logicalName,str); } return(1); } currentPtr = currentPtr->next; } /*=====================================================*/ /* The logical name was not recognized by any routers. */ /*=====================================================*/ if (strcmp(WERROR,logicalName) != 0) UnrecognizedRouterMessage(theEnv,logicalName); return(0); } /**************************************************/ /* EnvGetcRouter: Generic get character function. */ /**************************************************/ globle int EnvGetcRouter( void *theEnv, char *logicalName) { struct router *currentPtr; int inchar; /*===================================================*/ /* If the "fast load" option is being used, then the */ /* logical name is actually a pointer to a file and */ /* getc can be called directly to bypass querying */ /* all of the routers. */ /*===================================================*/ if (((char *) RouterData(theEnv)->FastLoadFilePtr) == logicalName) { inchar = getc(RouterData(theEnv)->FastLoadFilePtr); if ((inchar == '\r') || (inchar == '\n')) { if (((char *) RouterData(theEnv)->FastLoadFilePtr) == RouterData(theEnv)->LineCountRouter) { IncrementLineCount(theEnv); } } /* if (inchar == '\r') return('\n'); */ return(inchar); } /*===============================================*/ /* If the "fast string get" option is being used */ /* for the specified logical name, then bypass */ /* the router system and extract the character */ /* directly from the fast get string. */ /*===============================================*/ if (RouterData(theEnv)->FastCharGetRouter == logicalName) { inchar = (unsigned char) RouterData(theEnv)->FastCharGetString[RouterData(theEnv)->FastCharGetIndex]; RouterData(theEnv)->FastCharGetIndex++; if (inchar == '\0') return(EOF); if ((inchar == '\r') || (inchar == '\n')) { if (RouterData(theEnv)->FastCharGetRouter == RouterData(theEnv)->LineCountRouter) { IncrementLineCount(theEnv); } } /* if (inchar == '\r') return('\n'); */ return(inchar); } /*==============================================*/ /* Search through the list of routers until one */ /* is found that will handle the getc request. */ /*==============================================*/ currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if ((currentPtr->charget != NULL) ? QueryRouter(theEnv,logicalName,currentPtr) : FALSE) { if (currentPtr->environmentAware) { inchar = (*currentPtr->charget)(theEnv,logicalName); } else { inchar = ((int (*)(char *)) (*currentPtr->charget))(logicalName); } if ((inchar == '\r') || (inchar == '\n')) { if ((RouterData(theEnv)->LineCountRouter != NULL) && (strcmp(logicalName,RouterData(theEnv)->LineCountRouter) == 0)) { IncrementLineCount(theEnv); } } /* if (inchar == '\r') return('\n'); */ /* if (inchar != '\b') { return(inchar); } */ return(inchar); } currentPtr = currentPtr->next; } /*=====================================================*/ /* The logical name was not recognized by any routers. */ /*=====================================================*/ UnrecognizedRouterMessage(theEnv,logicalName); return(-1); } /******************************************************/ /* EnvUngetcRouter: Generic unget character function. */ /******************************************************/ globle int EnvUngetcRouter( void *theEnv, int ch, char *logicalName) { struct router *currentPtr; /*===================================================*/ /* If the "fast load" option is being used, then the */ /* logical name is actually a pointer to a file and */ /* ungetc can be called directly to bypass querying */ /* all of the routers. */ /*===================================================*/ if (((char *) RouterData(theEnv)->FastLoadFilePtr) == logicalName) { if ((ch == '\r') || (ch == '\n')) { if (((char *) RouterData(theEnv)->FastLoadFilePtr) == RouterData(theEnv)->LineCountRouter) { DecrementLineCount(theEnv); } } return(ungetc(ch,RouterData(theEnv)->FastLoadFilePtr)); } /*===============================================*/ /* If the "fast string get" option is being used */ /* for the specified logical name, then bypass */ /* the router system and unget the character */ /* directly from the fast get string. */ /*===============================================*/ if (RouterData(theEnv)->FastCharGetRouter == logicalName) { if ((ch == '\r') || (ch == '\n')) { if (RouterData(theEnv)->FastCharGetRouter == RouterData(theEnv)->LineCountRouter) { DecrementLineCount(theEnv); } } if (RouterData(theEnv)->FastCharGetIndex > 0) RouterData(theEnv)->FastCharGetIndex--; return(ch); } /*===============================================*/ /* Search through the list of routers until one */ /* is found that will handle the ungetc request. */ /*===============================================*/ currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if ((currentPtr->charunget != NULL) ? QueryRouter(theEnv,logicalName,currentPtr) : FALSE) { if ((ch == '\r') || (ch == '\n')) { if ((RouterData(theEnv)->LineCountRouter != NULL) && (strcmp(logicalName,RouterData(theEnv)->LineCountRouter) == 0)) { DecrementLineCount(theEnv); } } if (currentPtr->environmentAware) { return((*currentPtr->charunget)(theEnv,ch,logicalName)); } else { return(((int (*)(int,char *)) (*currentPtr->charunget))(ch,logicalName)); } } currentPtr = currentPtr->next; } /*=====================================================*/ /* The logical name was not recognized by any routers. */ /*=====================================================*/ UnrecognizedRouterMessage(theEnv,logicalName); return(-1); } /*****************************************************/ /* ExitCommand: H/L command for exiting the program. */ /*****************************************************/ globle void ExitCommand( void *theEnv) { int argCnt; int status; if ((argCnt = EnvArgCountCheck(theEnv,"exit",NO_MORE_THAN,1)) == -1) return; if (argCnt == 0) { EnvExitRouter(theEnv,EXIT_SUCCESS); } else { status = (int) EnvRtnLong(theEnv,1); if (GetEvaluationError(theEnv)) return; EnvExitRouter(theEnv,status); } return; } /***********************************************/ /* EnvExitRouter: Generic exit function. Calls */ /* all of the router exit functions. */ /***********************************************/ globle void EnvExitRouter( void *theEnv, int num) { struct router *currentPtr, *nextPtr; RouterData(theEnv)->Abort = FALSE; currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { nextPtr = currentPtr->next; if (currentPtr->active == TRUE) { if (currentPtr->exiter != NULL) { if (currentPtr->environmentAware) { (*currentPtr->exiter)(theEnv,num); } else { ((int (*)(int))(*currentPtr->exiter))(num); } } } currentPtr = nextPtr; } if (RouterData(theEnv)->Abort) return; genexit(num); } /********************************************/ /* AbortExit: Forces ExitRouter to terminate */ /* after calling all closing routers. */ /********************************************/ globle void AbortExit( void *theEnv) { RouterData(theEnv)->Abort = TRUE; } #if (! ENVIRONMENT_API_ONLY) && ALLOW_ENVIRONMENT_GLOBALS /*********************************************************/ /* AddRouter: Adds an I/O router to the list of routers. */ /*********************************************************/ globle intBool AddRouter( char *routerName, int priority, int (*queryFunction)(char *), int (*printFunction)(char *,char *), int (*getcFunction)(char *), int (*ungetcFunction)(int,char *), int (*exitFunction)(int)) { struct router *newPtr, *lastPtr, *currentPtr; void *theEnv; theEnv = GetCurrentEnvironment(); newPtr = get_struct(theEnv,router); newPtr->name = routerName; newPtr->active = TRUE; newPtr->environmentAware = FALSE; newPtr->priority = priority; newPtr->context = NULL; newPtr->query = (int (*)(void *,char *)) queryFunction; newPtr->printer = (int (*)(void *,char *,char *)) printFunction; newPtr->exiter = (int (*)(void *,int)) exitFunction; newPtr->charget = (int (*)(void *,char *)) getcFunction; newPtr->charunget = (int (*)(void *,int,char *)) ungetcFunction; newPtr->next = NULL; if (RouterData(theEnv)->ListOfRouters == NULL) { RouterData(theEnv)->ListOfRouters = newPtr; return(1); } lastPtr = NULL; currentPtr = RouterData(theEnv)->ListOfRouters; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = RouterData(theEnv)->ListOfRouters; RouterData(theEnv)->ListOfRouters = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(1); } #endif /************************************************************/ /* EnvAddRouter: Adds an I/O router to the list of routers. */ /************************************************************/ globle intBool EnvAddRouter( void *theEnv, char *routerName, int priority, int (*queryFunction)(void *,char *), int (*printFunction)(void *,char *,char *), int (*getcFunction)(void *,char *), int (*ungetcFunction)(void *,int,char *), int (*exitFunction)(void *,int)) { return EnvAddRouterWithContext(theEnv,routerName,priority, queryFunction,printFunction,getcFunction, ungetcFunction,exitFunction,NULL); } /***********************************************************************/ /* EnvAddRouterWithContext: Adds an I/O router to the list of routers. */ /***********************************************************************/ globle intBool EnvAddRouterWithContext( void *theEnv, char *routerName, int priority, int (*queryFunction)(void *,char *), int (*printFunction)(void *,char *,char *), int (*getcFunction)(void *,char *), int (*ungetcFunction)(void *,int,char *), int (*exitFunction)(void *,int), void *context) { struct router *newPtr, *lastPtr, *currentPtr; newPtr = get_struct(theEnv,router); newPtr->name = routerName; newPtr->active = TRUE; newPtr->environmentAware = TRUE; newPtr->context = context; newPtr->priority = priority; newPtr->query = queryFunction; newPtr->printer = printFunction; newPtr->exiter = exitFunction; newPtr->charget = getcFunction; newPtr->charunget = ungetcFunction; newPtr->next = NULL; if (RouterData(theEnv)->ListOfRouters == NULL) { RouterData(theEnv)->ListOfRouters = newPtr; return(1); } lastPtr = NULL; currentPtr = RouterData(theEnv)->ListOfRouters; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = RouterData(theEnv)->ListOfRouters; RouterData(theEnv)->ListOfRouters = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(1); } /*****************************************************************/ /* EnvDeleteRouter: Removes an I/O router from the list of routers. */ /*****************************************************************/ globle int EnvDeleteRouter( void *theEnv, char *routerName) { struct router *currentPtr, *lastPtr; currentPtr = RouterData(theEnv)->ListOfRouters; lastPtr = NULL; while (currentPtr != NULL) { if (strcmp(currentPtr->name,routerName) == 0) { if (lastPtr == NULL) { RouterData(theEnv)->ListOfRouters = currentPtr->next; rm(theEnv,currentPtr,(int) sizeof(struct router)); return(1); } lastPtr->next = currentPtr->next; rm(theEnv,currentPtr,(int) sizeof(struct router)); return(1); } lastPtr = currentPtr; currentPtr = currentPtr->next; } return(0); } /*********************************************************************/ /* QueryRouters: Determines if any router recognizes a logical name. */ /*********************************************************************/ globle int QueryRouters( void *theEnv, char *logicalName) { struct router *currentPtr; currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if (QueryRouter(theEnv,logicalName,currentPtr) == TRUE) return(TRUE); currentPtr = currentPtr->next; } return(FALSE); } /************************************************/ /* QueryRouter: Determines if a specific router */ /* recognizes a logical name. */ /************************************************/ static int QueryRouter( void *theEnv, char *logicalName, struct router *currentPtr) { /*===================================================*/ /* If the router is inactive, then it can't respond. */ /*===================================================*/ if (currentPtr->active == FALSE) { return(FALSE); } /*=============================================================*/ /* If the router has no query function, then it can't respond. */ /*=============================================================*/ if (currentPtr->query == NULL) return(FALSE); /*=========================================*/ /* Call the router's query function to see */ /* if it recognizes the logical name. */ /*=========================================*/ if (currentPtr->environmentAware) { if ((*currentPtr->query)(theEnv,logicalName) == TRUE) { return(TRUE); } } else { if (((int (*)(char *)) (*currentPtr->query))(logicalName) == TRUE) { return(TRUE); } } return(FALSE); } /*******************************************************/ /* EnvDeactivateRouter: Deactivates a specific router. */ /*******************************************************/ globle int EnvDeactivateRouter( void *theEnv, char *routerName) { struct router *currentPtr; currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if (strcmp(currentPtr->name,routerName) == 0) { currentPtr->active = FALSE; return(TRUE); } currentPtr = currentPtr->next; } return(FALSE); } /***************************************************/ /* EnvActivateRouter: Activates a specific router. */ /***************************************************/ globle int EnvActivateRouter( void *theEnv, char *routerName) { struct router *currentPtr; currentPtr = RouterData(theEnv)->ListOfRouters; while (currentPtr != NULL) { if (strcmp(currentPtr->name,routerName) == 0) { currentPtr->active = TRUE; return(TRUE); } currentPtr = currentPtr->next; } return(FALSE); } /********************************************************/ /* SetFastLoad: Used to bypass router system for loads. */ /********************************************************/ globle void SetFastLoad( void *theEnv, FILE *filePtr) { RouterData(theEnv)->FastLoadFilePtr = filePtr; } /********************************************************/ /* SetFastSave: Used to bypass router system for saves. */ /********************************************************/ globle void SetFastSave( void *theEnv, FILE *filePtr) { RouterData(theEnv)->FastSaveFilePtr = filePtr; } /******************************************************/ /* GetFastLoad: Returns the "fast load" file pointer. */ /******************************************************/ globle FILE *GetFastLoad( void *theEnv) { return(RouterData(theEnv)->FastLoadFilePtr); } /******************************************************/ /* GetFastSave: Returns the "fast save" file pointer. */ /******************************************************/ globle FILE *GetFastSave( void *theEnv) { return(RouterData(theEnv)->FastSaveFilePtr); } /*****************************************************/ /* UnrecognizedRouterMessage: Standard error message */ /* for an unrecognized router name. */ /*****************************************************/ globle void UnrecognizedRouterMessage( void *theEnv, char *logicalName) { PrintErrorID(theEnv,"ROUTER",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Logical name "); EnvPrintRouter(theEnv,WERROR,logicalName); EnvPrintRouter(theEnv,WERROR," was not recognized by any routers\n"); } /*****************************************/ /* PrintNRouter: Generic print function. */ /*****************************************/ globle int PrintNRouter( void *theEnv, char *logicalName, char *str, unsigned long length) { char *tempStr; int rv; tempStr = (char *) genlongalloc(theEnv,length+1); strncpy(tempStr,str,length); tempStr[length] = 0; rv = EnvPrintRouter(theEnv,logicalName,tempStr); genlongfree(theEnv,tempStr,length+1); return(rv); } clips-6.24/clipssrc/._dffctbsc.h0000400000175000017500000000075410441111645014664 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z = DTTFS cFMWBBMPSRclips-6.24/clipssrc/._drive.h0000400000175000017500000000075410441112047014214 0ustar jfsjfsMac OS X  2 RTEXT????`aTTFH Monaco0z0z!"TTFSmFMPSRMWBBLclips-6.24/clipssrc/tmpltpsr.h0000755000175000017500000000302507422634533014600 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFTEMPLATE PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_tmpltpsr #define _H_tmpltpsr #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDeftemplate(void *,char *); LOCALE void InstallDeftemplate(void *,struct deftemplate *); #endif clips-6.24/clipssrc/._bsave.c0000400000175000017500000000075410441164355014207 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco;6;6 TTF/BFMWBBMPSRclips-6.24/clipssrc/._usrsetup.h0000400000175000017500000000075410200331140014763 0ustar jfsjfsMac OS X  2 RTEXTCWIETTF^NuNVHN2\-@-n (nHn usrsetup.hrol Panels.doctxt.docTEXTCWIEl@t  /./.0.H//./.p/NJX @N>O`8Jo2Hn/ /./.0.H//./.p/NX @N>OJGf .g~JGfHn/ 0H Monacof%f%Ⱦ'TTF,FMWBBMPSRclips-6.24/clipssrc/classini.c0000755000175000017500000010012310441602062014473 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* CLASS INITIALIZATION MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Defclass Initialization Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include "classcom.h" #include "classexm.h" #include "classfun.h" #include "classinf.h" #include "classpsr.h" #include "cstrccom.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "extnfunc.h" #include "inscom.h" #include "memalloc.h" #include "modulpsr.h" #include "modulutl.h" #include "msgcom.h" #include "watch.h" #if DEFINSTANCES_CONSTRUCT #include "defins.h" #endif #if INSTANCE_SET_QUERIES #include "insquery.h" #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY #include "bload.h" #include "objbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "objcmp.h" #endif #if DEFRULE_CONSTRUCT #include "objrtbld.h" #endif #if RUN_TIME #include "insfun.h" #include "msgfun.h" #endif #include "classini.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define SUPERCLASS_RLN "is-a" #define NAME_RLN "name" #define INITIAL_OBJECT_NAME "initial-object" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void SetupDefclasses(void *); static void DeallocateDefclassData(void *); #if (! RUN_TIME) static void DestroyDefclassAction(void *,struct constructHeader *,void *); static DEFCLASS *AddSystemClass(void *,char *,DEFCLASS *); static void *AllocateModule(void *); static void ReturnModule(void *,void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT static void UpdateDefclassesScope(void *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************** NAME : SetupObjectSystem DESCRIPTION : Initializes all COOL constructs, functions, and data structures INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : COOL initialized NOTES : Order of setup calls is important **********************************************************/ globle void SetupObjectSystem( void *theEnv) { ENTITY_RECORD defclassEntityRecord = { "DEFCLASS_PTR", DEFCLASS_PTR,1,0,0, NULL,NULL,NULL,NULL,NULL, DecrementDefclassBusyCount, IncrementDefclassBusyCount, NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFCLASS_DATA,sizeof(struct defclassData),NULL); AddEnvironmentCleanupFunction(theEnv,"defclasses",DeallocateDefclassData,-500); memcpy(&DefclassData(theEnv)->DefclassEntityRecord,&defclassEntityRecord,sizeof(struct entityRecord)); #if ! RUN_TIME DefclassData(theEnv)->ClassDefaultsMode = CONVENIENCE_MODE; DefclassData(theEnv)->ISA_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SUPERCLASS_RLN); IncrementSymbolCount(DefclassData(theEnv)->ISA_SYMBOL); DefclassData(theEnv)->NAME_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,NAME_RLN); IncrementSymbolCount(DefclassData(theEnv)->NAME_SYMBOL); #if DEFRULE_CONSTRUCT DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INITIAL_OBJECT_NAME); IncrementSymbolCount(DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); #endif #endif SetupDefclasses(theEnv); SetupInstances(theEnv); SetupMessageHandlers(theEnv); #if DEFINSTANCES_CONSTRUCT SetupDefinstances(theEnv); #endif #if INSTANCE_SET_QUERIES SetupQuery(theEnv); #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY SetupObjectsBload(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) SetupObjectsCompiler(theEnv); #endif #if DEFRULE_CONSTRUCT SetupObjectPatternStuff(theEnv); #endif } /***************************************************/ /* DeallocateDefclassData: Deallocates environment */ /* data for the defclass construct. */ /***************************************************/ static void DeallocateDefclassData( void *theEnv) { #if ! RUN_TIME SLOT_NAME *tmpSNPPtr, *nextSNPPtr; int i; struct defclassModule *theModuleItem; void *theModule; int bloaded = FALSE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) bloaded = TRUE; #endif /*=============================*/ /* Destroy all the defclasses. */ /*=============================*/ if (! bloaded) { DoForAllConstructs(theEnv,DestroyDefclassAction,DefclassData(theEnv)->DefclassModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct defclassModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefclassData(theEnv)->DefclassModuleIndex); rtn_struct(theEnv,defclassModule,theModuleItem); } } /*==========================*/ /* Remove the class tables. */ /*==========================*/ if (! bloaded) { if (DefclassData(theEnv)->ClassIDMap != NULL) { genfree(theEnv,DefclassData(theEnv)->ClassIDMap,DefclassData(theEnv)->AvailClassID * sizeof(DEFCLASS *)); } } if (DefclassData(theEnv)->ClassTable != NULL) { genfree(theEnv,DefclassData(theEnv)->ClassTable,sizeof(DEFCLASS *) * CLASS_TABLE_HASH_SIZE); } /*==============================*/ /* Free up the slot name table. */ /*==============================*/ if (! bloaded) { for (i = 0; i < SLOT_NAME_TABLE_HASH_SIZE; i++) { tmpSNPPtr = DefclassData(theEnv)->SlotNameTable[i]; while (tmpSNPPtr != NULL) { nextSNPPtr = tmpSNPPtr->nxt; rtn_struct(theEnv,slotName,tmpSNPPtr); tmpSNPPtr = nextSNPPtr; } } } if (DefclassData(theEnv)->SlotNameTable != NULL) { genfree(theEnv,DefclassData(theEnv)->SlotNameTable,sizeof(SLOT_NAME *) * SLOT_NAME_TABLE_HASH_SIZE); } #else DEFCLASS *cls; void *tmpexp; register unsigned int i; register int 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++) { if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0)) { tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo; rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); cls->slots[i].defaultValue = tmpexp; } } } } #endif } #if ! RUN_TIME /*********************************************************/ /* DestroyDefclassAction: Action used to remove defclass */ /* as a result of DestroyEnvironment. */ /*********************************************************/ #if IBM_TBC #pragma argsused #endif static void DestroyDefclassAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif struct defclass *theDefclass = (struct defclass *) theConstruct; if (theDefclass == NULL) return; #if (! BLOAD_ONLY) DestroyDefclass(theEnv,theDefclass); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } #endif #if RUN_TIME /*************************************************** 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; } } } } #else /*************************************************************** NAME : CreateSystemClasses DESCRIPTION : Creates the built-in system classes INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : System classes inserted in the class hash table NOTES : The binary/load save indices for the primitive types (integer, float, symbol and string, multifield, external-address and fact-address) are very important. Need to be able to refer to types with the same index regardless of whether the object system is installed or not. Thus, the bsave/blaod indices of these classes match their integer codes. WARNING!!: Assumes no classes exist yet! ***************************************************************/ globle void CreateSystemClasses( void *theEnv) { DEFCLASS *user,*any,*primitive,*number,*lexeme,*address,*instance; #if DEFRULE_CONSTRUCT DEFCLASS *initialObject; #endif /* =================================== Add canonical slot name entries for the is-a and name fields - used for object patterns =================================== */ AddSlotName(theEnv,DefclassData(theEnv)->ISA_SYMBOL,ISA_ID,TRUE); AddSlotName(theEnv,DefclassData(theEnv)->NAME_SYMBOL,NAME_ID,TRUE); /* ========================================================= Bsave Indices for non-primitive classes start at 9 Object is 9, Primitive is 10, Number is 11, Lexeme is 12, Address is 13, and Instance is 14. because: float = 0, integer = 1, symbol = 2, string = 3, multifield = 4, and external-address = 5 and fact-address = 6, instance-adress = 7 and instance-name = 8. ========================================================= */ any = AddSystemClass(theEnv,OBJECT_TYPE_NAME,NULL); primitive = AddSystemClass(theEnv,PRIMITIVE_TYPE_NAME,any); user = AddSystemClass(theEnv,USER_TYPE_NAME,any); number = AddSystemClass(theEnv,NUMBER_TYPE_NAME,primitive); DefclassData(theEnv)->PrimitiveClassMap[INTEGER] = AddSystemClass(theEnv,INTEGER_TYPE_NAME,number); DefclassData(theEnv)->PrimitiveClassMap[FLOAT] = AddSystemClass(theEnv,FLOAT_TYPE_NAME,number); lexeme = AddSystemClass(theEnv,LEXEME_TYPE_NAME,primitive); DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] = AddSystemClass(theEnv,SYMBOL_TYPE_NAME,lexeme); DefclassData(theEnv)->PrimitiveClassMap[STRING] = AddSystemClass(theEnv,STRING_TYPE_NAME,lexeme); DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] = AddSystemClass(theEnv,MULTIFIELD_TYPE_NAME,primitive); address = AddSystemClass(theEnv,ADDRESS_TYPE_NAME,primitive); DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] = AddSystemClass(theEnv,EXTERNAL_ADDRESS_TYPE_NAME,address); DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] = AddSystemClass(theEnv,FACT_ADDRESS_TYPE_NAME,address); instance = AddSystemClass(theEnv,INSTANCE_TYPE_NAME,primitive); DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] = AddSystemClass(theEnv,INSTANCE_ADDRESS_TYPE_NAME,instance); DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] = AddSystemClass(theEnv,INSTANCE_NAME_TYPE_NAME,instance); #if DEFRULE_CONSTRUCT initialObject = AddSystemClass(theEnv,INITIAL_OBJECT_CLASS_NAME,user); initialObject->abstract = 0; initialObject->reactive = 1; #endif /* ================================================================================ INSTANCE-ADDRESS is-a INSTANCE and ADDRESS. The links between INSTANCE-ADDRESS and ADDRESS still need to be made. =============================================================================== */ AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]->directSuperclasses,address,-1); AddClassLink(theEnv,&DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]->allSuperclasses,address,2); AddClassLink(theEnv,&address->directSubclasses,DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS],-1); /* ======================================================================= The order of the class in the list MUST correspond to their type codes! See CONSTANT.H ======================================================================= */ AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[FLOAT]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INTEGER]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[SYMBOL]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[STRING]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]); AddConstructToModule((struct constructHeader *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]); AddConstructToModule((struct constructHeader *) any); AddConstructToModule((struct constructHeader *) primitive); AddConstructToModule((struct constructHeader *) number); AddConstructToModule((struct constructHeader *) lexeme); AddConstructToModule((struct constructHeader *) address); AddConstructToModule((struct constructHeader *) instance); AddConstructToModule((struct constructHeader *) user); #if DEFRULE_CONSTRUCT AddConstructToModule((struct constructHeader *) initialObject); #endif for (any = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; any != NULL ; any = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) any)) AssignClassID(theEnv,any); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************* NAME : SetupDefclasses DESCRIPTION : Initializes Class Hash Table, Function Parsers, and Data Structures INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : NOTES : None *********************************************************/ static void SetupDefclasses( void *theEnv) { InstallPrimitive(theEnv,&DefclassData(theEnv)->DefclassEntityRecord,DEFCLASS_PTR); DefclassData(theEnv)->DefclassModuleIndex = RegisterModuleItem(theEnv,"defclass", #if (! RUN_TIME) AllocateModule,ReturnModule, #else NULL,NULL, #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefclassModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefclassCModuleReference, #else NULL, #endif EnvFindDefclass); DefclassData(theEnv)->DefclassConstruct = AddConstruct(theEnv,"defclass","defclasses", #if (! BLOAD_ONLY) && (! RUN_TIME) ParseDefclass, #else NULL, #endif EnvFindDefclass, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefclass, SetNextConstruct,EnvIsDefclassDeletable, EnvUndefclass, #if (! RUN_TIME) RemoveDefclass #else NULL #endif ); AddClearReadyFunction(theEnv,"defclass",InstancesPurge,0); #if ! RUN_TIME EnvAddClearFunction(theEnv,"defclass",CreateSystemClasses,0); InitializeClasses(theEnv); #if ! BLOAD_ONLY #if DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"defclass",SYMBOL); AddAfterModuleDefinedFunction(theEnv,"defclass",UpdateDefclassesScope,0); #endif EnvDefineFunction2(theEnv,"undefclass",'v',PTIEF UndefclassCommand,"UndefclassCommand","11w"); AddSaveFunction(theEnv,"defclass",SaveDefclasses,10); #endif #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-defclasses",'v',PTIEF ListDefclassesCommand,"ListDefclassesCommand","01"); EnvDefineFunction2(theEnv,"ppdefclass",'v',PTIEF PPDefclassCommand,"PPDefclassCommand","11w"); EnvDefineFunction2(theEnv,"describe-class",'v',PTIEF DescribeClassCommand,"DescribeClassCommand","11w"); EnvDefineFunction2(theEnv,"browse-classes",'v',PTIEF BrowseClassesCommand,"BrowseClassesCommand","01w"); #endif EnvDefineFunction2(theEnv,"get-defclass-list",'m',PTIEF GetDefclassListFunction, "GetDefclassListFunction","01"); EnvDefineFunction2(theEnv,"superclassp",'b',PTIEF SuperclassPCommand,"SuperclassPCommand","22w"); EnvDefineFunction2(theEnv,"subclassp",'b',PTIEF SubclassPCommand,"SubclassPCommand","22w"); EnvDefineFunction2(theEnv,"class-existp",'b',PTIEF ClassExistPCommand,"ClassExistPCommand","11w"); EnvDefineFunction2(theEnv,"message-handler-existp",'b', PTIEF MessageHandlerExistPCommand,"MessageHandlerExistPCommand","23w"); EnvDefineFunction2(theEnv,"class-abstractp",'b',PTIEF ClassAbstractPCommand,"ClassAbstractPCommand","11w"); #if DEFRULE_CONSTRUCT EnvDefineFunction2(theEnv,"class-reactivep",'b',PTIEF ClassReactivePCommand,"ClassReactivePCommand","11w"); #endif EnvDefineFunction2(theEnv,"class-slots",'m',PTIEF ClassSlotsCommand,"ClassSlotsCommand","12w"); EnvDefineFunction2(theEnv,"class-superclasses",'m', PTIEF ClassSuperclassesCommand,"ClassSuperclassesCommand","12w"); EnvDefineFunction2(theEnv,"class-subclasses",'m', PTIEF ClassSubclassesCommand,"ClassSubclassesCommand","12w"); EnvDefineFunction2(theEnv,"get-defmessage-handler-list",'m', PTIEF GetDefmessageHandlersListCmd,"GetDefmessageHandlersListCmd","02w"); EnvDefineFunction2(theEnv,"slot-existp",'b',PTIEF SlotExistPCommand,"SlotExistPCommand","23w"); EnvDefineFunction2(theEnv,"slot-facets",'m',PTIEF SlotFacetsCommand,"SlotFacetsCommand","22w"); EnvDefineFunction2(theEnv,"slot-sources",'m',PTIEF SlotSourcesCommand,"SlotSourcesCommand","22w"); EnvDefineFunction2(theEnv,"slot-types",'m',PTIEF SlotTypesCommand,"SlotTypesCommand","22w"); EnvDefineFunction2(theEnv,"slot-allowed-values",'m',PTIEF SlotAllowedValuesCommand,"SlotAllowedValuesCommand","22w"); EnvDefineFunction2(theEnv,"slot-allowed-classes",'m',PTIEF SlotAllowedClassesCommand,"SlotAllowedClassesCommand","22w"); EnvDefineFunction2(theEnv,"slot-range",'m',PTIEF SlotRangeCommand,"SlotRangeCommand","22w"); EnvDefineFunction2(theEnv,"slot-cardinality",'m',PTIEF SlotCardinalityCommand,"SlotCardinalityCommand","22w"); EnvDefineFunction2(theEnv,"slot-writablep",'b',PTIEF SlotWritablePCommand,"SlotWritablePCommand","22w"); EnvDefineFunction2(theEnv,"slot-initablep",'b',PTIEF SlotInitablePCommand,"SlotInitablePCommand","22w"); EnvDefineFunction2(theEnv,"slot-publicp",'b',PTIEF SlotPublicPCommand,"SlotPublicPCommand","22w"); EnvDefineFunction2(theEnv,"slot-direct-accessp",'b',PTIEF SlotDirectAccessPCommand, "SlotDirectAccessPCommand","22w"); EnvDefineFunction2(theEnv,"slot-default-value",'u',PTIEF SlotDefaultValueCommand, "SlotDefaultValueCommand","22w"); EnvDefineFunction2(theEnv,"defclass-module",'w',PTIEF GetDefclassModuleCommand, "GetDefclassModuleCommand","11w"); EnvDefineFunction2(theEnv,"get-class-defaults-mode", 'w', PTIEF GetClassDefaultsModeCommand, "GetClassDefaultsModeCommand", "00"); EnvDefineFunction2(theEnv,"set-class-defaults-mode", 'w', PTIEF SetClassDefaultsModeCommand, "SetClassDefaultsModeCommand", "11w"); #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"instances",0,&DefclassData(theEnv)->WatchInstances,75,DefclassWatchAccess,DefclassWatchPrint); AddWatchItem(theEnv,"slots",1,&DefclassData(theEnv)->WatchSlots,74,DefclassWatchAccess,DefclassWatchPrint); #endif } #if (! RUN_TIME) /********************************************************* NAME : AddSystemClass DESCRIPTION : Performs all necessary allocations for adding a system class INPUTS : 1) The name-string of the system class 2) The address of the parent class (NULL if none) RETURNS : The address of the new system class SIDE EFFECTS : Allocations performed NOTES : Assumes system-class name is unique Also assumes SINGLE INHERITANCE for system classes to simplify precedence list determination Adds classes to has table but NOT to class list (this is responsibility of caller) *********************************************************/ static DEFCLASS *AddSystemClass( void *theEnv, char *name, DEFCLASS *parent) { DEFCLASS *sys; register unsigned i; char defaultScopeMap[1]; sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name)); sys->abstract = 1; #if DEFRULE_CONSTRUCT sys->reactive = 0; #endif IncrementSymbolCount(sys->header.name); sys->installed = 1; sys->system = 1; sys->hashTableIndex = HashClass(sys->header.name); AddClassLink(theEnv,&sys->allSuperclasses,sys,-1); if (parent != NULL) { AddClassLink(theEnv,&sys->directSuperclasses,parent,-1); AddClassLink(theEnv,&parent->directSubclasses,sys,-1); AddClassLink(theEnv,&sys->allSuperclasses,parent,-1); for (i = 1 ; i < parent->allSuperclasses.classCount ; i++) AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1); } sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex]; DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys; /* ========================================= Add default scope maps for a system class There is only one module (MAIN) so far - which has an id of 0 ========================================= */ ClearBitString((void *) defaultScopeMap,(int) sizeof(char)); SetBitMap(defaultScopeMap,0); #if DEFMODULE_CONSTRUCT sys->scopeMap = (BITMAP_HN *) AddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char)); IncrementBitMapCount(sys->scopeMap); #endif return(sys); } /***************************************************** 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,defclassModule)); } /*************************************************** NAME : ReturnModule DESCRIPTION : Removes a deffunction module and all associated deffunctions INPUTS : The deffunction module RETURNS : Nothing useful SIDE EFFECTS : Module and deffunctions deleted NOTES : None ***************************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefclassData(theEnv)->DefclassConstruct); DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,ISA_ID)); DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,NAME_ID)); rtn_struct(theEnv,defclassModule,theItem); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT /*************************************************** NAME : UpdateDefclassesScope DESCRIPTION : This function updates the scope bitmaps for existing classes when a new module is defined INPUTS : None RETURNS : Nothing SIDE EFFECTS : Class scope bitmaps are updated NOTES : None ***************************************************/ static void UpdateDefclassesScope( void *theEnv) { register unsigned i; DEFCLASS *theDefclass; int newModuleID,count; char *newScopeMap; unsigned newScopeMapSize; char *className; struct defmodule *matchModule; newModuleID = (int) ((struct defmodule *) EnvGetCurrentModule(theEnv))->bsaveID; newScopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1)); newScopeMap = (char *) gm2(theEnv,newScopeMapSize); for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++) for (theDefclass = DefclassData(theEnv)->ClassTable[i] ; theDefclass != NULL ; theDefclass = theDefclass->nxtHash) { matchModule = theDefclass->header.whichModule->theModule; className = ValueToString(theDefclass->header.name); ClearBitString((void *) newScopeMap,newScopeMapSize); GenCopyMemory(char,theDefclass->scopeMap->size, newScopeMap,ValueToBitMap(theDefclass->scopeMap)); DecrementBitMapCount(theEnv,theDefclass->scopeMap); if (theDefclass->system) SetBitMap(newScopeMap,newModuleID); else if (FindImportedConstruct(theEnv,"defclass",matchModule, className,&count,TRUE,NULL) != NULL) SetBitMap(newScopeMap,newModuleID); theDefclass->scopeMap = (BITMAP_HN *) AddBitMap(theEnv,(void *) newScopeMap,newScopeMapSize); IncrementBitMapCount(theDefclass->scopeMap); } rm(theEnv,(void *) newScopeMap,newScopeMapSize); } #endif #endif clips-6.24/clipssrc/._dffctbsc.c0000400000175000017500000000075410441111617014656 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zCJTTFS bFMWBBMPSRclips-6.24/clipssrc/conscomp.c0000755000175000017500000015040110441602076014520 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/04/06 */ /* */ /* CONSTRUCT COMPILER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for the constructs-to-c */ /* command. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* Barry Cameron */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Modifications to use the system constant */ /* FILENAME_MAX to check file name lengths. */ /* DR0856 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Used EnvClear rather than Clear in */ /* InitCImage initialization code. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Removed SHORT_LINK_NAMES code as this option */ /* is no longer supported. */ /* */ /* Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /*************************************************************/ #define _CONSCOMP_SOURCE_ #include "setup.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include #include #include "symbol.h" #include "memalloc.h" #include "constant.h" #include "exprnpsr.h" #include "cstrccom.h" #include "constrct.h" #include "argacces.h" #include "cstrncmp.h" #include "router.h" #include "sysdep.h" #include "utility.h" #include "modulcmp.h" #include "envrnmnt.h" #if DEFRULE_CONSTRUCT #include "network.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxcmp.h" #endif #if DEFTEMPLATE_CONSTRUCT #include "tmpltcmp.h" #endif #if DEFGLOBAL_CONSTRUCT #include "globlcmp.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccmp.h" #endif #if OBJECT_SYSTEM #include "objcmp.h" #endif #include "conscomp.h" /***************/ /* DEFINITIONS */ /***************/ #define FSIZE 80 /**********************************************/ /* CONSTRUCT CODES DEFINITIONS: The codes F, */ /* I, B, S, E, P, L, and C are not included */ /* because those are already taken. */ /* */ /* B: BitMap hash nodes */ /* C: Constraint hash nodes */ /* E: Expression hash nodes */ /* F: Float hash nodes */ /* I: Integer hash nodes */ /* L: Bitmaps */ /* P: Functions */ /* S: Symbol hash nodes */ /**********************************************/ #define PRIMARY_CODES "ADGHJKMNOQRTUVWXYZ" #define PRIMARY_LEN 18 #define SECONDARY_CODES "ABCDEFGHIJKLMNOPQRSTUVWXYZ" #define SECONDARY_LEN 26 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ void ConstructsToCCommand(void *); static int ConstructsToC(void *,char *,int,int); static void WriteFunctionExternDeclarations(void *,FILE *); static int FunctionsToCode(void *theEnv,char *); static int WriteInitializationFunction(void *,char *); static void DumpExpression(void *,struct expr *); static void MarkConstruct(void *,struct constructHeader *,void *); static void HashedExpressionsToCode(void *); static void DeallocateConstructCompilerData(void *); /**********************************************************/ /* InitializeConstructCompilerData: Allocates environment */ /* data for the constructs-to-c command. */ /**********************************************************/ globle void InitializeConstructCompilerData( void *theEnv) { AllocateEnvironmentData(theEnv,CONSTRUCT_COMPILER_DATA,sizeof(struct constructCompilerData),DeallocateConstructCompilerData); ConstructCompilerData(theEnv)->MaxIndices = 2000; ConstructCompilerData(theEnv)->CodeGeneratorCount = 0; } /************************************************************/ /* DeallocateConstructCompilerData: Deallocates environment */ /* data for the constructs-to-c command. */ /************************************************************/ static void DeallocateConstructCompilerData( void *theEnv) { struct CodeGeneratorItem *tmpPtr, *nextPtr; int i; tmpPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; for (i = 0; i < tmpPtr->arrayCount ; i++) { rm(theEnv,tmpPtr->arrayNames[i],strlen(tmpPtr->arrayNames[i]) + 1); } if (tmpPtr->arrayCount != 0) { rm(theEnv,tmpPtr->arrayNames,sizeof(char *) * tmpPtr->arrayCount); } rtn_struct(theEnv,CodeGeneratorItem,tmpPtr); tmpPtr = nextPtr; } } /**********************************************/ /* ConstructsToCCommand: H/L access routine */ /* for the constructs-to-c command. */ /**********************************************/ globle void ConstructsToCCommand( void *theEnv) { char *fileName; DATA_OBJECT theArg; int argCount; int id, max, nameLength; #if VAX_VMS || IBM_MSC || IBM_TBC || IBM_ICB || IBM_ZTC || IBM_SC int i; #endif /*============================================*/ /* Check for appropriate number of arguments. */ /*============================================*/ if ((argCount = EnvArgRangeCheck(theEnv,"constructs-to-c",2,3)) == -1) return; /*====================================================*/ /* Get the name of the file in which to place C code. */ /*====================================================*/ if (EnvArgTypeCheck(theEnv,"constructs-to-c",1,SYMBOL_OR_STRING,&theArg) == FALSE) { return; } fileName = DOToString(theArg); nameLength = (int) strlen(fileName); /*================================*/ /* File names for the VAX and IBM */ /* PCs can't contain a period. */ /*================================*/ #if VAX_VMS || IBM_MSC || IBM_TBC || IBM_ICB || IBM_ZTC || IBM_SC for (i = 0 ; *(fileName+i) ; i++) { if (*(fileName+i) == '.') { PrintErrorID(theEnv,"CONSCOMP",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Invalid file name "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR," contains \'.\'\n"); return; } } #endif /*==========================================================*/ /* The maximum file name size that can be passed into fopen */ /* is specified by FILENAME_MAX. Assume that the most */ /* characters that will be appended to the file prefix will */ /* be 20 and check that the prefix plus the additional */ /* characters is less than the supported maximum. */ /*==========================================================*/ if ((nameLength + 20) > FILENAME_MAX) { PrintErrorID(theEnv,"CONSCOMP",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Aborting because the base file name may cause the fopen maximum of "); PrintLongInteger(theEnv,WERROR,FILENAME_MAX); EnvPrintRouter(theEnv,WERROR," to be violated when file names are generated.\n"); return; } /*===========================================*/ /* If the base file name is greater than 3 */ /* characters, issue a warning that the file */ /* name lengths may exceed what is allowed */ /* under some operating systems. */ /*===========================================*/ if (nameLength > 3) { PrintWarningID(theEnv,"CONSCOMP",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Base file name exceeds 3 characters.\n"); EnvPrintRouter(theEnv,WWARNING," This may cause files to be overwritten if file name length\n"); EnvPrintRouter(theEnv,WWARNING," is limited on your platform.\n"); } /*====================================*/ /* Get the runtime image ID argument. */ /*====================================*/ if (EnvArgTypeCheck(theEnv,"constructs-to-c",2,INTEGER,&theArg) == FALSE) { return; } id = DOToInteger(theArg); if (id < 0) { ExpectedTypeError1(theEnv,"constructs-to-c",2,"positive integer"); return; } /*===========================================*/ /* Get the maximum number of data structures */ /* to store per file argument (if supplied). */ /*===========================================*/ if (argCount == 3) { if (EnvArgTypeCheck(theEnv,"constructs-to-c",3,INTEGER,&theArg) == FALSE) { return; } max = DOToInteger(theArg); if (max < 0) { ExpectedTypeError1(theEnv,"constructs-to-c",3,"positive integer"); return; } } else { max = 10000; } /*============================*/ /* Call the driver routine to */ /* generate the C code. */ /*============================*/ ConstructsToC(theEnv,fileName,id,max); } /***************************************/ /* ConstructsToC: C access routine for */ /* the constructs-to-c command. */ /***************************************/ static int ConstructsToC( void *theEnv, char *fileName, int theImageID, int max) { char fname[FILENAME_MAX+1]; int fileVersion; struct CodeGeneratorItem *cgPtr; /*===============================================*/ /* Set the global MaxIndices variable indicating */ /* the maximum number of data structures to save */ /* in each file. */ /*===============================================*/ ConstructCompilerData(theEnv)->MaxIndices = max; /*==================================*/ /* Call the list of functions to be */ /* executed before generating code. */ /*==================================*/ for (cgPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; cgPtr != NULL; cgPtr = cgPtr->next) { if (cgPtr->beforeFunction != NULL) (*cgPtr->beforeFunction)(theEnv); } /*=================================================*/ /* Do a periodic cleanup without using heuristics */ /* to get rid of as much garbage as possible so */ /* that it isn't written out as C data structures. */ /*=================================================*/ PeriodicCleanup(theEnv,FALSE,FALSE); /*=====================================*/ /* Initialize some global information. */ /*=====================================*/ ConstructCompilerData(theEnv)->FilePrefix = fileName; ConstructCompilerData(theEnv)->ImageID = theImageID; ConstructCompilerData(theEnv)->ExpressionFP = NULL; ConstructCompilerData(theEnv)->ExpressionVersion = 1; ConstructCompilerData(theEnv)->ExpressionHeader = TRUE; ConstructCompilerData(theEnv)->ExpressionCount = 0; /*=====================================================*/ /* Open a header file for dumping general information. */ /*=====================================================*/ sprintf(fname,"%s.h",fileName); if ((ConstructCompilerData(theEnv)->HeaderFP = GenOpen(theEnv,fname,"w")) == NULL) { OpenErrorMessage(theEnv,"constructs-to-c",fname); return(0); } fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#ifndef _CONSTRUCT_COMPILER_HEADER_\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#define _CONSTRUCT_COMPILER_HEADER_\n\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \"setup.h\"\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \"expressn.h\"\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \"extnfunc.h\"\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"#include \"%s\"\n",API_HEADER); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"\n#define VS (void *)\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"\n"); /*=========================================================*/ /* Give extern declarations for user and system functions. */ /*=========================================================*/ WriteFunctionExternDeclarations(theEnv,ConstructCompilerData(theEnv)->HeaderFP); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"\n#endif\n\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"/****************************/\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"/* EXTERN ARRAY DEFINITIONS */\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"/****************************/\n\n"); /*============================================*/ /* Open a file for dumping fixup information. */ /*============================================*/ sprintf(fname,"%s_init.c",fileName); if ((ConstructCompilerData(theEnv)->FixupFP = GenOpen(theEnv,fname,"w")) == NULL) { OpenErrorMessage(theEnv,"constructs-to-c",fname); return(0); } fprintf(ConstructCompilerData(theEnv)->FixupFP,"#include \"%s.h\"\n",fileName); fprintf(ConstructCompilerData(theEnv)->FixupFP,"\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"/**********************************/\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"/* CONSTRUCT IMAGE FIXUP FUNCTION */\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"/**********************************/\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP,"\nvoid FixupCImage_%d(\n",ConstructCompilerData(theEnv)->ImageID); fprintf(ConstructCompilerData(theEnv)->FixupFP," void *theEnv)\n"); fprintf(ConstructCompilerData(theEnv)->FixupFP," {\n"); /*==================================*/ /* Generate code for atomic values, */ /* function definitions, hashed */ /* expressions, and constructs. */ /*==================================*/ AtomicValuesToCode(theEnv,fileName); FunctionsToCode(theEnv,fileName); HashedExpressionsToCode(theEnv); ConstraintsToCode(theEnv,fileName,4,ConstructCompilerData(theEnv)->HeaderFP,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); /*===============================*/ /* Call each code generator item */ /* for the various constructs. */ /*===============================*/ fileVersion = 5; for (cgPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; cgPtr != NULL; cgPtr = cgPtr->next) { if (cgPtr->generateFunction != NULL) { (*cgPtr->generateFunction)(theEnv,fileName,fileVersion,ConstructCompilerData(theEnv)->HeaderFP,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); fileVersion++; } } /*=========================================*/ /* Restore the atomic data bucket values */ /* (which were set to an index reference). */ /*=========================================*/ RestoreAtomicValueBuckets(theEnv); /*============================*/ /* Close the expression file. */ /*============================*/ if (ConstructCompilerData(theEnv)->ExpressionFP != NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"};\n"); GenClose(theEnv,ConstructCompilerData(theEnv)->ExpressionFP); } /*=======================*/ /* Close the fixup file. */ /*=======================*/ if (ConstructCompilerData(theEnv)->FixupFP != NULL) { fprintf(ConstructCompilerData(theEnv)->FixupFP," }\n"); GenClose(theEnv,ConstructCompilerData(theEnv)->FixupFP); } /*====================================*/ /* Write the initialization function. */ /*====================================*/ WriteInitializationFunction(theEnv,fileName); /*========================*/ /* Close the header file. */ /*========================*/ GenClose(theEnv,ConstructCompilerData(theEnv)->HeaderFP); /*==================================================*/ /* Return TRUE to indicate that the constructs-to-c */ /* command was successfully executed. */ /*==================================================*/ return(TRUE); } /*******************************************************/ /* WriteFunctionExternDeclarations: Loop through the */ /* list of function definitions and generates extern */ /* declarations for them in the specified file. */ /*******************************************************/ static void WriteFunctionExternDeclarations( void *theEnv, FILE *fp) { struct FunctionDefinition *theFunction; fprintf(fp,"\n"); fprintf(fp,"/************************************/\n"); fprintf(fp,"/* EXTERNAL FUNCTION DEFINITIONS */\n"); fprintf(fp,"/************************************/\n\n"); for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { fprintf(fp,"extern "); switch(theFunction->returnValueType) { case 'i': case 'b': fprintf(fp,"int "); break; case 'l': fprintf(fp,"long "); break; case 'f': fprintf(fp,"float "); break; case 'd': fprintf(fp,"double "); break; case 'w': case 's': case 'o': fprintf(fp,"void *"); break; case 'c': fprintf(fp,"char "); break; case 'a': case 'x': fprintf(fp,"void * "); break; case 'v': case 'm': case 'u': case 'n': case 'j': case 'k': fprintf(fp,"void "); break; default: SystemError(theEnv,"CONSCOMP",1); break; } fprintf(fp,"%s(",theFunction->actualFunctionName); switch(theFunction->returnValueType) { case 'i': case 'b': case 'l': case 'f': case 'd': case 'w': case 's': case 'o': case 'c': case 'a': case 'x': case 'v': if (theFunction->environmentAware) { fprintf(fp,"void *"); } else { fprintf(fp,"void"); } break; case 'm': case 'u': case 'n': case 'j': case 'k': if (theFunction->environmentAware) { fprintf(fp,"void *,DATA_OBJECT_PTR_ARG"); } else { fprintf(fp,"DATA_OBJECT_PTR_ARG"); } break; } fprintf(fp,");\n"); } } /****************************************************/ /* FunctionsToCode: Generates C code to represent */ /* the function declaration data structures (used */ /* to declare system and user defined functions). */ /****************************************************/ static int FunctionsToCode( void *theEnv, char *fileName) { short i = 0; FILE *fp; int version = 1; int newHeader = TRUE; struct FunctionDefinition *fctnPtr; /*=============================*/ /* Assign a reference index to */ /* each of the functions. */ /*=============================*/ for (fctnPtr = GetFunctionList(theEnv); fctnPtr != NULL; fctnPtr = fctnPtr->next) { fctnPtr->bsaveIndex = i++; } /*=======================================*/ /* Create the file in which to store the */ /* function definition data structures. */ /*=======================================*/ if ((fp = NewCFile(theEnv,fileName,2,version,FALSE)) == NULL) { return(0); } /*===============================================*/ /* Construct the definition of the function list */ /* from the definitions of the functions. */ /*===============================================*/ fprintf(fp,"\n\n"); fprintf(fp,"/************************************/\n"); fprintf(fp,"/* FUNCTION LIST DEFINITION */\n"); fprintf(fp,"/************************************/\n\n"); i = 1; fctnPtr = GetFunctionList(theEnv); while (fctnPtr != NULL) { if (newHeader) { fprintf(fp,"struct FunctionDefinition P%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,version); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct FunctionDefinition P%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,version); newHeader = FALSE; } fprintf(fp,"{"); PrintSymbolReference(theEnv,fp,fctnPtr->callFunctionName); fprintf(fp,",\"%s\",",fctnPtr->actualFunctionName); fprintf(fp,"'%c',",fctnPtr->returnValueType); fprintf(fp,"PTIF %s,",fctnPtr->actualFunctionName); fprintf(fp,"NULL,"); if (fctnPtr->restrictions != NULL) fprintf(fp,"\"%s\",",fctnPtr->restrictions); else fprintf(fp,"NULL,"); fprintf(fp,"0,0,%d,0,",(fctnPtr->environmentAware ? 1 : 0)); PrintFunctionReference(theEnv,fp,fctnPtr->next); i++; fctnPtr = fctnPtr->next; if ((i > ConstructCompilerData(theEnv)->MaxIndices) || (fctnPtr == NULL)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); i = 1; version++; if (fctnPtr != NULL) { if ((fp = NewCFile(theEnv,fileName,2,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } return(TRUE); } /************************************************************/ /* PrintFunctionReference: Writes the C code representation */ /* of a pointer to a function definition data structure. */ /************************************************************/ globle void PrintFunctionReference( void *theEnv, FILE *fp, struct FunctionDefinition *funcPtr) { if (funcPtr == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&P%d_%d[%d]",ConstructCompilerData(theEnv)->ImageID, (funcPtr->bsaveIndex / ConstructCompilerData(theEnv)->MaxIndices) + 1, funcPtr->bsaveIndex % ConstructCompilerData(theEnv)->MaxIndices); } /******************************************/ /* WriteInitializationFunction: Generates */ /* the C initialization function for */ /* this constructs-to-c module. */ /******************************************/ static int WriteInitializationFunction( void *theEnv, char *fileName) { char fname[FILENAME_MAX+1]; FILE *fp; struct CodeGeneratorItem *cgPtr; /*===============================*/ /* Open the initialization file. */ /*===============================*/ sprintf(fname,"%s.c",fileName); if ((fp = GenOpen(theEnv,fname,"w")) == NULL) { OpenErrorMessage(theEnv,"constructs-to-c",fname); return(FALSE); } /*=====================================*/ /* Write out #includes and prototypes. */ /*=====================================*/ fprintf(fp,"#include \"%s.h\"\n",fileName); fprintf(fp,"\n"); fprintf(fp,"#include \"utility.h\"\n"); fprintf(fp,"#include \"generate.h\"\n"); fprintf(fp,"#include \"envrnmnt.h\"\n"); fprintf(fp,"#include \"expressn.h\"\n"); fprintf(fp,"#include \"extnfunc.h\"\n"); fprintf(fp,"#include \"objrtmch.h\"\n"); fprintf(fp,"#include \"rulebld.h\"\n\n"); fprintf(ConstructCompilerData(theEnv)->HeaderFP," void *InitCImage_%d(void);\n",ConstructCompilerData(theEnv)->ImageID); fprintf(ConstructCompilerData(theEnv)->HeaderFP," void FixupCImage_%d(void *);\n",ConstructCompilerData(theEnv)->ImageID); /*============================================*/ /* Begin writing the initialization function. */ /*============================================*/ fprintf(fp,"\n"); fprintf(fp,"/*******************************************/\n"); fprintf(fp,"/* CONSTRUCT IMAGE INITIALIZATION FUNCTION */\n"); fprintf(fp,"/*******************************************/\n"); fprintf(fp,"\nvoid *InitCImage_%d()\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp," {\n"); fprintf(fp," static void *theEnv = NULL;\n\n"); fprintf(fp," if (theEnv != NULL) return(NULL);\n\n"); fprintf(fp," theEnv = CreateRuntimeEnvironment(sht%d,fht%d,iht%d,bmht%d);\n\n", ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ImageID, ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ImageID); fprintf(fp," EnvClear(theEnv);\n"); fprintf(fp," PeriodicCleanup(theEnv,TRUE,FALSE);\n"); fprintf(fp," RefreshSpecialSymbols(theEnv);\n"); fprintf(fp," InstallFunctionList(theEnv,P%d_1);\n\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp," InitExpressionPointers(theEnv);\n"); fprintf(fp," FixupCImage_%d(theEnv);\n\n",ConstructCompilerData(theEnv)->ImageID); /*==========================================*/ /* Write construct specific initialization. */ /*==========================================*/ cgPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; while (cgPtr != NULL) { if (cgPtr->initFunction != NULL) { (*cgPtr->initFunction)(theEnv,fp,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); fprintf(fp,"\n"); } cgPtr = cgPtr->next; } /*================================*/ /* Close the initialization file. */ /*================================*/ fprintf(fp," return(theEnv);\n"); fprintf(fp," }\n"); GenClose(theEnv,fp); /*========================================*/ /* Return TRUE to indicate initialization */ /* file was successfully written. */ /*========================================*/ return(TRUE); } /**************************************************/ /* NewCFile: Opens a new file for writing C code. */ /**************************************************/ globle FILE *NewCFile( void *theEnv, char *fileName, int id, int version, int reopenOldFile) { char fname[FILENAME_MAX+1]; FILE *newFP; sprintf(fname,"%s%d_%d.c",fileName,id,version); newFP = GenOpen(theEnv,fname,(char *) (reopenOldFile ? "a" : "w")); if (newFP == NULL) { OpenErrorMessage(theEnv,"constructs-to-c",fname); return(NULL); } if (reopenOldFile == FALSE) { fprintf(newFP,"#include \"%s.h\"\n",fileName); fprintf(newFP,"\n"); } return(newFP); } /**********************************************************/ /* HashedExpressionsToCode: Traverses the expression hash */ /* table and calls ExpressionToCode to write the C */ /* code representation to a file of every expression in */ /* the table. */ /**********************************************************/ static void HashedExpressionsToCode( void *theEnv) { unsigned i; EXPRESSION_HN *exphash; for (i = 0; i < EXPRESSION_HASH_SIZE; i++) { for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i]; exphash != NULL; exphash = exphash->next) { exphash->bsaveID = ConstructCompilerData(theEnv)->ExpressionCount + (ConstructCompilerData(theEnv)->MaxIndices * ConstructCompilerData(theEnv)->ExpressionVersion); ExpressionToCode(theEnv,NULL,exphash->exp); } } } /*****************************************************/ /* PrintHashedExpressionReference: Writes the C code */ /* representation of a pointer to an expression */ /* stored in the expression hash table. */ /*****************************************************/ globle void PrintHashedExpressionReference( void *theEnv, FILE *theFile, struct expr *theExpression, int imageID, int maxIndices) { long theIDValue; if (theExpression == NULL) { fprintf(theFile,"NULL"); } else { theIDValue = HashedExpressionIndex(theEnv,theExpression); fprintf(theFile,"&E%d_%ld[%ld]", imageID, theIDValue / maxIndices, theIDValue % maxIndices); } } /**************************************************************/ /* ExpressionToCode: Writes the C code reference of a pointer */ /* to an expression and then calls DumpExpression to write */ /* the C code for the expression to the expression file. */ /**************************************************************/ globle int ExpressionToCode( void *theEnv, FILE *fp, struct expr *exprPtr) { /*========================================*/ /* Print the reference to the expression. */ /*========================================*/ if (exprPtr == NULL) { if (fp != NULL) fprintf(fp,"NULL"); return(FALSE); } else if (fp != NULL) { fprintf(fp,"&E%d_%d[%ld]",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion,ConstructCompilerData(theEnv)->ExpressionCount); } /*==================================================*/ /* Create a new expression code file, if necessary. */ /*==================================================*/ if (ConstructCompilerData(theEnv)->ExpressionHeader == TRUE) { if ((ConstructCompilerData(theEnv)->ExpressionFP = NewCFile(theEnv,ConstructCompilerData(theEnv)->FilePrefix,3,ConstructCompilerData(theEnv)->ExpressionVersion,FALSE)) == NULL) { return(-1); } fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"struct expr E%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct expr E%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion); ConstructCompilerData(theEnv)->ExpressionHeader = FALSE; } else { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,",\n"); } /*===========================*/ /* Dump the expression code. */ /*===========================*/ DumpExpression(theEnv,exprPtr); /*=========================================*/ /* Close the expression file if necessary. */ /*=========================================*/ if (ConstructCompilerData(theEnv)->ExpressionCount >= ConstructCompilerData(theEnv)->MaxIndices) { ConstructCompilerData(theEnv)->ExpressionCount = 0; ConstructCompilerData(theEnv)->ExpressionVersion++; fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"};\n"); GenClose(theEnv,ConstructCompilerData(theEnv)->ExpressionFP); ConstructCompilerData(theEnv)->ExpressionFP = NULL; ConstructCompilerData(theEnv)->ExpressionHeader = TRUE; } /*==========================================*/ /* Return TRUE to indicate the expression */ /* reference and expression data structures */ /* were succcessfully written to the file. */ /*==========================================*/ return(TRUE); } /**********************************************************/ /* DumpExpression: Writes the C code representation of an */ /* expression data structure to the expression file. */ /**********************************************************/ static void DumpExpression( void *theEnv, struct expr *exprPtr) { while (exprPtr != NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"{"); fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"%d,",exprPtr->type); fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"VS "); switch (exprPtr->type) { case FCALL: PrintFunctionReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(struct FunctionDefinition *) exprPtr->value); break; case INTEGER: PrintIntegerReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(INTEGER_HN *) exprPtr->value); break; case FLOAT: PrintFloatReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(FLOAT_HN *) exprPtr->value); break; case PCALL: #if DEFFUNCTION_CONSTRUCT PrintDeffunctionReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(DEFFUNCTION *) exprPtr->value, ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case GCALL: #if DEFGENERIC_CONSTRUCT PrintGenericFunctionReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(DEFGENERIC *) exprPtr->value, ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case DEFTEMPLATE_PTR: #if DEFTEMPLATE_CONSTRUCT DeftemplateCConstructReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,exprPtr->value,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case DEFGLOBAL_PTR: #if DEFGLOBAL_CONSTRUCT DefglobalCConstructReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,exprPtr->value,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case DEFCLASS_PTR: #if OBJECT_SYSTEM PrintClassReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(DEFCLASS *) exprPtr->value,ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->MaxIndices); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case FACT_ADDRESS: #if DEFTEMPLATE_CONSTRUCT fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); fprintf(ConstructCompilerData(theEnv)->FixupFP, " E%d_%d[%ld].value = &FactData(theEnv)->DummyFact;\n", ConstructCompilerData(theEnv)->ImageID, ConstructCompilerData(theEnv)->ExpressionVersion, ConstructCompilerData(theEnv)->ExpressionCount); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case INSTANCE_ADDRESS: #if OBJECT_SYSTEM fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); fprintf(ConstructCompilerData(theEnv)->FixupFP, " E%d_%d[%ld].value = &InstanceData(theEnv)->DummyInstance;\n", ConstructCompilerData(theEnv)->ImageID, ConstructCompilerData(theEnv)->ExpressionVersion, ConstructCompilerData(theEnv)->ExpressionCount); #else fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); #endif break; case STRING: case SYMBOL: case INSTANCE_NAME: case GBL_VARIABLE: PrintSymbolReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(SYMBOL_HN *) exprPtr->value); break; case RVOID: fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); break; default: if (EvaluationData(theEnv)->PrimitivesArray[exprPtr->type] == NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); } else if (EvaluationData(theEnv)->PrimitivesArray[exprPtr->type]->bitMap) { PrintBitMapReference(theEnv,ConstructCompilerData(theEnv)->ExpressionFP,(BITMAP_HN *) exprPtr->value); } else { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL"); } break; } fprintf(ConstructCompilerData(theEnv)->ExpressionFP,","); ConstructCompilerData(theEnv)->ExpressionCount++; if (exprPtr->argList == NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL,"); } else { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"&E%d_%d[%ld],",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion, ConstructCompilerData(theEnv)->ExpressionCount); } if (exprPtr->nextArg == NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"NULL}"); } else { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,"&E%d_%d[%ld]}",ConstructCompilerData(theEnv)->ImageID,ConstructCompilerData(theEnv)->ExpressionVersion, ConstructCompilerData(theEnv)->ExpressionCount + ExpressionSize(exprPtr->argList)); } if (exprPtr->argList != NULL) { fprintf(ConstructCompilerData(theEnv)->ExpressionFP,",\n"); DumpExpression(theEnv,exprPtr->argList); } exprPtr = exprPtr->nextArg; if (exprPtr != NULL) fprintf(ConstructCompilerData(theEnv)->ExpressionFP,",\n"); } } /***********************************************/ /* ConstructsToCCommandDefinition: Initializes */ /* the constructs-to-c command. */ /***********************************************/ globle void ConstructsToCCommandDefinition( void *theEnv) { EnvDefineFunction2(theEnv,"constructs-to-c",'v', PTIEF ConstructsToCCommand, "ConstructsToCCommand", "23*kii"); } /*********************************************************/ /* AddCodeGeneratorItem: Adds another code generator */ /* item to the list of items for which code is */ /* generated bythe constructs-to-c function. Typically */ /* each construct has its own code generator item. */ /*********************************************************/ globle struct CodeGeneratorItem *AddCodeGeneratorItem( void *theEnv, char *name, int priority, void (*beforeFunction)(void *), void (*initFunction)(void *,FILE *,int,int), int (*generateFunction)(void *,char *,int,FILE *,int,int), int arrayCount) { struct CodeGeneratorItem *newPtr, *currentPtr, *lastPtr = NULL; register int i; char theBuffer[3]; /*======================================*/ /* Create the code generator item data */ /* structure and initialize its values. */ /*======================================*/ newPtr = get_struct(theEnv,CodeGeneratorItem); newPtr->name = name; newPtr->beforeFunction = beforeFunction; newPtr->initFunction = initFunction; newPtr->generateFunction = generateFunction; newPtr->priority = priority; newPtr->arrayCount = arrayCount; /*================================================*/ /* Create the primary and secondary codes used to */ /* provide names for the C data structure arrays. */ /* (The maximum number of arrays is currently */ /* limited to 47. */ /*================================================*/ if (arrayCount != 0) { if ((arrayCount + ConstructCompilerData(theEnv)->CodeGeneratorCount) > (PRIMARY_LEN + SECONDARY_LEN)) { SystemError(theEnv,"CONSCOMP",2); EnvExitRouter(theEnv,EXIT_FAILURE); } newPtr->arrayNames = (char **) gm2(theEnv,(sizeof(char *) * arrayCount)); for (i = 0 ; i < arrayCount ; i++) { if (ConstructCompilerData(theEnv)->CodeGeneratorCount < PRIMARY_LEN) { sprintf(theBuffer,"%c",PRIMARY_CODES[ConstructCompilerData(theEnv)->CodeGeneratorCount]); } else { sprintf(theBuffer,"%c_",SECONDARY_CODES[ConstructCompilerData(theEnv)->CodeGeneratorCount - PRIMARY_LEN]); } ConstructCompilerData(theEnv)->CodeGeneratorCount++; newPtr->arrayNames[i] = (char *) gm2(theEnv,(strlen(theBuffer) + 1)); strcpy(newPtr->arrayNames[i],theBuffer); } } else { newPtr->arrayNames = NULL; } /*===========================================*/ /* Add the new item in the appropriate place */ /* in the code generator item list. */ /*===========================================*/ if (ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems == NULL) { newPtr->next = NULL; ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems = newPtr; return(newPtr); } currentPtr = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems; ConstructCompilerData(theEnv)->ListOfCodeGeneratorItems = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } /*=========================*/ /* Return a pointer to the */ /* code generator item. */ /*=========================*/ return(newPtr); } /************************************************************/ /* CloseFileIfNeeded: Determines if a C file to which data */ /* structures have been written should be closed. The */ /* file is closed either when all data structures of */ /* that specific type are written to files or the maximum */ /* number of array entries for a single file has been */ /* exceeded. */ /************************************************************/ globle FILE *CloseFileIfNeeded( void *theEnv, FILE *theFile, int *theCount, int *arrayVersion, int maxIndices, int *canBeReopened, struct CodeGeneratorFile *codeFile) { /*==========================================*/ /* If the maximum number of entries for the */ /* file hasn't been exceeded, then... */ /*==========================================*/ if (*theCount < maxIndices) { /*====================================*/ /* If the file can be reopened later, */ /* close it. Otherwise, keep it open. */ /*====================================*/ if (canBeReopened != NULL) { *canBeReopened = TRUE; GenClose(theEnv,theFile); return(NULL); } return(theFile); } /*===========================================*/ /* Otherwise, the number of entries allowed */ /* in a file has been reached. Indicate that */ /* the file can't be reopened. */ /*===========================================*/ if (canBeReopened != NULL) { *canBeReopened = FALSE; } /*===============================================*/ /* If the file is closed, then we need to reopen */ /* it to print the final closing right brace. */ /*===============================================*/ if (theFile == NULL) { if ((canBeReopened == NULL) || (codeFile == NULL)) { SystemError(theEnv,"CONSCOMP",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (codeFile->filePrefix == NULL) { return(NULL); } theFile = NewCFile(theEnv,codeFile->filePrefix,codeFile->id,codeFile->version,TRUE); if (theFile == NULL) { SystemError(theEnv,"CONSCOMP",4); EnvExitRouter(theEnv,EXIT_FAILURE); } } /*================================*/ /* Print the final closing brace. */ /*================================*/ fprintf(theFile,"};\n"); GenClose(theEnv,theFile); /*============================================*/ /* Update index values for subsequent writing */ /* of data structures to files. */ /*============================================*/ *theCount = 0; (*arrayVersion)++; /*=========================*/ /* Return NULL to indicate */ /* the file is closed. */ /*=========================*/ return(NULL); } /**************************************************************/ /* OpenFileIfNeeded: Determines if a C file to which data */ /* structures have been written should be closed. The */ /* file is closed either when all data structures of */ /* that specific type are written to files or the maximum */ /* number of array entries for a single file has been */ /* exceeded. */ /******************************************************************/ globle FILE *OpenFileIfNeeded( void *theEnv, FILE *theFile, char *fileName, int fileID, int imageID, int *fileCount, int arrayVersion, FILE *headerFP, char *structureName, char *structPrefix, int reopenOldFile, struct CodeGeneratorFile *codeFile) { char arrayName[80]; char *newName; int newID, newVersion; /*===========================================*/ /* If a file is being reopened, use the same */ /* version number, name, and ID as before. */ /*===========================================*/ if (reopenOldFile) { if (codeFile == NULL) { SystemError(theEnv,"CONSCOMP",5); EnvExitRouter(theEnv,EXIT_FAILURE); } newName = codeFile->filePrefix; newID = codeFile->id; newVersion = codeFile->version; } /*=====================================================*/ /* Otherwise, use the specified version number, name, */ /* and ID. If the appropriate argument is supplied, */ /* remember these values for later reopening the file. */ /*=====================================================*/ else { newName = fileName; newVersion = *fileCount; newID = fileID; if (codeFile != NULL) { codeFile->version = newVersion; codeFile->filePrefix = newName; codeFile->id = newID; } } /*=========================================*/ /* If the file is already open, return it. */ /*=========================================*/ if (theFile != NULL) { fprintf(theFile,",\n"); return(theFile); } /*================*/ /* Open the file. */ /*================*/ if ((theFile = NewCFile(theEnv,newName,newID,newVersion,reopenOldFile)) == NULL) { return(NULL); } /*=========================================*/ /* If this is the first time the file has */ /* been opened, write out the beginning of */ /* the array variable definition. */ /*=========================================*/ if (reopenOldFile == FALSE) { (*fileCount)++; sprintf(arrayName,"%s%d_%d",structPrefix,imageID,arrayVersion); fprintf(theFile,"%s %s[] = {\n",structureName,arrayName); fprintf(headerFP,"extern %s %s[];\n",structureName,arrayName); } else { fprintf(theFile,",\n"); } /*==================*/ /* Return the file. */ /*==================*/ return(theFile); } /*************************************************/ /* MarkConstructBsaveIDs: Mark all occurences of */ /* a specific construct with a unique ID. */ /*************************************************/ globle void MarkConstructBsaveIDs( void *theEnv, int constructModuleIndex) { long theCount = 0; DoForAllConstructs(theEnv,MarkConstruct,constructModuleIndex,FALSE,&theCount); } /*************************************************************/ /* MarkConstruct: Sets the bsaveID for a specific construct. */ /* Used with the MarkConstructBsaveIDs function to mark all */ /* occurences of a specific construct with a unique ID. */ /*************************************************************/ #if IBM_TBC #pragma argsused #endif static void MarkConstruct( void *theEnv, struct constructHeader *theConstruct, void *vTheBuffer) { long *count = (long *) vTheBuffer; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif theConstruct->bsaveID = (*count)++; } /***********************************************************/ /* ConstructHeaderToCode: Writes the C code representation */ /* of a single construct header to the specified file. */ /***********************************************************/ globle void ConstructHeaderToCode( void *theEnv, FILE *theFile, struct constructHeader *theConstruct, int imageID, int maxIndices, int moduleCount, char *constructModulePrefix, char *constructPrefix) { /*================*/ /* Construct Name */ /*================*/ fprintf(theFile,"{"); PrintSymbolReference(theEnv,theFile,theConstruct->name); /*===================*/ /* Pretty Print Form */ /*===================*/ fprintf(theFile,",NULL,"); /*====================*/ /* Construct Module */ /*====================*/ fprintf(theFile,"MIHS &%s%d_%d[%d],", constructModulePrefix, imageID, (moduleCount / maxIndices) + 1, moduleCount % maxIndices); /*==========*/ /* Bsave ID */ /*==========*/ fprintf(theFile,"0,"); /*================*/ /* Next Construct */ /*================*/ if (theConstruct->next == NULL) { fprintf(theFile,"NULL}"); } else { fprintf(theFile,"CHS &%s%d_%ld[%ld]}", constructPrefix, imageID, (theConstruct->next->bsaveID / maxIndices) + 1, theConstruct->next->bsaveID % maxIndices); } } /***********************************************************/ /* ConstructModuleToCode: Writes the C code representation */ /* of a single construct module to the specified file. */ /***********************************************************/ globle void ConstructModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int constructIndex, char *constructPrefix) { struct defmoduleItemHeader *theModuleItem; /*======================*/ /* Associated Defmodule */ /*======================*/ fprintf(theFile,"{"); theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,constructIndex); PrintDefmoduleReference(theEnv,theFile,theModule); fprintf(theFile,","); /*=============================*/ /* First Construct Module Item */ /*=============================*/ if (theModuleItem->firstItem == NULL) fprintf(theFile,"NULL,"); else fprintf(theFile,"CHS &%s%d_%ld[%ld],", constructPrefix, imageID, (long) (theModuleItem->firstItem->bsaveID / maxIndices) + 1, (long) theModuleItem->firstItem->bsaveID % maxIndices); /*============================*/ /* Last Construct Module Item */ /*============================*/ if (theModuleItem->lastItem == NULL) fprintf(theFile,"NULL"); else fprintf(theFile,"CHS &%s%d_%ld[%ld]", constructPrefix, imageID, (long) (theModuleItem->lastItem->bsaveID / maxIndices) + 1, (long) theModuleItem->lastItem->bsaveID % maxIndices); fprintf(theFile,"}"); } #else /* CONSTRUCT_COMPILER && (! RUN_TIME) */ void ConstructsToCCommand(void *); /************************************/ /* ConstructsToCCommand: Definition */ /* for rule compiler stub. */ /************************************/ void ConstructsToCCommand( void *theEnv) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ clips-6.24/clipssrc/._factbld.c0000400000175000017500000000452210441071737014504 0ustar jfsjfsMac OS X  2 R TEXTR*chn factbld.ctrol PanelTCmr.txt.docTEXTR*ch p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco9v9vN`nS&nGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/._insqypsr.h0000400000175000017500000000012207422634652015000 0ustar jfsjfsMac OS X  2 RTEXT???? aclips-6.24/clipssrc/lgcldpnd.h0000755000175000017500000000506310441147665014506 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* LOGICAL DEPENDENCIES HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provide support routines for managing truth */ /* maintenance using the logical conditional element. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_lgcldpnd #define _H_lgcldpnd struct dependency { void *dPtr; struct dependency *next; }; #ifndef _H_match #include "match.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _LGCLDPND_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool AddLogicalDependencies(void *,struct patternEntity *,int); LOCALE void RemoveEntityDependencies(void *,struct patternEntity *); LOCALE void RemovePMDependencies(void *,struct partialMatch *); LOCALE void DestroyPMDependencies(void *,struct partialMatch *); LOCALE void RemoveLogicalSupport(void *,struct partialMatch *); LOCALE void ForceLogicalRetractions(void *); LOCALE void Dependencies(void *,struct patternEntity *); LOCALE void Dependents(void *,struct patternEntity *); LOCALE void DependenciesCommand(void *); LOCALE void DependentsCommand(void *); LOCALE void ReturnEntityDependencies(void *,struct patternEntity *); #endif clips-6.24/clipssrc/._symblbin.c0000400000175000017500000000012207422634602014715 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/factrete.c0000755000175000017500000010111710441143445014474 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* FACT RETE ACCESS FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Rete access functions for fact pattern matching. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _FACTRETE_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "memalloc.h" #include "extnfunc.h" #include "router.h" #include "incrrset.h" #include "reteutil.h" #include "drive.h" #include "engine.h" #include "factgen.h" #include "factmch.h" #include "envrnmnt.h" #include "factrete.h" /***************************************************************/ /* FactPNGetVar1: Fact pattern network function for extracting */ /* a variable's value. This is the most generalized routine. */ /***************************************************************/ globle intBool FactPNGetVar1( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { unsigned short theField, theSlot; struct fact *factPtr; struct field *fieldPtr; struct multifieldMarker *marks; struct multifield *segmentPtr; int extent; struct factGetVarPN1Call *hack; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarPN1Call *) ValueToBitMap(theValue); /*=====================================================*/ /* Get the pointer to the fact from the partial match. */ /*=====================================================*/ factPtr = FactData(theEnv)->CurrentPatternFact; marks = FactData(theEnv)->CurrentPatternMarks; /*==========================================================*/ /* Determine if we want to retrieve the fact address of the */ /* fact, rather than retrieving a field from the fact. */ /*==========================================================*/ if (hack->factAddress) { returnValue->type = FACT_ADDRESS; returnValue->value = (void *) factPtr; return(TRUE); } /*=========================================================*/ /* Determine if we want to retrieve the entire slot value. */ /*=========================================================*/ if (hack->allFields) { theSlot = hack->whichSlot; fieldPtr = &factPtr->theProposition.theFields[theSlot]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; if (returnValue->type == MULTIFIELD) { SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,((struct multifield *) fieldPtr->value)->multifieldLength); } return(TRUE); } /*====================================================*/ /* If the slot being accessed is a single field slot, */ /* then just return the single value found in that */ /* slot. The multifieldMarker data structures do not */ /* have to be considered since access to a single */ /* field slot is not affected by variable bindings */ /* from multifield slots. */ /*====================================================*/ theField = hack->whichField; theSlot = hack->whichSlot; fieldPtr = &factPtr->theProposition.theFields[theSlot]; /*==========================================================*/ /* Retrieve a value from a multifield slot. First determine */ /* the range of fields for the variable being retrieved. */ /*==========================================================*/ extent = -1; theField = AdjustFieldPosition(theEnv,marks,theField,theSlot,&extent); /*=============================================================*/ /* If a range of values are being retrieved (i.e. a multifield */ /* variable), then return the values as a multifield. */ /*=============================================================*/ if (extent != -1) { returnValue->type = MULTIFIELD; returnValue->value = (void *) fieldPtr->value; returnValue->begin = theField; returnValue->end = theField + extent - 1; return(TRUE); } /*========================================================*/ /* Otherwise a single field value is being retrieved from */ /* a multifield slot. Just return the type and value. */ /*========================================================*/ segmentPtr = (struct multifield *) fieldPtr->value; fieldPtr = &segmentPtr->theFields[theField]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /**************************************************/ /* FactPNGetVar2: Fact pattern network function */ /* for extracting a variable's value. The value */ /* extracted is from a single field slot. */ /**************************************************/ globle intBool FactPNGetVar2( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct fact *factPtr; struct factGetVarPN2Call *hack; struct field *fieldPtr; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarPN2Call *) ValueToBitMap(theValue); /*==============================*/ /* Get the pointer to the fact. */ /*==============================*/ factPtr = FactData(theEnv)->CurrentPatternFact; /*============================================*/ /* Extract the value from the specified slot. */ /*============================================*/ fieldPtr = &factPtr->theProposition.theFields[hack->whichSlot]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /*****************************************************************/ /* FactPNGetVar3: Fact pattern network function for extracting a */ /* variable's value. The value extracted is from a multifield */ /* slot that contains at most one multifield variable. */ /*****************************************************************/ globle intBool FactPNGetVar3( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct fact *factPtr; struct multifield *segmentPtr; struct field *fieldPtr; struct factGetVarPN3Call *hack; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarPN3Call *) ValueToBitMap(theValue); /*==============================*/ /* Get the pointer to the fact. */ /*==============================*/ factPtr = FactData(theEnv)->CurrentPatternFact; /*============================================================*/ /* Get the multifield value from which the data is retrieved. */ /*============================================================*/ segmentPtr = (struct multifield *) factPtr->theProposition.theFields[hack->whichSlot].value; /*=========================================*/ /* If the beginning and end flags are set, */ /* then retrieve a multifield value. */ /*=========================================*/ if (hack->fromBeginning && hack->fromEnd) { returnValue->type = MULTIFIELD; returnValue->value = (void *) segmentPtr; returnValue->begin = (long) hack->beginOffset; returnValue->end = (long) (segmentPtr->multifieldLength - (hack->endOffset + 1)); return(TRUE); } /*=====================================================*/ /* Return a single field value from a multifield slot. */ /*=====================================================*/ if (hack->fromBeginning) { fieldPtr = &segmentPtr->theFields[hack->beginOffset]; } else { fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (hack->endOffset + 1)]; } returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /******************************************************/ /* FactPNConstant1: Fact pattern network function for */ /* comparing a value stored in a single field slot */ /* to a constant for either equality or inequality. */ /******************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool FactPNConstant1( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(returnValue) #endif struct factConstantPN1Call *hack; struct field *fieldPtr; struct expr *theConstant; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factConstantPN1Call *) ValueToBitMap(theValue); /*============================================*/ /* Extract the value from the specified slot. */ /*============================================*/ fieldPtr = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot]; /*====================================*/ /* Compare the value to the constant. */ /*====================================*/ theConstant = GetFirstArgument(); if (theConstant->type != fieldPtr->type) return(1 - hack->testForEquality); if (theConstant->value != fieldPtr->value) return(1 - hack->testForEquality); return(hack->testForEquality); } /****************************************************************/ /* FactPNConstant2: Fact pattern network function for comparing */ /* a value stored in a slot to a constant for either equality */ /* or inequality. The value being retrieved from the slot has */ /* no multifields to its right (thus it can be retrieved */ /* relative to the beginning). */ /****************************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool FactPNConstant2( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(returnValue) #endif struct factConstantPN2Call *hack; struct field *fieldPtr; struct expr *theConstant; struct multifield *segmentPtr; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factConstantPN2Call *) ValueToBitMap(theValue); /*==========================================================*/ /* Extract the value from the specified slot. Note that the */ /* test to determine the slot's type (multifield) should be */ /* unnecessary since this routine should only be used for */ /* multifield slots. */ /*==========================================================*/ fieldPtr = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot]; if (fieldPtr->type == MULTIFIELD) { segmentPtr = (struct multifield *) fieldPtr->value; if (hack->fromBeginning) { fieldPtr = &segmentPtr->theFields[hack->offset]; } else { fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (hack->offset + 1)]; } } /*====================================*/ /* Compare the value to the constant. */ /*====================================*/ theConstant = GetFirstArgument(); if (theConstant->type != fieldPtr->type) return(1 - hack->testForEquality); if (theConstant->value != fieldPtr->value) return(1 - hack->testForEquality); return(hack->testForEquality); } /**************************************************************/ /* FactJNGetVar1: Fact join network function for extracting a */ /* variable's value. This is the most generalized routine. */ /**************************************************************/ globle intBool FactJNGetVar1( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { unsigned short theField, theSlot; struct fact *factPtr; struct field *fieldPtr; struct multifieldMarker *marks; struct multifield *segmentPtr; int extent; struct factGetVarJN1Call *hack; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarJN1Call *) ValueToBitMap(theValue); /*=====================================================*/ /* Get the pointer to the fact from the partial match. */ /*=====================================================*/ if (EngineData(theEnv)->GlobalRHSBinds == NULL) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; marks = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->markers; } else if ((EngineData(theEnv)->GlobalJoin->depth - 1) == hack->whichPattern) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->matchingItem; marks = get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->markers; } else { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; marks = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->markers; } /*==========================================================*/ /* Determine if we want to retrieve the fact address of the */ /* fact, rather than retrieving a field from the fact. */ /*==========================================================*/ if (hack->factAddress) { returnValue->type = FACT_ADDRESS; returnValue->value = (void *) factPtr; return(TRUE); } /*=========================================================*/ /* Determine if we want to retrieve the entire slot value. */ /*=========================================================*/ if (hack->allFields) { theSlot = hack->whichSlot; fieldPtr = &factPtr->theProposition.theFields[theSlot]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; if (returnValue->type == MULTIFIELD) { SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,((struct multifield *) fieldPtr->value)->multifieldLength); } return(TRUE); } /*====================================================*/ /* If the slot being accessed is a single field slot, */ /* then just return the single value found in that */ /* slot. The multifieldMarker data structures do not */ /* have to be considered since access to a single */ /* field slot is not affected by variable bindings */ /* from multifield slots. */ /*====================================================*/ theField = hack->whichField; theSlot = hack->whichSlot; fieldPtr = &factPtr->theProposition.theFields[theSlot]; if (fieldPtr->type != MULTIFIELD) { returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /*==========================================================*/ /* Retrieve a value from a multifield slot. First determine */ /* the range of fields for the variable being retrieved. */ /*==========================================================*/ extent = -1; theField = AdjustFieldPosition(theEnv,marks,theField,theSlot,&extent); /*=============================================================*/ /* If a range of values are being retrieved (i.e. a multifield */ /* variable), then return the values as a multifield. */ /*=============================================================*/ if (extent != -1) { returnValue->type = MULTIFIELD; returnValue->value = (void *) fieldPtr->value; returnValue->begin = theField; returnValue->end = theField + extent - 1; return(TRUE); } /*========================================================*/ /* Otherwise a single field value is being retrieved from */ /* a multifield slot. Just return the type and value. */ /*========================================================*/ segmentPtr = (struct multifield *) factPtr->theProposition.theFields[theSlot].value; fieldPtr = &segmentPtr->theFields[theField]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /*************************************************/ /* FactJNGetVar2: Fact join network function for */ /* extracting a variable's value. The value */ /* extracted is from a single field slot. */ /*************************************************/ globle intBool FactJNGetVar2( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct fact *factPtr; struct factGetVarJN2Call *hack; struct field *fieldPtr; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarJN2Call *) ValueToBitMap(theValue); /*=====================================================*/ /* Get the pointer to the fact from the partial match. */ /*=====================================================*/ if (EngineData(theEnv)->GlobalRHSBinds == NULL) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } else if ((EngineData(theEnv)->GlobalJoin->depth - 1) == hack->whichPattern) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->matchingItem; } else { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } /*============================================*/ /* Extract the value from the specified slot. */ /*============================================*/ fieldPtr = &factPtr->theProposition.theFields[hack->whichSlot]; returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /****************************************************************/ /* FactJNGetVar3: Fact join network function for extracting a */ /* variable's value. The value extracted is from a multifield */ /* slot that contains at most one multifield variable. */ /****************************************************************/ globle intBool FactJNGetVar3( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct fact *factPtr; struct multifield *segmentPtr; struct field *fieldPtr; struct factGetVarJN3Call *hack; /*==========================================*/ /* Retrieve the arguments for the function. */ /*==========================================*/ hack = (struct factGetVarJN3Call *) ValueToBitMap(theValue); /*=====================================================*/ /* Get the pointer to the fact from the partial match. */ /*=====================================================*/ if (EngineData(theEnv)->GlobalRHSBinds == NULL) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } else if ((EngineData(theEnv)->GlobalJoin->depth - 1) == hack->whichPattern) { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->matchingItem; } else { factPtr = (struct fact *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,hack->whichPattern)->matchingItem; } /*============================================================*/ /* Get the multifield value from which the data is retrieved. */ /*============================================================*/ segmentPtr = (struct multifield *) factPtr->theProposition.theFields[hack->whichSlot].value; /*=========================================*/ /* If the beginning and end flags are set, */ /* then retrieve a multifield value. */ /*=========================================*/ if (hack->fromBeginning && hack->fromEnd) { returnValue->type = MULTIFIELD; returnValue->value = (void *) segmentPtr; returnValue->begin = hack->beginOffset; returnValue->end = (long) (segmentPtr->multifieldLength - (hack->endOffset + 1)); return(TRUE); } /*=====================================================*/ /* Return a single field value from a multifield slot. */ /*=====================================================*/ if (hack->fromBeginning) { fieldPtr = &segmentPtr->theFields[hack->beginOffset]; } else { fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (hack->endOffset + 1)]; } returnValue->type = fieldPtr->type; returnValue->value = fieldPtr->value; return(TRUE); } /****************************************************/ /* FactSlotLength: Determines if the length of a */ /* multifield slot falls within a specified range. */ /****************************************************/ globle intBool FactSlotLength( void *theEnv, void *theValue, DATA_OBJECT_PTR returnValue) { struct factCheckLengthPNCall *hack; struct multifield *segmentPtr; int extraOffset = 0; struct multifieldMarker *tempMark; returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); hack = (struct factCheckLengthPNCall *) ValueToBitMap(theValue); for (tempMark = FactData(theEnv)->CurrentPatternMarks; tempMark != NULL; tempMark = tempMark->next) { if (tempMark->where.whichSlotNumber != hack->whichSlot) continue; extraOffset += ((tempMark->endPosition - tempMark->startPosition) + 1); } segmentPtr = (struct multifield *) FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot].value; if (segmentPtr->multifieldLength < (unsigned) (hack->minLength + extraOffset)) { return(FALSE); } if (hack->exactly && (segmentPtr->multifieldLength > (unsigned) (hack->minLength + extraOffset))) { return(FALSE); } returnValue->value = EnvTrueSymbol(theEnv); return(TRUE); } /************************************************************/ /* FactJNCompVars1: Fact join network routine for comparing */ /* the values of two single field slots. */ /************************************************************/ #if IBM_TBC #pragma argsused #endif globle int FactJNCompVars1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theResult) #endif int p1, e1, p2, e2; struct fact *fact1, *fact2; struct factCompVarsJN1Call *hack; /*=========================================*/ /* Retrieve the arguments to the function. */ /*=========================================*/ hack = (struct factCompVarsJN1Call *) ValueToBitMap(theValue); /*=================================================*/ /* Extract the fact pointers for the two patterns. */ /*=================================================*/ p1 = EngineData(theEnv)->GlobalJoin->depth - 1; p2 = ((int) hack->pattern2) - 1; fact1 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[0].gm.theMatch->matchingItem; if (p1 != p2) { fact2 = (struct fact *) EngineData(theEnv)->GlobalLHSBinds->binds[p2].gm.theMatch->matchingItem; } else { fact2 = fact1; } /*=====================*/ /* Compare the values. */ /*=====================*/ e1 = (int) hack->slot1; e2 = (int) hack->slot2; if (fact1->theProposition.theFields[e1].type != fact2->theProposition.theFields[e2].type) { return((int) hack->fail); } if (fact1->theProposition.theFields[e1].value != fact2->theProposition.theFields[e2].value) { return((int) hack->fail); } return((int) hack->pass); } /*****************************************************************/ /* FactJNCompVars2: Fact join network routine for comparing the */ /* two single field value that are found in the first slot */ /* (which must also be a multifield slot) of a deftemplate. */ /* This function is provided so that variable comparisons of */ /* implied deftemplates will be faster. */ /*****************************************************************/ #if IBM_TBC #pragma argsused #endif globle int FactJNCompVars2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theResult) #endif int p1, s1, p2, s2; struct fact *fact1, *fact2; struct factCompVarsJN2Call *hack; struct multifield *segment; struct field *fieldPtr1, *fieldPtr2; /*=========================================*/ /* Retrieve the arguments to the function. */ /*=========================================*/ hack = (struct factCompVarsJN2Call *) ValueToBitMap(theValue); /*=================================================*/ /* Extract the fact pointers for the two patterns. */ /*=================================================*/ p1 = EngineData(theEnv)->GlobalJoin->depth - 1; p2 = ((int) hack->pattern2) - 1; s1 = (int) hack->slot1; s2 = (int) hack->slot2; fact1 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[0].gm.theMatch->matchingItem; if (p1 != p2) { fact2 = (struct fact *) EngineData(theEnv)->GlobalLHSBinds->binds[p2].gm.theMatch->matchingItem; } else { fact2 = fact1; } /*======================*/ /* Retrieve the values. */ /*======================*/ if (fact1->theProposition.theFields[s1].type != MULTIFIELD) { fieldPtr1 = &fact1->theProposition.theFields[s1]; } else { segment = (struct multifield *) fact1->theProposition.theFields[s1].value; if (hack->fromBeginning1) { fieldPtr1 = &segment->theFields[hack->offset1]; } else { fieldPtr1 = &segment->theFields[segment->multifieldLength - (hack->offset1 + 1)]; } } if (fact2->theProposition.theFields[s2].type != MULTIFIELD) { fieldPtr2 = &fact2->theProposition.theFields[s2]; } else { segment = (struct multifield *) fact2->theProposition.theFields[s2].value; if (hack->fromBeginning2) { fieldPtr2 = &segment->theFields[hack->offset2]; } else { fieldPtr2 = &segment->theFields[segment->multifieldLength - (hack->offset2 + 1)]; } } /*=====================*/ /* Compare the values. */ /*=====================*/ if (fieldPtr1->type != fieldPtr2->type) { return((int) hack->fail); } if (fieldPtr1->value != fieldPtr2->value) { return((int) hack->fail); } return((int) hack->pass); } /*****************************************************/ /* FactPNCompVars1: Fact pattern network routine for */ /* comparing the values of two single field slots. */ /*****************************************************/ globle int FactPNCompVars1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { int rv; struct field *fieldPtr1, *fieldPtr2; struct factCompVarsPN1Call *hack; /*========================================*/ /* Extract the arguments to the function. */ /*========================================*/ hack = (struct factCompVarsPN1Call *) ValueToBitMap(theValue); fieldPtr1 = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->field1]; fieldPtr2 = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->field2]; /*=====================*/ /* Compare the values. */ /*=====================*/ if (fieldPtr1->type != fieldPtr2->type) rv = (int) hack->fail; else if (fieldPtr1->value != fieldPtr2->value) rv = (int) hack->fail; else rv = (int) hack->pass; theResult->type = SYMBOL; if (rv) theResult->value = EnvTrueSymbol(theEnv); else theResult->value = EnvFalseSymbol(theEnv); return(rv); } /*************************************************************************/ /* AdjustFieldPosition: Given a list of multifield markers and the index */ /* to a variable in a slot, this function computes the index to the */ /* field in the slot where the variable begins. In the case of */ /* multifield variables, it also computes the extent (or length) of */ /* the multifield. Note that the extent should be given a default */ /* value of either -1 or 1 for variables other than multifield */ /* variables before calling this routine. An extent of -1 for these */ /* variables will distinguish their extent as being different when it */ /* is necessary to note their difference from a multifield variable */ /* with an extent of 1. For example, given the slot pattern */ /* (data $?x c $?y ?z) and the slot value (data a b c d e f x), the */ /* actual index in the fact for the 5th item in the pattern (the */ /* variable ?z) would be 8 since $?x binds to 2 fields and $?y binds */ /* to 3 fields. */ /*************************************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned short AdjustFieldPosition( void *theEnv, struct multifieldMarker *markList, unsigned short whichField, unsigned short whichSlot, int *extent) { unsigned short actualIndex; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif actualIndex = whichField; for (; markList != NULL; markList = markList->next) { /*===============================================*/ /* Skip over multifield markers for other slots. */ /*===============================================*/ if (markList->where.whichSlotNumber != whichSlot) continue; /*=========================================================*/ /* If the multifield marker occurs exactly at the field in */ /* question, then the actual index needs to be adjusted */ /* and the extent needs to be computed since the value is */ /* a multifield value. */ /*=========================================================*/ if (markList->whichField == whichField) { *extent = (markList->endPosition - markList->startPosition) + 1; return(actualIndex); } /*=====================================================*/ /* Otherwise if the multifield marker occurs after the */ /* field in question, then the actual index has been */ /* completely computed and can be returned. */ /*=====================================================*/ else if (markList->whichField > whichField) { return(actualIndex); } /*==========================================================*/ /* Adjust the actual index to the field based on the number */ /* of fields taken up by the preceding multifield variable. */ /*==========================================================*/ actualIndex += (unsigned short) (markList->endPosition - markList->startPosition); } /*=======================================*/ /* Return the actual index to the field. */ /*=======================================*/ return(actualIndex); } /*****************************************************/ /* FactStoreMultifield: This primitive is used by a */ /* number of multifield functions for grouping a */ /* series of valuesinto a single multifield value. */ /*****************************************************/ #if IBM_TBC #pragma argsused #endif globle int FactStoreMultifield( void *theEnv, void *theValue, DATA_OBJECT *theResult) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theValue) #endif StoreInMultifield(theEnv,theResult,GetFirstArgument(),FALSE); return(TRUE); } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/insfun.h0000755000175000017500000001136610441602232014206 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INSTANCE FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Link error occurs for the SlotExistError */ /* function when OBJECT_SYSTEM is set to 0 in */ /* setup.h. DR0865 */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved EvaluateAndStoreInDataObject to */ /* evaluatn.c */ /* */ /*************************************************************/ #ifndef _H_insfun #define _H_insfun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_object #include "object.h" #endif #ifndef _H_pattern #include "pattern.h" #endif typedef struct igarbage { INSTANCE_TYPE *ins; struct igarbage *nxt; } IGARBAGE; #define INSTANCE_TABLE_HASH_SIZE 8191 #define InstanceSizeHeuristic(ins) sizeof(INSTANCE_TYPE) #ifdef LOCALE #undef LOCALE #endif #ifdef _INSFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DecrementInstanceCount(theEnv,a) EnvDecrementInstanceCount(theEnv,a) #define GetInstancesChanged(theEnv) EnvGetInstancesChanged(theEnv) #define IncrementInstanceCount(theEnv,a) EnvIncrementInstanceCount(theEnv,a) #define SetInstancesChanged(theEnv,a) EnvSetInstancesChanged(theEnv,a) #else #define DecrementInstanceCount(a) EnvDecrementInstanceCount(GetCurrentEnvironment(),a) #define GetInstancesChanged() EnvGetInstancesChanged(GetCurrentEnvironment()) #define IncrementInstanceCount(a) EnvIncrementInstanceCount(GetCurrentEnvironment(),a) #define SetInstancesChanged(a) EnvSetInstancesChanged(GetCurrentEnvironment(),a) #endif LOCALE void EnvIncrementInstanceCount(void *,void *); LOCALE void EnvDecrementInstanceCount(void *,void *); LOCALE void InitializeInstanceTable(void *); LOCALE void CleanupInstances(void *); LOCALE unsigned HashInstance(SYMBOL_HN *); LOCALE void DestroyAllInstances(void *); LOCALE void RemoveInstanceData(void *,INSTANCE_TYPE *); LOCALE INSTANCE_TYPE *FindInstanceBySymbol(void *,SYMBOL_HN *); LOCALE INSTANCE_TYPE *FindInstanceInModule(void *,SYMBOL_HN *,struct defmodule *, struct defmodule *,unsigned); LOCALE INSTANCE_SLOT *FindInstanceSlot(void *,INSTANCE_TYPE *,SYMBOL_HN *); LOCALE int FindInstanceTemplateSlot(void *,DEFCLASS *,SYMBOL_HN *); LOCALE int PutSlotValue(void *,INSTANCE_TYPE *,INSTANCE_SLOT *,DATA_OBJECT *,DATA_OBJECT *,char *); LOCALE int DirectPutSlotValue(void *,INSTANCE_TYPE *,INSTANCE_SLOT *,DATA_OBJECT *,DATA_OBJECT *); LOCALE intBool ValidSlotValue(void *,DATA_OBJECT *,SLOT_DESC *,INSTANCE_TYPE *,char *); LOCALE INSTANCE_TYPE *CheckInstance(void *,char *); LOCALE void NoInstanceError(void *,char *,char *); LOCALE void StaleInstanceAddress(void *,char *,int); LOCALE int EnvGetInstancesChanged(void *); LOCALE void EnvSetInstancesChanged(void *,int); LOCALE void PrintSlot(void *,char *,SLOT_DESC *,INSTANCE_TYPE *,char *); LOCALE void PrintInstanceNameAndClass(void *,char *,INSTANCE_TYPE *,intBool); LOCALE void PrintInstanceName(void *,char *,void *); LOCALE void PrintInstanceLongForm(void *,char *,void *); #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM LOCALE void DecrementObjectBasisCount(void *,void *); LOCALE void IncrementObjectBasisCount(void *,void *); LOCALE void MatchObjectFunction(void *,void *); LOCALE intBool NetworkSynchronized(void *,void *); #endif #endif clips-6.24/clipssrc/factlhs.h0000755000175000017500000000327307422635017014342 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT BUILD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factlhs #define _H_factlhs #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTLHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int FactPatternParserFind(SYMBOL_HN *); LOCALE struct lhsParseNode *FactPatternParse(void *,char *,struct token *); LOCALE struct lhsParseNode *SequenceRestrictionParse(void *,char *,struct token *); LOCALE struct lhsParseNode *CreateInitialFactPattern(void *); #endif clips-6.24/clipssrc/._insfile.c0000400000175000017500000000075410441602225014531 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH MonacoY0Y0SYTTFL, FMPSRMWBBLclips-6.24/clipssrc/._inscom.c0000400000175000017500000000452210441147426014374 0ustar jfsjfsMac OS X  2 R TEXTR*chninscom.cntrol PanelTCmr.txt.docTEXTR*ch p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco,S0,S09FPPOnLbnGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/._dffnxfun.c0000400000175000017500000000075410441602131014712 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco;.;.nTTFL(FMPSRMWBBLclips-6.24/clipssrc/insmngr.h0000755000175000017500000000421610441147557014373 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INSTANCE PRIMITIVE SUPPORT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_insmngr #define _H_insmngr #ifndef _H_object #include "object.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSMNGR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeInstanceCommand(void *,DATA_OBJECT *); LOCALE void MakeInstanceCommand(void *,DATA_OBJECT *); LOCALE SYMBOL_HN *GetFullInstanceName(void *,INSTANCE_TYPE *); LOCALE INSTANCE_TYPE *BuildInstance(void *,SYMBOL_HN *,DEFCLASS *,intBool); LOCALE void InitSlotsCommand(void *,DATA_OBJECT *); LOCALE intBool QuashInstance(void *,INSTANCE_TYPE *); #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM LOCALE void InactiveInitializeInstance(void *,DATA_OBJECT *); LOCALE void InactiveMakeInstance(void *,DATA_OBJECT *); #endif #endif clips-6.24/clipssrc/._symbol.h0000400000175000017500000000452210441161336014412 0ustar jfsjfsMac OS X  2 R TEXTR*ch@nsymbol.h.hrol PanelTCmr.txt.docTEXTR*ch@ p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco55\0Wn/BnGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/._msgpsr.c0000400000175000017500000000075410441150154014412 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z:TTFS /FMWBBMPSRclips-6.24/clipssrc/modulbin.c0000755000175000017500000005527007673515424014535 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* DEFMODULE BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* defmodule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _MODULBIN_SOURCE_ #include "setup.h" #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "constrct.h" #include "moduldef.h" #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "modulbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateDefmodule(void *,void *,long); static void UpdatePortItem(void *,void *,long); static void ClearBload(void *); /*********************************************/ /* DefmoduleBinarySetup: Installs the binary */ /* save/load feature for defmodules. */ /*********************************************/ globle void DefmoduleBinarySetup( void *theEnv) { AddBeforeBloadFunction(theEnv,"defmodule",RemoveAllDefmodules,2000); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"defmodule",0,BsaveFind,NULL, BsaveStorage,BsaveBinaryItem, BloadStorage,BloadBinaryItem, ClearBload); #endif AddAbortBloadFunction(theEnv,"defmodule",CreateMainModule,0); #if (BLOAD || BLOAD_ONLY) AddBinaryItem(theEnv,"defmodule",0,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /**************************************************************/ /* UpdateDefmoduleItemHeader: Updates the values in defmodule */ /* item headers for the loaded binary image. */ /**************************************************************/ globle void UpdateDefmoduleItemHeader( void *theEnv, struct bsaveDefmoduleItemHeader *theBsaveHeader, struct defmoduleItemHeader *theHeader, int itemSize, void *itemArray) { long firstOffset,lastOffset; theHeader->theModule = ModulePointer(theBsaveHeader->theModule); if (theBsaveHeader->firstItem == -1L) { theHeader->firstItem = NULL; theHeader->lastItem = NULL; } else { firstOffset = itemSize * theBsaveHeader->firstItem; lastOffset = itemSize * theBsaveHeader->lastItem; theHeader->firstItem = (struct constructHeader *) &((char *) itemArray)[firstOffset]; theHeader->lastItem = (struct constructHeader *) &((char *) itemArray)[lastOffset]; } } #if BLOAD_AND_BSAVE /*********************************************************/ /* AssignBsaveDefmdlItemHdrVals: Assigns the appropriate */ /* values to a bsave defmodule item header record. */ /*********************************************************/ globle void AssignBsaveDefmdlItemHdrVals( struct bsaveDefmoduleItemHeader *theBsaveHeader, struct defmoduleItemHeader *theHeader) { theBsaveHeader->theModule = theHeader->theModule->bsaveID; if (theHeader->firstItem == NULL) { theBsaveHeader->firstItem = -1L; theBsaveHeader->lastItem = -1L; } else { theBsaveHeader->firstItem = theHeader->firstItem->bsaveID; theBsaveHeader->lastItem = theHeader->lastItem->bsaveID; } } /**********************************************************/ /* BsaveFind: Counts the number of data structures which */ /* must be saved in the binary image for the defmodules */ /* in the current environment. */ /**********************************************************/ static void BsaveFind( void *theEnv) { struct defmodule *defmodulePtr; struct portItem *theList; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DefmoduleData(theEnv)->BNumberOfDefmodules); SaveBloadCount(theEnv,DefmoduleData(theEnv)->NumberOfPortItems); /*==========================================*/ /* Set the count of defmodule and defmodule */ /* port items data structures to zero. */ /*==========================================*/ DefmoduleData(theEnv)->BNumberOfDefmodules = 0; DefmoduleData(theEnv)->NumberOfPortItems = 0; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); defmodulePtr != NULL; defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,defmodulePtr)) { /*==============================================*/ /* Increment the number of modules encountered. */ /*==============================================*/ DefmoduleData(theEnv)->BNumberOfDefmodules++; /*===========================*/ /* Mark the defmodule's name */ /* as being a needed symbol. */ /*===========================*/ defmodulePtr->name->neededSymbol = TRUE; /*==============================================*/ /* Loop through each of the port items in the */ /* defmodule's import list incrementing the */ /* number of port items encountered and marking */ /* needed symbols. */ /*==============================================*/ for (theList = defmodulePtr->importList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; if (theList->moduleName != NULL) { theList->moduleName->neededSymbol = TRUE; } if (theList->constructType != NULL) { theList->constructType->neededSymbol = TRUE; } if (theList->constructName != NULL) { theList->constructName->neededSymbol = TRUE; } } /*==============================================*/ /* Loop through each of the port items in the */ /* defmodule's export list incrementing the */ /* number of port items encountered and marking */ /* needed symbols. */ /*==============================================*/ for (theList = defmodulePtr->exportList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; if (theList->moduleName != NULL) { theList->moduleName->neededSymbol = TRUE; } if (theList->constructType != NULL) { theList->constructType->neededSymbol = TRUE; } if (theList->constructName != NULL) { theList->constructName->neededSymbol = TRUE; } } } } /*********************************************************/ /* BsaveStorage: Writes out the storage requirements for */ /* all defmodule structures to the binary file. */ /*********************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { unsigned long space; space = sizeof(long) * 2; GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); GenWrite(&DefmoduleData(theEnv)->BNumberOfDefmodules,(unsigned long) sizeof(long int),fp); GenWrite(&DefmoduleData(theEnv)->NumberOfPortItems,(unsigned long) sizeof(long int),fp); } /*********************************************/ /* BsaveBinaryItem: Writes out all defmodule */ /* structures to the binary file. */ /*********************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { unsigned long int space; struct defmodule *defmodulePtr; struct bsaveDefmodule newDefmodule; struct bsavePortItem newPortItem; struct portItem *theList; /*=========================================================*/ /* Write out the amount of space taken up by the defmodule */ /* and port item data structures in the binary image. */ /*=========================================================*/ space = DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct bsaveDefmodule); space += DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct bsavePortItem); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); /*==========================================*/ /* Write out each defmodule data structure. */ /*==========================================*/ DefmoduleData(theEnv)->BNumberOfDefmodules = 0; DefmoduleData(theEnv)->NumberOfPortItems = 0; for (defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); defmodulePtr != NULL; defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,defmodulePtr)) { newDefmodule.name = defmodulePtr->name->bucket; DefmoduleData(theEnv)->BNumberOfDefmodules++; if (defmodulePtr->next != NULL) { newDefmodule.next = DefmoduleData(theEnv)->BNumberOfDefmodules; } else { newDefmodule.next = -1L; } if (defmodulePtr->importList == NULL) { newDefmodule.importList = -1L; } else { newDefmodule.importList = DefmoduleData(theEnv)->NumberOfPortItems; for (theList = defmodulePtr->importList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; } } if (defmodulePtr->exportList == NULL) { newDefmodule.exportList = -1L; } else { newDefmodule.exportList = DefmoduleData(theEnv)->NumberOfPortItems; for (theList = defmodulePtr->exportList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; } } newDefmodule.bsaveID = defmodulePtr->bsaveID; GenWrite(&newDefmodule,(unsigned long) sizeof(struct bsaveDefmodule),fp); } /*==========================================*/ /* Write out each port item data structure. */ /*==========================================*/ DefmoduleData(theEnv)->NumberOfPortItems = 0; defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (defmodulePtr != NULL) { for (theList = defmodulePtr->importList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; if (theList->moduleName == NULL) newPortItem.moduleName = -1L; else newPortItem.moduleName = (long) theList->moduleName->bucket; if (theList->constructType == NULL) newPortItem.constructType = -1L; else newPortItem.constructType = (long) theList->constructType->bucket; if (theList->constructName == NULL) newPortItem.constructName = -1L; else newPortItem.constructName = (long) theList->constructName->bucket; if (theList->next == NULL) newPortItem.next = -1L; else newPortItem.next = DefmoduleData(theEnv)->NumberOfPortItems; GenWrite(&newPortItem,(unsigned long) sizeof(struct bsavePortItem),fp); } for (theList = defmodulePtr->exportList; theList != NULL; theList = theList->next) { DefmoduleData(theEnv)->NumberOfPortItems++; if (theList->moduleName == NULL) newPortItem.moduleName = -1L; else newPortItem.moduleName = (long) theList->moduleName->bucket; if (theList->constructType == NULL) newPortItem.constructType = -1L; else newPortItem.constructType = (long) theList->constructType->bucket; if (theList->constructName == NULL) newPortItem.constructName = -1L; else newPortItem.constructName = (long) theList->constructName->bucket; if (theList->next == NULL) newPortItem.next = -1L; else newPortItem.next = DefmoduleData(theEnv)->NumberOfPortItems; GenWrite(&newPortItem,(unsigned long) sizeof(struct bsavePortItem),fp); } defmodulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,defmodulePtr); } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of defmodule and port items in the binary image (these were */ /* overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DefmoduleData(theEnv)->BNumberOfDefmodules); RestoreBloadCount(theEnv,&DefmoduleData(theEnv)->NumberOfPortItems); } #endif /* BLOAD_AND_BSAVE */ /**********************************************************/ /* BloadStorage: Allocates storage requirements for the */ /* defmodules and port items used by this binary image. */ /**********************************************************/ static void BloadStorage( void *theEnv) { unsigned long int space; /*=======================================*/ /* Determine the number of defmodule and */ /* port item data structures to be read. */ /*=======================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); GenReadBinary(theEnv,&DefmoduleData(theEnv)->BNumberOfDefmodules,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&DefmoduleData(theEnv)->NumberOfPortItems,(unsigned long) sizeof(long int)); /*================================*/ /* Allocate the space needed for */ /* the defmodule data structures. */ /*================================*/ if (DefmoduleData(theEnv)->BNumberOfDefmodules == 0) { DefmoduleData(theEnv)->DefmoduleArray = NULL; return; } space = (unsigned long) (DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule)); DefmoduleData(theEnv)->DefmoduleArray = (struct defmodule *) genlongalloc(theEnv,space); /*================================*/ /* Allocate the space needed for */ /* the port item data structures. */ /*================================*/ if (DefmoduleData(theEnv)->NumberOfPortItems == 0) { DefmoduleData(theEnv)->PortItemArray = NULL; return; } space = (unsigned long) (DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem)); DefmoduleData(theEnv)->PortItemArray = (struct portItem *) genlongalloc(theEnv,space); } /********************************************/ /* BloadBinaryItem: Loads and refreshes the */ /* defmodules used by this binary image. */ /********************************************/ static void BloadBinaryItem( void *theEnv) { unsigned long int space; GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); if (DefmoduleData(theEnv)->BNumberOfDefmodules == 0) return; BloadandRefresh(theEnv,DefmoduleData(theEnv)->BNumberOfDefmodules,(unsigned) sizeof(struct bsaveDefmodule),UpdateDefmodule); BloadandRefresh(theEnv,DefmoduleData(theEnv)->NumberOfPortItems,(unsigned) sizeof(struct bsavePortItem),UpdatePortItem); SetListOfDefmodules(theEnv,(void *) DefmoduleData(theEnv)->DefmoduleArray); EnvSetCurrentModule(theEnv,(void *) EnvGetNextDefmodule(theEnv,NULL)); } /******************************************/ /* UpdateDefmodule: Bload refresh routine */ /* for defmodule data structure. */ /******************************************/ static void UpdateDefmodule( void *theEnv, void *buf, long obji) { struct bsaveDefmodule *bdp; struct moduleItem *theItem; int i; bdp = (struct bsaveDefmodule *) buf; DefmoduleData(theEnv)->DefmoduleArray[obji].name = SymbolPointer(bdp->name); IncrementSymbolCount(DefmoduleData(theEnv)->DefmoduleArray[obji].name); if (bdp->next != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].next = (struct defmodule *) &DefmoduleData(theEnv)->DefmoduleArray[bdp->next]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].next = NULL; } if (GetNumberOfModuleItems(theEnv) == 0) { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = NULL; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * GetNumberOfModuleItems(theEnv)); } for (i = 0, theItem = GetListOfModuleItems(theEnv); (i < GetNumberOfModuleItems(theEnv)) && (theItem != NULL) ; i++, theItem = theItem->next) { if (theItem->bloadModuleReference == NULL) { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] = NULL; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] = (struct defmoduleItemHeader *) (*theItem->bloadModuleReference)(theEnv,obji); } } DefmoduleData(theEnv)->DefmoduleArray[obji].ppForm = NULL; if (bdp->importList != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].importList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->importList]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].importList = NULL; } if (bdp->exportList != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->exportList]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = NULL; } DefmoduleData(theEnv)->DefmoduleArray[obji].bsaveID = bdp->bsaveID; } /*****************************************/ /* UpdatePortItem: Bload refresh routine */ /* for port item data structure. */ /*****************************************/ static void UpdatePortItem( void *theEnv, void *buf, long obji) { struct bsavePortItem *bdp; bdp = (struct bsavePortItem *) buf; if (bdp->moduleName != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].moduleName = SymbolPointer(bdp->moduleName); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].moduleName); } else { DefmoduleData(theEnv)->PortItemArray[obji].moduleName = NULL; } if (bdp->constructType != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].constructType = SymbolPointer(bdp->constructType); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructType); } else { DefmoduleData(theEnv)->PortItemArray[obji].constructType = NULL; } if (bdp->constructName != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].constructName = SymbolPointer(bdp->constructName); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructName); } else { DefmoduleData(theEnv)->PortItemArray[obji].constructName = NULL; } if (bdp->next != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].next = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->next]; } else { DefmoduleData(theEnv)->PortItemArray[obji].next = NULL; } } /***************************************/ /* ClearBload: Defmodule clear routine */ /* when a binary load is in effect. */ /***************************************/ static void ClearBload( void *theEnv) { long i; unsigned long space; struct portItem *theList; /*===========================*/ /* Decrement in use counters */ /* used by the binary image. */ /*===========================*/ for (i = 0; i < DefmoduleData(theEnv)->BNumberOfDefmodules; i++) { DecrementSymbolCount(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].name); for (theList = DefmoduleData(theEnv)->DefmoduleArray[i].importList; theList != NULL; theList = theList->next) { if (theList->moduleName != NULL) DecrementSymbolCount(theEnv,theList->moduleName); if (theList->constructType != NULL) DecrementSymbolCount(theEnv,theList->constructType); if (theList->constructName != NULL) DecrementSymbolCount(theEnv,theList->constructName); } for (theList = DefmoduleData(theEnv)->DefmoduleArray[i].exportList; theList != NULL; theList = theList->next) { if (theList->moduleName != NULL) DecrementSymbolCount(theEnv,theList->moduleName); if (theList->constructType != NULL) DecrementSymbolCount(theEnv,theList->constructType); if (theList->constructName != NULL) DecrementSymbolCount(theEnv,theList->constructName); } rm(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].itemsArray,sizeof(void *) * GetNumberOfModuleItems(theEnv)); } /*================================*/ /* Deallocate the space used for */ /* the defmodule data structures. */ /*================================*/ space = DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule); if (space != 0) genlongfree(theEnv,(void *) DefmoduleData(theEnv)->DefmoduleArray,space); DefmoduleData(theEnv)->BNumberOfDefmodules = 0; /*================================*/ /* Deallocate the space used for */ /* the port item data structures. */ /*================================*/ space = DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem); if (space != 0) genlongfree(theEnv,(void *) DefmoduleData(theEnv)->PortItemArray,space); DefmoduleData(theEnv)->NumberOfPortItems = 0; /*===========================*/ /* Reset module information. */ /*===========================*/ SetListOfDefmodules(theEnv,NULL); CreateMainModule(theEnv); DefmoduleData(theEnv)->MainModuleRedefinable = TRUE; } #endif /* (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips-6.24/clipssrc/pprint.h0000755000175000017500000000526307422635023014230 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* PRETTY PRINT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for processing the pretty print */ /* representation of constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_pprint #define _H_pprint #define PRETTY_PRINT_DATA 52 struct prettyPrintData { int PPBufferStatus; int PPBufferEnabled; int IndentationDepth; int PPBufferPos; unsigned PPBufferMax; int PPBackupOnce; int PPBackupTwice; char *PrettyPrintBuffer; }; #define PrettyPrintData(theEnv) ((struct prettyPrintData *) GetEnvironmentData(theEnv,PRETTY_PRINT_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _PPRINT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializePrettyPrintData(void *); LOCALE void FlushPPBuffer(void *); LOCALE void DestroyPPBuffer(void *); LOCALE void SavePPBuffer(void *,char *); LOCALE void PPBackup(void *); LOCALE char *CopyPPBuffer(void *); LOCALE char *GetPPBuffer(void *); LOCALE void PPCRAndIndent(void *); LOCALE void IncrementIndentDepth(void *,int); LOCALE void DecrementIndentDepth(void *,int); LOCALE void SetIndentDepth(void *,int); LOCALE void SetPPBufferStatus(void *,int); LOCALE int GetPPBufferStatus(void *); LOCALE int SetPPBufferEnabled(void *,int); LOCALE int GetPPBufferEnabled(void *); #endif clips-6.24/clipssrc/factmngr.h0000755000175000017500000001716010441143407014507 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FACTS MANAGER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_factmngr #define _H_factmngr struct fact; #ifndef _H_facthsh #include "facthsh.h" #endif #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #include "multifld.h" #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif struct fact { struct patternEntity factHeader; struct deftemplate *whichDeftemplate; void *list; long int factIndex; unsigned int depth : 15; unsigned int garbage : 1; struct fact *previousFact; struct fact *nextFact; struct fact *previousTemplateFact; struct fact *nextTemplateFact; struct multifield theProposition; }; #define FACTS_DATA 3 struct factsData { int ChangeToFactList; #if DEBUGGING_FUNCTIONS unsigned WatchFacts; #endif struct fact DummyFact; struct fact *GarbageFacts; struct fact *LastFact; struct fact *FactList; long int NextFactIndex; unsigned long NumberOfFacts; struct patternEntityRecord FactInfo; #if (! RUN_TIME) && (! BLOAD_ONLY) struct deftemplate *CurrentDeftemplate; #endif #if DEFRULE_CONSTRUCT && (! RUN_TIME) && DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER struct CodeGeneratorItem *FactCodeItem; #endif struct factHashEntry **FactHashTable; intBool FactDuplication; #if DEFRULE_CONSTRUCT struct fact *CurrentPatternFact; struct multifieldMarker *CurrentPatternMarks; #endif long LastModuleIndex; }; #define FactData(theEnv) ((struct factsData *) GetEnvironmentData(theEnv,FACTS_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTMNGR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define Assert(theEnv,a) EnvAssert(theEnv,a) #define AssertString(theEnv,a) EnvAssertString(theEnv,a) #define AssignFactSlotDefaults(theEnv,a) EnvAssignFactSlotDefaults(theEnv,a) #define CreateFact(theEnv,a) EnvCreateFact(theEnv,a) #define DecrementFactCount(theEnv,a) EnvDecrementFactCount(theEnv,a) #define FactIndex(theEnv,a) EnvFactIndex(theEnv,a) #define GetFactListChanged(theEnv) EnvGetFactListChanged(theEnv) #define GetFactPPForm(theEnv,a,b,c) EnvGetFactPPForm(theEnv,a,b,c) #define GetFactSlot(theEnv,a,b,c) EnvGetFactSlot(theEnv,a,b,c) #define GetNextFact(theEnv,a) EnvGetNextFact(theEnv,a) #define IncrementFactCount(theEnv,a) EnvIncrementFactCount(theEnv,a) #define PutFactSlot(theEnv,a,b,c) EnvPutFactSlot(theEnv,a,b,c) #define Retract(theEnv,a) EnvRetract(theEnv,a) #define SetFactListChanged(theEnv,a) EnvSetFactListChanged(theEnv,a) #else #define Assert(a) EnvAssert(GetCurrentEnvironment(),a) #define AssertString(a) EnvAssertString(GetCurrentEnvironment(),a) #define AssignFactSlotDefaults(a) EnvAssignFactSlotDefaults(GetCurrentEnvironment(),a) #define CreateFact(a) EnvCreateFact(GetCurrentEnvironment(),a) #define DecrementFactCount(a) EnvDecrementFactCount(GetCurrentEnvironment(),a) #define FactIndex(a) EnvFactIndex(GetCurrentEnvironment(),a) #define GetFactListChanged() EnvGetFactListChanged(GetCurrentEnvironment()) #define GetFactPPForm(a,b,c) EnvGetFactPPForm(GetCurrentEnvironment(),a,b,c) #define GetFactSlot(a,b,c) EnvGetFactSlot(GetCurrentEnvironment(),a,b,c) #define GetNextFact(a) EnvGetNextFact(GetCurrentEnvironment(),a) #define IncrementFactCount(a) EnvIncrementFactCount(GetCurrentEnvironment(),a) #define PutFactSlot(a,b,c) EnvPutFactSlot(GetCurrentEnvironment(),a,b,c) #define Retract(a) EnvRetract(GetCurrentEnvironment(),a) #define SetFactListChanged(a) EnvSetFactListChanged(GetCurrentEnvironment(),a) #endif LOCALE void *EnvAssert(void *,void *); LOCALE void *EnvAssertString(void *,char *); LOCALE struct fact *EnvCreateFact(void *,void *); LOCALE void EnvDecrementFactCount(void *,void *); LOCALE long int EnvFactIndex(void *,void *); LOCALE intBool EnvGetFactSlot(void *,void *,char *,DATA_OBJECT *); LOCALE void PrintFactWithIdentifier(void *,char *,struct fact *); LOCALE void PrintFact(void *,char *,struct fact *,int,int); LOCALE void PrintFactIdentifierInLongForm(void *,char *,void *); LOCALE intBool EnvRetract(void *,void *); LOCALE void RemoveAllFacts(void *); LOCALE struct fact *CreateFactBySize(void *,unsigned); LOCALE void FactInstall(void *,struct fact *); LOCALE void FactDeinstall(void *,struct fact *); LOCALE void *EnvGetNextFact(void *,void *); LOCALE void *GetNextFactInScope(void *theEnv,void *); LOCALE void EnvGetFactPPForm(void *,char *,unsigned,void *); LOCALE int EnvGetFactListChanged(void *); LOCALE void EnvSetFactListChanged(void *,int); LOCALE unsigned long GetNumberOfFacts(void *); LOCALE void InitializeFacts(void *); LOCALE struct fact *FindIndexedFact(void *,long); LOCALE void EnvIncrementFactCount(void *,void *); LOCALE void PrintFactIdentifier(void *,char *,void *); LOCALE void DecrementFactBasisCount(void *,void *); LOCALE void IncrementFactBasisCount(void *,void *); LOCALE void ReturnFact(void *,struct fact *); LOCALE void MatchFactFunction(void *,void *); LOCALE intBool EnvPutFactSlot(void *,void *,char *,DATA_OBJECT *); LOCALE intBool EnvAssignFactSlotDefaults(void *,void *); LOCALE intBool CopyFactSlotValues(void *,void *,void *); LOCALE intBool DeftemplateSlotDefault(void *,struct deftemplate *, struct templateSlot *,DATA_OBJECT *,int); #ifndef _FACTMNGR_SOURCE_ extern int ChangeToFactList; extern struct fact DummyFact; #if DEBUGGING_FUNCTIONS extern unsigned WatchFacts; #endif #endif #endif clips-6.24/clipssrc/tmpltutl.h0000755000175000017500000000604110441602351014565 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFTEMPLATE UTILITIES HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added additional arguments to */ /* InvalidDeftemplateSlotMessage function. */ /* */ /* Added additional arguments to */ /* PrintTemplateFact function. */ /* */ /*************************************************************/ #ifndef _H_tmpltutl #define _H_tmpltutl #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTUTL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InvalidDeftemplateSlotMessage(void *,char *,char *,int); LOCALE void SingleFieldSlotCardinalityError(void *,char *); LOCALE void MultiIntoSingleFieldSlotError(void *,struct templateSlot *,struct deftemplate *); LOCALE void CheckTemplateFact(void *,struct fact *); LOCALE intBool CheckRHSSlotTypes(void *,struct expr *,struct templateSlot *,char *); LOCALE struct templateSlot *GetNthSlot(struct deftemplate *,int); LOCALE int FindSlotPosition(struct deftemplate *,struct symbolHashNode *); LOCALE void PrintTemplateFact(void *,char *,struct fact *,int,int); LOCALE void UpdateDeftemplateScope(void *); LOCALE struct templateSlot *FindSlot(struct deftemplate *,struct symbolHashNode *,short *); LOCALE struct deftemplate *CreateImpliedDeftemplate(void *,SYMBOL_HN *,int); #endif clips-6.24/clipssrc/cstrnutl.h0000755000175000017500000000442607422634656014605 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* CONSTRAINT UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Utility routines for manipulating, initializing, */ /* creating, copying, and comparing constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrnutl #define _H_cstrnutl #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNUTL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif LOCALE struct constraintRecord *GetConstraintRecord(void *); LOCALE int CompareNumbers(void *,int,void *,int,void *); LOCALE struct constraintRecord *CopyConstraintRecord(void *,CONSTRAINT_RECORD *); LOCALE int SetConstraintType(int,CONSTRAINT_RECORD *); LOCALE void SetAnyAllowedFlags(CONSTRAINT_RECORD *,int); LOCALE void SetAnyRestrictionFlags(CONSTRAINT_RECORD *,int); LOCALE CONSTRAINT_RECORD *ArgumentTypeToConstraintRecord(void *,int); LOCALE CONSTRAINT_RECORD *FunctionCallToConstraintRecord(void *,void *); LOCALE CONSTRAINT_RECORD *ExpressionToConstraintRecord(void *,struct expr *); #endif clips-6.24/clipssrc/symblbin.h0000755000175000017500000000503707422635005014532 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* SYMBOL BINARY SAVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for */ /* atomic data values. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_symblbin #define _H_symblbin #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _SYMBLBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define BitMapPointer(i) ((BITMAP_HN *) (SymbolData(theEnv)->BitMapArray[i])) #define SymbolPointer(i) ((SYMBOL_HN *) (SymbolData(theEnv)->SymbolArray[i])) #define FloatPointer(i) ((FLOAT_HN *) (SymbolData(theEnv)->FloatArray[i])) #define IntegerPointer(i) ((INTEGER_HN *) (SymbolData(theEnv)->IntegerArray[i])) LOCALE void MarkNeededAtomicValues(void); LOCALE void WriteNeededAtomicValues(void *,FILE *); LOCALE void ReadNeededAtomicValues(void *); LOCALE void InitAtomicValueNeededFlags(void *); LOCALE void FreeAtomicValueStorage(void *); LOCALE void WriteNeededSymbols(void *,FILE *); LOCALE void WriteNeededFloats(void *,FILE *); LOCALE void WriteNeededIntegers(void *,FILE *); LOCALE void ReadNeededSymbols(void *); LOCALE void ReadNeededFloats(void *); LOCALE void ReadNeededIntegers(void *); #endif clips-6.24/clipssrc/objrtmch.c0000755000175000017500000015146410441150421014511 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* OBJECT PATTERN MATCHER MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: RETE Network Interface for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #include "classfun.h" #include "memalloc.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "lgcldpnd.h" #include "multifld.h" #if (! RUN_TIME) && (! BLOAD_ONLY) #include "incrrset.h" #endif #include "reteutil.h" #include "ruledlt.h" #include "reorder.h" #include "retract.h" #include "router.h" #include "objrtfnx.h" #define _OBJRTMCH_SOURCE_ #include "objrtmch.h" #include "insmngr.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void QueueObjectMatchAction(void *,int,INSTANCE_TYPE *,int); static SLOT_BITMAP *QueueModifySlotMap(void *,SLOT_BITMAP *,int); static void ReturnObjectMatchAction(void *,OBJECT_MATCH_ACTION *); static void ProcessObjectMatchQueue(void *); static void MarkObjectPatternNetwork(void *,SLOT_BITMAP *); static intBool CompareSlotBitMaps(SLOT_BITMAP *,SLOT_BITMAP *); static void ObjectPatternMatch(void *,int,OBJECT_PATTERN_NODE *,struct multifieldMarker *); static void ProcessPatternNode(void *,int,OBJECT_PATTERN_NODE *,struct multifieldMarker *); static void CreateObjectAlphaMatch(void *,OBJECT_ALPHA_NODE *); static intBool EvaluateObjectPatternTest(void *,int,struct multifieldMarker *,EXPRESSION *, OBJECT_PATTERN_NODE *); static void ObjectAssertAction(void *,INSTANCE_TYPE *); static void ObjectModifyAction(void *,INSTANCE_TYPE *,SLOT_BITMAP *); static void ObjectRetractAction(void *,INSTANCE_TYPE *,SLOT_BITMAP *); static void ObjectPatternNetErrorMessage(void *,OBJECT_PATTERN_NODE *); static void TraceErrorToObjectPattern(void *,int,OBJECT_PATTERN_NODE *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************************** NAME : ObjectMatchDelay DESCRIPTION : H/L interface for SetDelayObjectPatternMatching INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : DelayObjectPatternMatching set and Rete network updates delayed until pattern-matching is completed NOTES : H/L Syntax: (object-pattern-match-delay *) ***************************************************************************/ globle void ObjectMatchDelay( void *theEnv, DATA_OBJECT *result) { register int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); EvaluateExpression(theEnv,GetFirstArgument(),result); if (EvaluationData(theEnv)->EvaluationError) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); SetDelayObjectPatternMatching(theEnv,ov); SetEvaluationError(theEnv,TRUE); } else SetDelayObjectPatternMatching(theEnv,ov); } /*************************************************** NAME : SetDelayObjectPatternMatching DESCRIPTION : Sets the flag determining if Rete network activity is to be delayed for objects or not INPUTS : The value of the flag RETURNS : The old value of the flag SIDE EFFECTS : DelayObjectPatternMatching set NOTES : When the delay is set to FALSE, all pending Rete network updates are performed ***************************************************/ globle intBool SetDelayObjectPatternMatching( void *theEnv, int value) { intBool oldval; oldval = ObjectReteData(theEnv)->DelayObjectPatternMatching; if (value) ObjectReteData(theEnv)->DelayObjectPatternMatching = TRUE; else { ObjectReteData(theEnv)->DelayObjectPatternMatching = FALSE; ObjectNetworkAction(theEnv,0,NULL,-1); } return(oldval); } /*************************************************** NAME : GetDelayObjectPatternMatching DESCRIPTION : Gets the flag determining if Rete network activity is to be delayed for objects or not INPUTS : None RETURNS : The flag SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool GetDelayObjectPatternMatching( void *theEnv) { return(ObjectReteData(theEnv)->DelayObjectPatternMatching); } /******************************************************** NAME : ObjectNetworkPointer DESCRIPTION : Returns the first object network pattern node INPUTS : None RETURNS : The top of the object pattern network SIDE EFFECTS : None NOTES : None ********************************************************/ globle OBJECT_PATTERN_NODE *ObjectNetworkPointer( void *theEnv) { return(ObjectReteData(theEnv)->ObjectPatternNetworkPointer); } /******************************************************** NAME : ObjectNetworkTerminalPointer DESCRIPTION : Returns the first terminal pattern node INPUTS : None RETURNS : The last node of a pattern SIDE EFFECTS : None NOTES : None ********************************************************/ globle OBJECT_ALPHA_NODE *ObjectNetworkTerminalPointer( void *theEnv) { return(ObjectReteData(theEnv)->ObjectPatternNetworkTerminalPointer); } /*************************************************** NAME : SetObjectNetworkPointer DESCRIPTION : Sets the object pattern network to the given network INPUTS : Top of the new pattern network RETURNS : Nothing useful SIDE EFFECTS : ObjectPatternNetworkPointer set NOTES : None ***************************************************/ globle void SetObjectNetworkPointer( void *theEnv, OBJECT_PATTERN_NODE *value) { ObjectReteData(theEnv)->ObjectPatternNetworkPointer = value; } /******************************************************* NAME : SetObjectNetworkTerminalPointer DESCRIPTION : Sets the global list of terminal pattern nodes (the ones containing the bitmaps) to the given node INPUTS : The last node of a pattern RETURNS : Nothing useful SIDE EFFECTS : ObjectPatternNetworkTerminalPointer set NOTES : None *******************************************************/ globle void SetObjectNetworkTerminalPointer( void *theEnv, OBJECT_ALPHA_NODE *value) { ObjectReteData(theEnv)->ObjectPatternNetworkTerminalPointer = value; } /************************************************************************ NAME : ObjectNetworkAction DESCRIPTION : Main driver for pattern-matching on objects If the pattern-matching is current delayed or another object is currently being pattern-matched, the requested match action is queued for later processing. Otherwise, the match action is performed and the Rete network is updated. INPUTS : 1) The match action type OBJECT_ASSERT (1) OBJECT_RETRACT (2) OBJECT_MODIFY (3) 2) The instance to be matched (can be NULL if only want pending actions to be performed) 3) The name id of the slot being updated (can be -1) If this argument is -1, it is assumed that any pattern which could match this instance must be checked. Otherwise, only the patterns which explicitly match on the named slot will be checked. RETURNS : Nothing useful SIDE EFFECTS : Action queued or Rete network updated NOTES : None ************************************************************************/ globle void ObjectNetworkAction( void *theEnv, int type, INSTANCE_TYPE *ins, int slotNameID) { SLOT_BITMAP *tmpMap; if (EngineData(theEnv)->JoinOperationInProgress) return; EngineData(theEnv)->JoinOperationInProgress = TRUE; /* ================================================ For purposes of conflict resolution, all objects which have had pattern-matching delayed will have the same relative timestamp, i.e., the inference engine thinks they all just appeared simultaneously When delay is off, however, each object gets the new and current timestamp as expected. ================================================ */ ObjectReteData(theEnv)->UseEntityTimeTag = DefruleData(theEnv)->CurrentEntityTimeTag++; /* ================================================== If pattern-matching is delayed (by use of the set-object-pattern-match-delay function), then the instance should be marked for later processing (when the delay is turned off). ================================================== */ if (ins != NULL) { /* 6.05 Bug Fix */ ins->reteSynchronized = FALSE; if (ObjectReteData(theEnv)->DelayObjectPatternMatching == FALSE) switch (type) { case OBJECT_ASSERT : ObjectAssertAction(theEnv,ins); break; case OBJECT_RETRACT : ObjectRetractAction(theEnv,ins,NULL); break; default : tmpMap = QueueModifySlotMap(theEnv,NULL,slotNameID); ObjectModifyAction(theEnv,ins,tmpMap); rm(theEnv,(void *) tmpMap,SlotBitMapSize(tmpMap)); } else QueueObjectMatchAction(theEnv,type,ins,slotNameID); } /* ======================================== Process all pending actions in the queue All updates will use the same timestamp ======================================== */ ProcessObjectMatchQueue(theEnv); EngineData(theEnv)->JoinOperationInProgress = FALSE; ForceLogicalRetractions(theEnv); /*=========================================*/ /* Free partial matches that were released */ /* by the assertion of the fact. */ /*=========================================*/ if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ResetObjectMatchTimeTags DESCRIPTION : If CurrentObjectMatchTimeTag + 1 would cause an overflow, CurrentObjectMatchTimeTag is reset to 0L and all time tags in object pattern nodes are reset. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : CurrentObjectMatchTimeTag reset to 0, and all match time tags reset These tags are used to recognize valid pattern nodes on a match NOTES : None ***************************************************/ globle void ResetObjectMatchTimeTags( void *theEnv) { OBJECT_ALPHA_NODE *alphaPtr; OBJECT_PATTERN_NODE *lastLevel; /* ============================================ If the current tag incremented by one would not cause an overflow, then we can leave things alone. ============================================ */ if ((ObjectReteData(theEnv)->CurrentObjectMatchTimeTag + 1L) > ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) return; ObjectReteData(theEnv)->CurrentObjectMatchTimeTag = 0L; alphaPtr = ObjectNetworkTerminalPointer(theEnv); while (alphaPtr != NULL) { alphaPtr->matchTimeTag = 0L; lastLevel = alphaPtr->patternNode; while (lastLevel != NULL) { if (lastLevel->matchTimeTag == 0L) break; lastLevel->matchTimeTag = 0L; lastLevel = lastLevel->lastLevel; } alphaPtr = alphaPtr->nxtTerminal; } } /*************************************************** NAME : QueueObjectMatchAction DESCRIPTION : Posts a Rete network match event for later processing INPUTS : 1) The match action type OBJECT_ASSERT (1) OBJECT_RETRACT (2) OBJECT_MODIFY (3) 2) The instance to be matched 3) The name id of the slot being updated (can be -1) RETURNS : Nothing useful SIDE EFFECTS : Queue updated NOTES : None ***************************************************/ static void QueueObjectMatchAction( void *theEnv, int type, INSTANCE_TYPE *ins, int slotNameID) { OBJECT_MATCH_ACTION *prv,*cur,*newMatch; prv = NULL; cur = ObjectReteData(theEnv)->ObjectMatchActionQueue; while (cur != NULL) { /* =========================================================== Here are the possibilities for the first Rete event already on the queue as compared with the new event for an object: Assert/Retract --> Delete assert event Ignore retract event Assert/Modify --> Ignore modify event Modify/Modify --> Merge new modify event Modify/Retract --> Delete modify event Queue the retract event =========================================================== */ if (cur->ins == ins) { /* =================================================== An action for initially asserting the newly created object to all applicable patterns =================================================== */ if (cur->type == OBJECT_ASSERT) { if (type == OBJECT_RETRACT) { /* =================================================== If we are retracting the entire object, then we can remove the assert action (and all modifies as well) and ignore the retract action (basically the object came and went before the Rete network had a chance to see it) =================================================== */ if (prv == NULL) ObjectReteData(theEnv)->ObjectMatchActionQueue = cur->nxt; else prv->nxt = cur->nxt; cur->ins->busy--; ReturnObjectMatchAction(theEnv,cur); } /* ================================================= If this is a modify action, then we can ignore it since the assert action will encompass it ================================================= */ } /* =================================================== If the object is being deleted after a slot modify, drop the modify event and replace with the retract =================================================== */ else if (type == OBJECT_RETRACT) { cur->type = OBJECT_RETRACT; if (cur->slotNameIDs != NULL) { rm(theEnv,(void *) cur->slotNameIDs,SlotBitMapSize(cur->slotNameIDs)); cur->slotNameIDs = NULL; } } /* ==================================================== If a modify event for this slot is already on the queue, ignore this one. Otherwise, merge the slot id ==================================================== */ else cur->slotNameIDs = QueueModifySlotMap(theEnv,cur->slotNameIDs,slotNameID); return; } prv = cur; cur = cur->nxt; } /* ================================================ If there are no actions for the instance already on the queue, the new action is simply appended. ================================================ */ newMatch = get_struct(theEnv,objectMatchAction); newMatch->type = type; newMatch->nxt = cur; newMatch->slotNameIDs = (type != OBJECT_MODIFY) ? NULL : QueueModifySlotMap(theEnv,NULL,slotNameID); newMatch->ins = ins; newMatch->ins->busy++; if (prv == NULL) ObjectReteData(theEnv)->ObjectMatchActionQueue = newMatch; else prv->nxt = newMatch; } /**************************************************** NAME : QueueModifySlotMap DESCRIPTION : Sets the bitmap for a queued object modify Rete network action INPUTS : 1) The old bitmap (can be NULL) 2) The canonical slot id to set RETURNS : The (new) bitmap SIDE EFFECTS : Bitmap allocated/reallocated if necessary, and slot id bit set NOTES : If the bitmap must be (re)allocated, this routine allocates twice the room necessary for the current id to allow for growth. ****************************************************/ static SLOT_BITMAP *QueueModifySlotMap( void *theEnv, SLOT_BITMAP *oldMap, int slotNameID) { SLOT_BITMAP *newMap; unsigned short newmaxid; unsigned oldsz,newsz; if ((oldMap == NULL) ? TRUE : (slotNameID > oldMap->maxid)) { newmaxid = (unsigned short) (slotNameID * 2); newsz = sizeof(SLOT_BITMAP) + (sizeof(char) * (newmaxid / BITS_PER_BYTE)); newMap = (SLOT_BITMAP *) gm2(theEnv,newsz); ClearBitString((void *) newMap,newsz); if (oldMap != NULL) { oldsz = SlotBitMapSize(oldMap); GenCopyMemory(char,oldsz,newMap,oldMap); rm(theEnv,(void *) oldMap,oldsz); } newMap->maxid = newmaxid; } else newMap = oldMap; SetBitMap(newMap->map,slotNameID); return(newMap); } /*************************************************** NAME : ReturnObjectMatchAction DESCRIPTION : Deallocates and object match action structure and associated slot bitmap (if any) INPUTS : The queued match action item RETURNS : Nothing useful SIDE EFFECTS : Object match action item deleted NOTES : None ***************************************************/ static void ReturnObjectMatchAction( void *theEnv, OBJECT_MATCH_ACTION *omaPtr) { if (omaPtr->slotNameIDs != NULL) rm(theEnv,(void *) omaPtr->slotNameIDs,SlotBitMapSize(omaPtr->slotNameIDs)); rtn_struct(theEnv,objectMatchAction,omaPtr); } /*************************************************** NAME : ProcessObjectMatchQueue DESCRIPTION : Processes all outstanding object Rete network update events INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pattern-matching on objects NOTES : None ***************************************************/ static void ProcessObjectMatchQueue( void *theEnv) { OBJECT_MATCH_ACTION *cur; while ((ObjectReteData(theEnv)->ObjectMatchActionQueue != NULL) && (ObjectReteData(theEnv)->DelayObjectPatternMatching == FALSE)) { cur = ObjectReteData(theEnv)->ObjectMatchActionQueue; ObjectReteData(theEnv)->ObjectMatchActionQueue = cur->nxt; switch(cur->type) { case OBJECT_ASSERT : ObjectAssertAction(theEnv,cur->ins); break; case OBJECT_RETRACT : ObjectRetractAction(theEnv,cur->ins,cur->slotNameIDs); break; default : ObjectModifyAction(theEnv,cur->ins,cur->slotNameIDs); } cur->ins->busy--; ReturnObjectMatchAction(theEnv,cur); } } /****************************************************** NAME : MarkObjectPatternNetwork DESCRIPTION : Iterates through all terminal pattern nodes checking class and slot bitmaps. If a pattern is applicable to the object/slot change, then all the nodes belonging to the pattern are marked as needing to be examined by the pattern matcher. INPUTS : The bitmap of ids of the slots being changed (NULL if this is an assert for the for the entire object) RETURNS : Nothing useful SIDE EFFECTS : Applicable pattern nodes marked NOTES : Incremental reset status is also checked here ******************************************************/ static void MarkObjectPatternNetwork( void *theEnv, SLOT_BITMAP *slotNameIDs) { OBJECT_ALPHA_NODE *alphaPtr; OBJECT_PATTERN_NODE *upper; CLASS_BITMAP *clsset; unsigned id; ResetObjectMatchTimeTags(theEnv); ObjectReteData(theEnv)->CurrentObjectMatchTimeTag++; alphaPtr = ObjectNetworkTerminalPointer(theEnv); id = ObjectReteData(theEnv)->CurrentPatternObject->cls->id; while (alphaPtr != NULL) { /* ============================================================= If an incremental reset is in progress, make sure that the pattern has been marked for initialization before proceeding. ============================================================= */ #if (! RUN_TIME) && (! BLOAD_ONLY) if (EngineData(theEnv)->IncrementalResetInProgress && (alphaPtr->header.initialize == FALSE)) { alphaPtr = alphaPtr->nxtTerminal; continue; } #endif /* ============================================ Check the class bitmap to see if the pattern pattern is applicable to the object at all ============================================ */ clsset = (CLASS_BITMAP *) ValueToBitMap(alphaPtr->classbmp); if ((id > (unsigned) clsset->maxid) ? FALSE : TestBitMap(clsset->map,id)) { /* =================================================== If we are doing an assert, then we need to check all patterns which satsify the class bitmap (The retraction has already been done in this case) =================================================== */ if (slotNameIDs == NULL) { alphaPtr->matchTimeTag = ObjectReteData(theEnv)->CurrentObjectMatchTimeTag; for (upper = alphaPtr->patternNode ; upper != NULL ; upper = upper->lastLevel) { if (upper->matchTimeTag == ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) break; else upper->matchTimeTag = ObjectReteData(theEnv)->CurrentObjectMatchTimeTag; } } /* =================================================== If we are doing a slot modify, then we need to check only the subset of patterns which satisfy the class bitmap AND actually match on the slot in question. =================================================== */ else if (alphaPtr->slotbmp != NULL) { if (CompareSlotBitMaps(slotNameIDs, (SLOT_BITMAP *) ValueToBitMap(alphaPtr->slotbmp))) { alphaPtr->matchTimeTag = ObjectReteData(theEnv)->CurrentObjectMatchTimeTag; for (upper = alphaPtr->patternNode ; upper != NULL ; upper = upper->lastLevel) { if (upper->matchTimeTag == ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) break; else upper->matchTimeTag = ObjectReteData(theEnv)->CurrentObjectMatchTimeTag; } } } } alphaPtr = alphaPtr->nxtTerminal; } } /*************************************************** NAME : CompareSlotBitMaps DESCRIPTION : Compares two slot bitmaps by bitwising and'ing byte per byte up to the length of the smaller map. INPUTS : The two slot bitmaps RETURNS : TRUE if any common bits are set in both maps, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ static intBool CompareSlotBitMaps( SLOT_BITMAP *smap1, SLOT_BITMAP *smap2) { unsigned short i,maxByte; maxByte = (unsigned short) (((smap1->maxid < smap2->maxid) ? smap1->maxid : smap2->maxid) / BITS_PER_BYTE); for (i = 0 ; i <= maxByte ; i++) if (smap1->map[i] & smap2->map[i]) return(TRUE); return(FALSE); } /********************************************************************************** NAME : ObjectPatternMatch DESCRIPTION : Iterates through all the pattern nodes on one level in the pattern network. A node is only processed if it can lead to a terminating class bitmap node which applies to the object being matched. This allows for a significant reduction in the number of patterns considered. INPUTS : 1) The offset of the slot position from the pattern index 2) The pattern node being examined 3) The end of the list of multifield markers for the pattern RETURNS : Nothing useful SIDE EFFECTS : The pattern tests are evaluated and the child nodes may be processed (which may cause a whole series of Rete network updates). NOTES : Several globals are used to keep track of the current slot being examined: CurrentPatternMarks - the series of multifield markers CurrentPatternObject - the object being pattern-matched CurrentPatternObjectSlot - the current slot being examined CurrentObjectSlotLength - the cardinality of the slot value An optimization is performed when evaluating constant tests on a slot value field. All pattern nodes on a level which restrict the same slot are grouped together. Those which are constant tests are placed at the far right. Thus, as soon as one of these constant tests succeeds, the remaining nodes for that slot on this level can be skipped **********************************************************************************/ static void ObjectPatternMatch( void *theEnv, int offset, OBJECT_PATTERN_NODE *patternTop, struct multifieldMarker *endMark) { register unsigned saveSlotLength; register INSTANCE_SLOT *saveSlot; OBJECT_PATTERN_NODE *blockedNode; while (patternTop != NULL) { /* =========================================================== MarkObjectPatternNetwork() has already marked pattern nodes which need processing according to the class bitmaps, slot updates and incremental reset status =========================================================== */ if (patternTop->matchTimeTag == ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) { /* ======================================== Make sure we are examining the correct slot of the object for this pattern node ======================================== */ if ((patternTop->slotNameID == ISA_ID) || (patternTop->slotNameID == NAME_ID)) { ObjectReteData(theEnv)->CurrentPatternObjectSlot = NULL; ObjectReteData(theEnv)->CurrentObjectSlotLength = 1; offset = 0; } else if ((ObjectReteData(theEnv)->CurrentPatternObjectSlot == NULL) ? TRUE : (ObjectReteData(theEnv)->CurrentPatternObjectSlot->desc->slotName->id != patternTop->slotNameID)) { /* ==================================================== Need to reset the indices for the multifield markers now that we have moved onto a different slot ==================================================== */ ObjectReteData(theEnv)->CurrentPatternObjectSlot = ObjectReteData(theEnv)->CurrentPatternObject->slotAddresses[ObjectReteData(theEnv)->CurrentPatternObject->cls->slotNameMap [patternTop->slotNameID] - 1]; offset = 0; if (ObjectReteData(theEnv)->CurrentPatternObjectSlot->desc->multiple) ObjectReteData(theEnv)->CurrentObjectSlotLength = GetInstanceSlotLength(ObjectReteData(theEnv)->CurrentPatternObjectSlot); else ObjectReteData(theEnv)->CurrentObjectSlotLength = 1; } /* ======================================================== Process the pattern node. If it is satisfied by the the instance, ProcessPatternNode() will recursively pass all of its children nodes through ObjectPatternMatch() ======================================================== */ saveSlotLength = ObjectReteData(theEnv)->CurrentObjectSlotLength; saveSlot = ObjectReteData(theEnv)->CurrentPatternObjectSlot; ProcessPatternNode(theEnv,offset,patternTop,endMark); ObjectReteData(theEnv)->CurrentObjectSlotLength = saveSlotLength; ObjectReteData(theEnv)->CurrentPatternObjectSlot = saveSlot; } /* ============================================================== Move on to the siblings of this node - if the current node was a constant test that succeeded, skip further sibling nodes (which test on the same field in the pattern) which match on the same slot since they are all constant tests as well and will, of course fail. ============================================================== */ if (patternTop->blocked == TRUE) { patternTop->blocked = FALSE; blockedNode = patternTop; patternTop = patternTop->rightNode; while (patternTop != NULL) { if ((patternTop->slotNameID != blockedNode->slotNameID) || (patternTop->whichField != blockedNode->whichField)) break; patternTop = patternTop->rightNode; } } else patternTop = patternTop->rightNode; } } /********************************************************************************** NAME : ProcessPatternNode DESCRIPTION : Determines if a pattern node satsifies the corresponding slot value field(s) in an object. If it does, ObjectPatternMatch() is recursively called to process the child nodes of this node. In this mutual recursion between ObjectPatternMatch() and ProcessPatternNode(), the nodes of all applicable patterns are processed to completion. ObjectPatternMatch() enters an object into a pattern's aplha memory when the traversal reaches a terminal class bitmap node. INPUTS : 1) The offset of the slot index from the pattern index 2) The pattern node being examined 3) The end of the list of multifield markers for the pattern RETURNS : Nothing useful SIDE EFFECTS : The pattern tests are evaluated and the child nodes may be processed (which may cause a whole series of Rete network updates). NOTES : Several globals are used to keep track of the current slot being examined: CurrentPatternMarks - the series of multifield markers CurrentPatternObject - the object being pattern-matched CurrentPatternObjectSlot - the current slot being examined CurrentObjectSlotLength - the cardinality of the slot value **********************************************************************************/ static void ProcessPatternNode( void *theEnv, int offset, OBJECT_PATTERN_NODE *patternNode, struct multifieldMarker *endMark) { int patternSlotField,objectSlotField; unsigned objectSlotLength; int repeatCount; INSTANCE_SLOT *objectSlot; struct multifieldMarker *newMark; patternSlotField = patternNode->whichField; objectSlotField = patternSlotField + offset; /* ========================================== If this is a test on the class or the name of the object, process it separately. ========================================== */ if (ObjectReteData(theEnv)->CurrentPatternObjectSlot == NULL) { if ((patternNode->networkTest == NULL) ? TRUE : (EvaluateObjectPatternTest(theEnv,objectSlotField,NULL, (EXPRESSION *) patternNode->networkTest,patternNode))) { if (patternNode->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,patternNode->alphaNode); ObjectPatternMatch(theEnv,offset,patternNode->nextLevel,endMark); } return; } /* ================================ Check a single-field restriction ================================ */ if (patternNode->multifieldNode == 0) { if ((patternNode->networkTest == NULL) ? TRUE : EvaluateObjectPatternTest(theEnv,objectSlotField,NULL, (EXPRESSION *) patternNode->networkTest,patternNode)) { if (patternNode->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,patternNode->alphaNode); ObjectPatternMatch(theEnv,offset,patternNode->nextLevel,endMark); } return; } /* ================================================================== Check a multifield restriction. Add a marker for this field which has indices indicating to which values in the object slot the multifield pattern node is bound ================================================================== */ newMark = get_struct(theEnv,multifieldMarker); newMark->whichField = patternSlotField; newMark->where.whichSlot = (void *) ObjectReteData(theEnv)->CurrentPatternObjectSlot->desc->slotName->name; newMark->startPosition = objectSlotField; newMark->next = NULL; if (ObjectReteData(theEnv)->CurrentPatternObjectMarks == NULL) ObjectReteData(theEnv)->CurrentPatternObjectMarks = newMark; else endMark->next = newMark; /* ========================================================== If there are further pattern restrictions on this slot, try pattern-matching for all possible bound values of the multifield pattern node: from no values to all values from the starting position of the multifield to the end of the object slot. Otherwise, bind the multifield to all the remaining fields in the slot value and continue with pattern-matching ========================================================== */ if (patternNode->endSlot == FALSE) { objectSlotLength = ObjectReteData(theEnv)->CurrentObjectSlotLength; objectSlot = ObjectReteData(theEnv)->CurrentPatternObjectSlot; newMark->endPosition = newMark->startPosition - 1; repeatCount = (int) (objectSlotLength - newMark->startPosition - patternNode->leaveFields + 2); while (repeatCount > 0) { if ((patternNode->networkTest == NULL) ? TRUE : EvaluateObjectPatternTest(theEnv,objectSlotField,newMark, (EXPRESSION *) patternNode->networkTest,patternNode)) { if (patternNode->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,patternNode->alphaNode); ObjectPatternMatch(theEnv,(int) (offset + (newMark->endPosition - objectSlotField)), patternNode->nextLevel,newMark); ObjectReteData(theEnv)->CurrentObjectSlotLength = objectSlotLength; ObjectReteData(theEnv)->CurrentPatternObjectSlot = objectSlot; } newMark->endPosition++; repeatCount--; } } else { newMark->endPosition = (long) ObjectReteData(theEnv)->CurrentObjectSlotLength; if ((patternNode->networkTest == NULL) ? TRUE : EvaluateObjectPatternTest(theEnv,objectSlotField,newMark, (EXPRESSION *) patternNode->networkTest,patternNode)) { if (patternNode->alphaNode != NULL) CreateObjectAlphaMatch(theEnv,patternNode->alphaNode); ObjectPatternMatch(theEnv,0,patternNode->nextLevel,newMark); } } /* ====================================== Delete the temporary multifield marker ====================================== */ if (ObjectReteData(theEnv)->CurrentPatternObjectMarks == newMark) ObjectReteData(theEnv)->CurrentPatternObjectMarks = NULL; else endMark->next = NULL; rtn_struct(theEnv,multifieldMarker,newMark); } /*************************************************** NAME : CreateObjectAlphaMatch DESCRIPTION : Places an instance in the alpha memory of a pattern and drives the partial match through the join network INPUTS : The alpha memory node RETURNS : Nothing useful SIDE EFFECTS : Join network updated NOTES : None ***************************************************/ static void CreateObjectAlphaMatch( void *theEnv, OBJECT_ALPHA_NODE *alphaPtr) { struct joinNode *listOfJoins; struct partialMatch *theMatch; struct patternMatch *newMatch; while (alphaPtr != NULL) { if (alphaPtr->matchTimeTag == ObjectReteData(theEnv)->CurrentObjectMatchTimeTag) { /* =================================================== If we have reached the class bitmap of the pattern, place the object in the alpha memory of each of the terminal nodes underneath and drive the partial matches through the join network. Insert the instance into the alpha memory of this pattern and mark it as busy =================================================== */ ObjectReteData(theEnv)->CurrentPatternObject->busy++; theMatch = CreateAlphaMatch(theEnv,(void *) ObjectReteData(theEnv)->CurrentPatternObject, ObjectReteData(theEnv)->CurrentPatternObjectMarks, (struct patternNodeHeader *) alphaPtr); /* ====================================== Attach the partial match to the object to ease later retraction ====================================== */ newMatch = get_struct(theEnv,patternMatch); newMatch->next = (struct patternMatch *) ObjectReteData(theEnv)->CurrentPatternObject->partialMatchList; newMatch->matchingPattern = (struct patternNodeHeader *) alphaPtr; newMatch->theMatch = theMatch; ObjectReteData(theEnv)->CurrentPatternObject->partialMatchList = (void *) newMatch; /* ================================================ Drive the partial match through the join network ================================================ */ listOfJoins = alphaPtr->header.entryJoin; while (listOfJoins != NULL) { NetworkAssert(theEnv,theMatch,listOfJoins,RHS); listOfJoins = listOfJoins->rightMatchNode; } } alphaPtr = alphaPtr->nxtInGroup; } } /****************************************************** NAME : EvaluateObjectPatternTest DESCRIPTION : Evaluates the pattern network test expression for a node INPUTS : 1) The actual index of the slot value field currently being examined 2) The multifield marker (if any) for the pattern node being exmained 3) The pattern network test expression 4) The pattern node being examined RETURNS : TRUE if the node passes the test, FALSE otherwise SIDE EFFECTS : Evaluation of the test EvaluationError and HaltExecution are always set to FALSE NOTES : Assumes networkTest != NULL ******************************************************/ static intBool EvaluateObjectPatternTest( void *theEnv, int objectSlotField, struct multifieldMarker *selfSlotMarker, EXPRESSION *networkTest, OBJECT_PATTERN_NODE *patternNode) { DATA_OBJECT vresult; int rv; if (networkTest->type == OBJ_PN_CONSTANT) { struct expr *oldArgument; oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = networkTest; rv = ObjectCmpConstantFunction(theEnv,networkTest->value,&vresult); EvaluationData(theEnv)->CurrentExpression = oldArgument; if (rv) { if (((struct ObjectCmpPNConstant *) ValueToBitMap(networkTest->value))->pass) patternNode->blocked = TRUE; return(TRUE); } return(FALSE); } /* ========================================================= Evaluate or expressions expressed in the format: (or ... ) Returns TRUE (1.0) if any of the expression are TRUE, otherwise returns false (0.0). ========================================================= */ if (networkTest->value == ExpressionData(theEnv)->PTR_OR) { networkTest = networkTest->argList; while (networkTest != NULL) { if (EvaluateObjectPatternTest(theEnv,objectSlotField,selfSlotMarker,networkTest,patternNode)) { /* ============================================ A node can be blocked ONLY if there were one positive constant test on that node ============================================ */ patternNode->blocked = FALSE; return(TRUE); } patternNode->blocked = FALSE; networkTest = networkTest->nextArg; } return(FALSE); } /* ========================================================== Evaluate and expressions expressed in the format: (and ... ) Returns false (0.0) if any of the expression are false, otherwise returns TRUE (1.0). ========================================================== */ else if (networkTest->value == ExpressionData(theEnv)->PTR_AND) { networkTest = networkTest->argList; while (networkTest != NULL) { if (EvaluateObjectPatternTest(theEnv,objectSlotField,selfSlotMarker,networkTest,patternNode) == FALSE) { patternNode->blocked = FALSE; return(FALSE); } patternNode->blocked = FALSE; networkTest = networkTest->nextArg; } return(TRUE); } /* ======================================================= Evaluate all other expressions using EvaluateExpression ======================================================= */ else { EvaluationData(theEnv)->HaltExecution = FALSE; if (EvaluateExpression(theEnv,networkTest,&vresult)) { ObjectPatternNetErrorMessage(theEnv,patternNode); EvaluationData(theEnv)->EvaluationError = FALSE; EvaluationData(theEnv)->HaltExecution = FALSE; return(FALSE); } if ((vresult.value != EnvFalseSymbol(theEnv)) || (vresult.type != SYMBOL)) return(TRUE); } return(FALSE); } /*************************************************** NAME : ObjectAssertAction DESCRIPTION : Filters an instance through the object pattern network INPUTS : The instance RETURNS : Nothing useful SIDE EFFECTS : Instance matched NOTES : None ***************************************************/ static void ObjectAssertAction( void *theEnv, INSTANCE_TYPE *ins) { ins->header.timeTag = ObjectReteData(theEnv)->UseEntityTimeTag; ObjectReteData(theEnv)->CurrentPatternObject = ins; ObjectReteData(theEnv)->CurrentPatternObjectSlot = NULL; MarkObjectPatternNetwork(theEnv,NULL); ObjectPatternMatch(theEnv,0,ObjectNetworkPointer(theEnv),NULL); ins->reteSynchronized = TRUE; } /********************************************************************** NAME : ObjectModifyAction DESCRIPTION : Removes an instance from patterns (and attached joins) applicable to specified slot(s), and then filters same instance through object pattern network (only against patterns which explicitly match on named slot(s)) INPUTS : 1) The instance 2) The bitmap of slot ids RETURNS : Nothing useful SIDE EFFECTS : Instance retracted/asserted NOTES : None **********************************************************************/ static void ObjectModifyAction( void *theEnv, INSTANCE_TYPE *ins, SLOT_BITMAP *slotNameIDs) { ins->header.timeTag = ObjectReteData(theEnv)->UseEntityTimeTag; ObjectRetractAction(theEnv,ins,slotNameIDs); ObjectReteData(theEnv)->CurrentPatternObject = ins; ObjectReteData(theEnv)->CurrentPatternObjectSlot = NULL; MarkObjectPatternNetwork(theEnv,slotNameIDs); ObjectPatternMatch(theEnv,0,ObjectNetworkPointer(theEnv),NULL); ins->reteSynchronized = TRUE; } /**************************************************** NAME : ObjectRetractAction DESCRIPTION : Retracts the instance from the applicable patterns for the object (if the slotNameID != -1, then the instance is only retracted from the alpha memories of the patterns which actually match on that slot) INPUTS : 1) The instance 2) The slot bitmap for a modify (NULL if the instance is actually being removed) RETURNS : Nothing useful SIDE EFFECTS : Retractions performed NOTES : None ****************************************************/ static void ObjectRetractAction( void *theEnv, INSTANCE_TYPE *ins, SLOT_BITMAP *slotNameIDs) { struct patternMatch *prvMatch,*tmpMatch, *deleteMatch,*lastDeleteMatch; OBJECT_ALPHA_NODE *alphaPtr; void *saveDependents; if (slotNameIDs == NULL) { if (ins->partialMatchList != NULL) { tmpMatch = (struct patternMatch *) ins->partialMatchList; while (tmpMatch != NULL) { ins->busy--; tmpMatch = tmpMatch->next; } NetworkRetract(theEnv,(struct patternMatch *) ins->partialMatchList); ins->partialMatchList = NULL; } } else { deleteMatch = NULL; lastDeleteMatch = NULL; prvMatch = NULL; tmpMatch = (struct patternMatch *) ins->partialMatchList; while (tmpMatch != NULL) { alphaPtr = (OBJECT_ALPHA_NODE *) tmpMatch->matchingPattern; if (alphaPtr->slotbmp != NULL) { if (CompareSlotBitMaps(slotNameIDs, (SLOT_BITMAP *) ValueToBitMap(alphaPtr->slotbmp))) { ins->busy--; if (prvMatch == NULL) ins->partialMatchList = (void *) tmpMatch->next; else prvMatch->next = tmpMatch->next; if (!deleteMatch) deleteMatch = tmpMatch; else lastDeleteMatch->next = tmpMatch; lastDeleteMatch = tmpMatch; tmpMatch = tmpMatch->next; lastDeleteMatch->next = NULL; } else { prvMatch = tmpMatch; tmpMatch = tmpMatch->next; } } else { prvMatch = tmpMatch; tmpMatch = tmpMatch->next; } } /* ============================================= We need to preserve any logical dependencies of this object and reattach them after doing the retract. Otherwise, the Rete network will believe the object is gone and remove the links from the partial matches upon which this object is logically dependent. ============================================= */ if (deleteMatch != NULL) { saveDependents = ins->header.dependents; ins->header.dependents = NULL; NetworkRetract(theEnv,deleteMatch); ins->header.dependents = saveDependents; } } ins->reteSynchronized = TRUE; } /***************************************************** NAME : ObjectPatternNetErrorMessage DESCRIPTION : Prints out a locational error message when an evaluation error occurs during object pattern-matching INPUTS : The pattern node RETURNS : Nothing useful SIDE EFFECTS : Error message displayed NOTES : None *****************************************************/ static void ObjectPatternNetErrorMessage( void *theEnv, OBJECT_PATTERN_NODE *patternPtr) { PrintErrorID(theEnv,"OBJRTMCH",1,TRUE); EnvPrintRouter(theEnv,WERROR,"This error occurred in the object pattern network\n"); EnvPrintRouter(theEnv,WERROR," Currently active instance: ["); EnvPrintRouter(theEnv,WERROR,ValueToString(ObjectReteData(theEnv)->CurrentPatternObject->name)); EnvPrintRouter(theEnv,WERROR,"]\n"); EnvPrintRouter(theEnv,WERROR," Problem resides in slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(FindIDSlotName(theEnv,patternPtr->slotNameID))); EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long) patternPtr->whichField); EnvPrintRouter(theEnv,WERROR,"\n"); TraceErrorToObjectPattern(theEnv,TRUE,patternPtr); EnvPrintRouter(theEnv,WERROR,"\n"); } /********************************************************* NAME : TraceErrorToObjectPattern DESCRIPTION : Used by ObjectPatternNetErrorMessage() to print the rule(s) which contain an object pattern. INPUTS : 1) A flag indicating if this is the node in which the error actually occurred or not 2) The pattern node RETURNS : Nothing useful SIDE EFFECTS : Error message displayed NOTES : None *********************************************************/ static void TraceErrorToObjectPattern( void *theEnv, int errorNode, OBJECT_PATTERN_NODE *patternPtr) { struct joinNode *joinPtr; while (patternPtr != NULL) { if (patternPtr->alphaNode != NULL) { joinPtr = patternPtr->alphaNode->header.entryJoin; while (joinPtr != NULL) { EnvPrintRouter(theEnv,WERROR," Of pattern #"); PrintLongInteger(theEnv,WERROR,(long) joinPtr->depth); EnvPrintRouter(theEnv,WERROR," in rule(s):\n"); TraceErrorToRule(theEnv,joinPtr," "); joinPtr = joinPtr->rightMatchNode; } } TraceErrorToObjectPattern(theEnv,FALSE,patternPtr->nextLevel); if (errorNode) break; patternPtr = patternPtr->rightNode; } } #endif clips-6.24/clipssrc/._inherpsr.h0000400000175000017500000000012207422634770014743 0ustar jfsjfsMac OS X  2 RTEXT????aclips-6.24/clipssrc/insqypsr.h0000755000175000017500000000303307422634652014604 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_insqypsr #define _H_insqypsr #if INSTANCE_SET_QUERIES && (! RUN_TIME) #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSQYPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE EXPRESSION *ParseQueryNoAction(void *,EXPRESSION *,char *); LOCALE EXPRESSION *ParseQueryAction(void *,EXPRESSION *,char *); #ifndef _INSQYPSR_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/cstrnpsr.c0000755000175000017500000014173510441131501014555 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for parsing constraint */ /* declarations. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Donnell */ /* */ /* Revision History: */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _CSTRNPSR_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "scanner.h" #include "cstrnutl.h" #include "cstrnchk.h" #include "cstrnpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static intBool ParseRangeCardinalityAttribute(void *, char *,CONSTRAINT_RECORD *, CONSTRAINT_PARSE_RECORD *, char *,int); static intBool ParseTypeAttribute(void *,char *,CONSTRAINT_RECORD *); static void AddToRestrictionList(void *,int,CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static intBool ParseAllowedValuesAttribute(void *,char *,char *, CONSTRAINT_RECORD *, CONSTRAINT_PARSE_RECORD *); static int GetConstraintTypeFromAllowedName(char *); static int GetConstraintTypeFromTypeName(char *); static int GetAttributeParseValue(char *,CONSTRAINT_PARSE_RECORD *); static void SetRestrictionFlag(int,CONSTRAINT_RECORD *,int); static void SetParseFlag(CONSTRAINT_PARSE_RECORD *,char *); static void NoConjunctiveUseError(void *,char *,char *); #endif /********************************************************************/ /* CheckConstraintParseConflicts: Determines if a constraint record */ /* has any conflicts in the attribute specifications. Returns */ /* TRUE if no conflicts were detected, otherwise FALSE. */ /********************************************************************/ globle intBool CheckConstraintParseConflicts( void *theEnv, CONSTRAINT_RECORD *constraints) { /*===================================================*/ /* Check to see if any of the allowed-... attributes */ /* conflict with the type attribute. */ /*===================================================*/ if (constraints->anyAllowed == TRUE) { /* Do Nothing */ } else if (constraints->symbolRestriction && (constraints->symbolsAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-symbols"); return(FALSE); } else if (constraints->stringRestriction && (constraints->stringsAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-strings"); return(FALSE); } else if (constraints->integerRestriction && (constraints->integersAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-integers/numbers"); return(FALSE); } else if (constraints->floatRestriction && (constraints->floatsAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-floats/numbers"); return(FALSE); } else if (constraints->classRestriction && (constraints->instanceAddressesAllowed == FALSE) && (constraints->instanceNamesAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-classes"); return(FALSE); } else if (constraints->instanceNameRestriction && (constraints->instanceNamesAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-instance-names"); return(FALSE); } else if (constraints->anyRestriction) { struct expr *theExp; for (theExp = constraints->restrictionList; theExp != NULL; theExp = theExp->nextArg) { if (ConstraintCheckValue(theEnv,theExp->type,theExp->value,constraints) != NO_VIOLATION) { AttributeConflictErrorMessage(theEnv,"type","allowed-values"); return(FALSE); } } } /*================================================================*/ /* Check to see if range attribute conflicts with type attribute. */ /*================================================================*/ if ((constraints->maxValue != NULL) && (constraints->anyAllowed == FALSE)) { if (((constraints->maxValue->type == INTEGER) && (constraints->integersAllowed == FALSE)) || ((constraints->maxValue->type == FLOAT) && (constraints->floatsAllowed == FALSE))) { AttributeConflictErrorMessage(theEnv,"type","range"); return(FALSE); } } if ((constraints->minValue != NULL) && (constraints->anyAllowed == FALSE)) { if (((constraints->minValue->type == INTEGER) && (constraints->integersAllowed == FALSE)) || ((constraints->minValue->type == FLOAT) && (constraints->floatsAllowed == FALSE))) { AttributeConflictErrorMessage(theEnv,"type","range"); return(FALSE); } } /*=========================================*/ /* Check to see if allowed-class attribute */ /* conflicts with type attribute. */ /*=========================================*/ if ((constraints->classList != NULL) && (constraints->anyAllowed == FALSE) && (constraints->instanceNamesAllowed == FALSE) && (constraints->instanceAddressesAllowed == FALSE)) { AttributeConflictErrorMessage(theEnv,"type","allowed-class"); return(FALSE); } /*=====================================================*/ /* Return TRUE to indicate no conflicts were detected. */ /*=====================================================*/ return(TRUE); } /********************************************************/ /* AttributeConflictErrorMessage: Generic error message */ /* for a constraint attribute conflict. */ /********************************************************/ globle void AttributeConflictErrorMessage( void *theEnv, char *attribute1, char *attribute2) { PrintErrorID(theEnv,"CSTRNPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The "); EnvPrintRouter(theEnv,WERROR,attribute1); EnvPrintRouter(theEnv,WERROR," attribute conflicts with the "); EnvPrintRouter(theEnv,WERROR,attribute2); EnvPrintRouter(theEnv,WERROR," attribute.\n"); } #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************************************************/ /* InitializeConstraintParseRecord: Initializes the values of a constraint */ /* parse record which is used to determine whether one of the standard */ /* constraint specifications has already been parsed. */ /***************************************************************************/ globle void InitializeConstraintParseRecord( CONSTRAINT_PARSE_RECORD *parsedConstraints) { parsedConstraints->type = FALSE; parsedConstraints->range = FALSE; parsedConstraints->allowedSymbols = FALSE; parsedConstraints->allowedStrings = FALSE; parsedConstraints->allowedLexemes = FALSE; parsedConstraints->allowedIntegers = FALSE; parsedConstraints->allowedFloats = FALSE; parsedConstraints->allowedNumbers = FALSE; parsedConstraints->allowedValues = FALSE; parsedConstraints->allowedInstanceNames = FALSE; parsedConstraints->allowedClasses = FALSE; parsedConstraints->cardinality = FALSE; } /************************************************************************/ /* StandardConstraint: Returns TRUE if the specified name is one of the */ /* standard constraints parseable by the routines in this module. */ /************************************************************************/ globle intBool StandardConstraint( char *constraintName) { if ((strcmp(constraintName,"type") == 0) || (strcmp(constraintName,"range") == 0) || (strcmp(constraintName,"cardinality") == 0) || (strcmp(constraintName,"allowed-symbols") == 0) || (strcmp(constraintName,"allowed-strings") == 0) || (strcmp(constraintName,"allowed-lexemes") == 0) || (strcmp(constraintName,"allowed-integers") == 0) || (strcmp(constraintName,"allowed-floats") == 0) || (strcmp(constraintName,"allowed-numbers") == 0) || (strcmp(constraintName,"allowed-instance-names") == 0) || (strcmp(constraintName,"allowed-classes") == 0) || (strcmp(constraintName,"allowed-values") == 0)) { return(TRUE); } return(FALSE); } /***********************************************************************/ /* ParseStandardConstraint: Parses a standard constraint. Returns TRUE */ /* if the constraint was successfully parsed, otherwise FALSE. */ /***********************************************************************/ globle intBool ParseStandardConstraint( void *theEnv, char *readSource, char *constraintName, CONSTRAINT_RECORD *constraints, CONSTRAINT_PARSE_RECORD *parsedConstraints, int multipleValuesAllowed) { int rv = FALSE; /*=====================================================*/ /* Determine if the attribute has already been parsed. */ /*=====================================================*/ if (GetAttributeParseValue(constraintName,parsedConstraints)) { AlreadyParsedErrorMessage(theEnv,constraintName," attribute"); return(FALSE); } /*==========================================*/ /* If specified, parse the range attribute. */ /*==========================================*/ if (strcmp(constraintName,"range") == 0) { rv = ParseRangeCardinalityAttribute(theEnv,readSource,constraints,parsedConstraints, constraintName,multipleValuesAllowed); } /*================================================*/ /* If specified, parse the cardinality attribute. */ /*================================================*/ else if (strcmp(constraintName,"cardinality") == 0) { rv = ParseRangeCardinalityAttribute(theEnv,readSource,constraints,parsedConstraints, constraintName,multipleValuesAllowed); } /*=========================================*/ /* If specified, parse the type attribute. */ /*=========================================*/ else if (strcmp(constraintName,"type") == 0) { rv = ParseTypeAttribute(theEnv,readSource,constraints); } /*================================================*/ /* If specified, parse the allowed-... attribute. */ /*================================================*/ else if ((strcmp(constraintName,"allowed-symbols") == 0) || (strcmp(constraintName,"allowed-strings") == 0) || (strcmp(constraintName,"allowed-lexemes") == 0) || (strcmp(constraintName,"allowed-integers") == 0) || (strcmp(constraintName,"allowed-floats") == 0) || (strcmp(constraintName,"allowed-numbers") == 0) || (strcmp(constraintName,"allowed-instance-names") == 0) || (strcmp(constraintName,"allowed-classes") == 0) || (strcmp(constraintName,"allowed-values") == 0)) { rv = ParseAllowedValuesAttribute(theEnv,readSource,constraintName, constraints,parsedConstraints); } /*=========================================*/ /* Remember which constraint attribute was */ /* parsed and return the error status. */ /*=========================================*/ SetParseFlag(parsedConstraints,constraintName); return(rv); } /***********************************************************/ /* OverlayConstraint: Overlays fields of source constraint */ /* record on destination based on which fields are set in */ /* the parsed constraint record. Assumes AddConstraint has */ /* not yet been called for the destination constraint */ /* record. */ /***********************************************************/ globle void OverlayConstraint( void *theEnv, CONSTRAINT_PARSE_RECORD *pc, CONSTRAINT_RECORD *cdst, CONSTRAINT_RECORD *csrc) { if (pc->type == 0) { cdst->anyAllowed = csrc->anyAllowed; cdst->symbolsAllowed = csrc->symbolsAllowed; cdst->stringsAllowed = csrc->stringsAllowed; cdst->floatsAllowed = csrc->floatsAllowed; cdst->integersAllowed = csrc->integersAllowed; cdst->instanceNamesAllowed = csrc->instanceNamesAllowed; cdst->instanceAddressesAllowed = csrc->instanceAddressesAllowed; cdst->externalAddressesAllowed = csrc->externalAddressesAllowed; cdst->voidAllowed = csrc->voidAllowed; cdst->factAddressesAllowed = csrc->factAddressesAllowed; } if (pc->range == 0) { ReturnExpression(theEnv,cdst->minValue); ReturnExpression(theEnv,cdst->maxValue); cdst->minValue = CopyExpression(theEnv,csrc->minValue); cdst->maxValue = CopyExpression(theEnv,csrc->maxValue); } if (pc->allowedClasses == 0) { ReturnExpression(theEnv,cdst->classList); cdst->classList = CopyExpression(theEnv,csrc->classList); } if (pc->allowedValues == 0) { if ((pc->allowedSymbols == 0) && (pc->allowedStrings == 0) && (pc->allowedLexemes == 0) && (pc->allowedIntegers == 0) && (pc->allowedFloats == 0) && (pc->allowedNumbers == 0) && (pc->allowedInstanceNames == 0)) { cdst->anyRestriction = csrc->anyRestriction; cdst->symbolRestriction = csrc->symbolRestriction; cdst->stringRestriction = csrc->stringRestriction; cdst->floatRestriction = csrc->floatRestriction; cdst->integerRestriction = csrc->integerRestriction; cdst->classRestriction = csrc->classRestriction; cdst->instanceNameRestriction = csrc->instanceNameRestriction; cdst->restrictionList = CopyExpression(theEnv,csrc->restrictionList); } else { if ((pc->allowedSymbols == 0) && csrc->symbolRestriction) { cdst->symbolRestriction = 1; AddToRestrictionList(theEnv,SYMBOL,cdst,csrc); } if ((pc->allowedStrings == 0) && csrc->stringRestriction) { cdst->stringRestriction = 1; AddToRestrictionList(theEnv,STRING,cdst,csrc); } if ((pc->allowedLexemes == 0) && csrc->symbolRestriction && csrc->stringRestriction) { cdst->symbolRestriction = 1; cdst->stringRestriction = 1; AddToRestrictionList(theEnv,SYMBOL,cdst,csrc); AddToRestrictionList(theEnv,STRING,cdst,csrc); } if ((pc->allowedIntegers == 0) && csrc->integerRestriction) { cdst->integerRestriction = 1; AddToRestrictionList(theEnv,INTEGER,cdst,csrc); } if ((pc->allowedFloats == 0) && csrc->floatRestriction) { cdst->floatRestriction = 1; AddToRestrictionList(theEnv,FLOAT,cdst,csrc); } if ((pc->allowedNumbers == 0) && csrc->integerRestriction && csrc->floatRestriction) { cdst->integerRestriction = 1; cdst->floatRestriction = 1; AddToRestrictionList(theEnv,INTEGER,cdst,csrc); AddToRestrictionList(theEnv,FLOAT,cdst,csrc); } if ((pc->allowedInstanceNames == 0) && csrc->instanceNameRestriction) { cdst->instanceNameRestriction = 1; AddToRestrictionList(theEnv,INSTANCE_NAME,cdst,csrc); } } } if (pc->cardinality == 0) { ReturnExpression(theEnv,cdst->minFields); ReturnExpression(theEnv,cdst->maxFields); cdst->minFields = CopyExpression(theEnv,csrc->minFields); cdst->maxFields = CopyExpression(theEnv,csrc->maxFields); } } /**********************************************/ /* OverlayConstraintParseRecord: Performs a */ /* field-wise "or" of the destination parse */ /* record with the source parse record. */ /**********************************************/ globle void OverlayConstraintParseRecord( CONSTRAINT_PARSE_RECORD *dst, CONSTRAINT_PARSE_RECORD *src) { if (src->type) dst->type = TRUE; if (src->range) dst->range = TRUE; if (src->allowedSymbols) dst->allowedSymbols = TRUE; if (src->allowedStrings) dst->allowedStrings = TRUE; if (src->allowedLexemes) dst->allowedLexemes = TRUE; if (src->allowedIntegers) dst->allowedIntegers = TRUE; if (src->allowedFloats) dst->allowedFloats = TRUE; if (src->allowedNumbers) dst->allowedNumbers = TRUE; if (src->allowedValues) dst->allowedValues = TRUE; if (src->allowedInstanceNames) dst->allowedInstanceNames = TRUE; if (src->allowedClasses) dst->allowedClasses = TRUE; if (src->cardinality) dst->cardinality = TRUE; } /************************************************************/ /* AddToRestrictionList: Prepends atoms of the specified */ /* type from the source restriction list to the destination */ /************************************************************/ static void AddToRestrictionList( void *theEnv, int type, CONSTRAINT_RECORD *cdst, CONSTRAINT_RECORD *csrc) { struct expr *theExp,*tmp; for (theExp = csrc->restrictionList; theExp != NULL; theExp = theExp->nextArg) { if (theExp->type == type) { tmp = GenConstant(theEnv,theExp->type,theExp->value); tmp->nextArg = cdst->restrictionList; cdst->restrictionList = tmp; } } } /*******************************************************************/ /* ParseAllowedValuesAttribute: Parses the allowed-... attributes. */ /*******************************************************************/ static intBool ParseAllowedValuesAttribute( void *theEnv, char *readSource, char *constraintName, CONSTRAINT_RECORD *constraints, CONSTRAINT_PARSE_RECORD *parsedConstraints) { struct token inputToken; int expectedType, restrictionType, error = FALSE; struct expr *newValue, *lastValue; int constantParsed = FALSE, variableParsed = FALSE; char *tempPtr = NULL; /*======================================================*/ /* The allowed-values attribute is not allowed if other */ /* allowed-... attributes have already been parsed. */ /*======================================================*/ if ((strcmp(constraintName,"allowed-values") == 0) && ((parsedConstraints->allowedSymbols) || (parsedConstraints->allowedStrings) || (parsedConstraints->allowedLexemes) || (parsedConstraints->allowedIntegers) || (parsedConstraints->allowedFloats) || (parsedConstraints->allowedNumbers) || (parsedConstraints->allowedInstanceNames))) { if (parsedConstraints->allowedSymbols) tempPtr = "allowed-symbols"; else if (parsedConstraints->allowedStrings) tempPtr = "allowed-strings"; else if (parsedConstraints->allowedLexemes) tempPtr = "allowed-lexemes"; else if (parsedConstraints->allowedIntegers) tempPtr = "allowed-integers"; else if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats"; else if (parsedConstraints->allowedNumbers) tempPtr = "allowed-numbers"; else if (parsedConstraints->allowedInstanceNames) tempPtr = "allowed-instance-names"; NoConjunctiveUseError(theEnv,"allowed-values",tempPtr); return(FALSE); } /*=======================================================*/ /* The allowed-values/numbers/integers/floats attributes */ /* are not allowed with the range attribute. */ /*=======================================================*/ if (((strcmp(constraintName,"allowed-values") == 0) || (strcmp(constraintName,"allowed-numbers") == 0) || (strcmp(constraintName,"allowed-integers") == 0) || (strcmp(constraintName,"allowed-floats") == 0)) && (parsedConstraints->range)) { NoConjunctiveUseError(theEnv,constraintName,"range"); return(FALSE); } /*===================================================*/ /* The allowed-... attributes are not allowed if the */ /* allowed-values attribute has already been parsed. */ /*===================================================*/ if ((strcmp(constraintName,"allowed-values") != 0) && (parsedConstraints->allowedValues)) { NoConjunctiveUseError(theEnv,constraintName,"allowed-values"); return(FALSE); } /*==================================================*/ /* The allowed-numbers attribute is not allowed if */ /* the allowed-integers or allowed-floats attribute */ /* has already been parsed. */ /*==================================================*/ if ((strcmp(constraintName,"allowed-numbers") == 0) && ((parsedConstraints->allowedFloats) || (parsedConstraints->allowedIntegers))) { if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats"; else tempPtr = "allowed-integers"; NoConjunctiveUseError(theEnv,"allowed-numbers",tempPtr); return(FALSE); } /*============================================================*/ /* The allowed-integers/floats attributes are not allowed if */ /* the allowed-numbers attribute has already been parsed. */ /*============================================================*/ if (((strcmp(constraintName,"allowed-integers") == 0) || (strcmp(constraintName,"allowed-floats") == 0)) && (parsedConstraints->allowedNumbers)) { NoConjunctiveUseError(theEnv,constraintName,"allowed-number"); return(FALSE); } /*==================================================*/ /* The allowed-lexemes attribute is not allowed if */ /* the allowed-symbols or allowed-strings attribute */ /* has already been parsed. */ /*==================================================*/ if ((strcmp(constraintName,"allowed-lexemes") == 0) && ((parsedConstraints->allowedSymbols) || (parsedConstraints->allowedStrings))) { if (parsedConstraints->allowedSymbols) tempPtr = "allowed-symbols"; else tempPtr = "allowed-strings"; NoConjunctiveUseError(theEnv,"allowed-lexemes",tempPtr); return(FALSE); } /*===========================================================*/ /* The allowed-symbols/strings attributes are not allowed if */ /* the allowed-lexemes attribute has already been parsed. */ /*===========================================================*/ if (((strcmp(constraintName,"allowed-symbols") == 0) || (strcmp(constraintName,"allowed-strings") == 0)) && (parsedConstraints->allowedLexemes)) { NoConjunctiveUseError(theEnv,constraintName,"allowed-lexemes"); return(FALSE); } /*========================*/ /* Get the expected type. */ /*========================*/ restrictionType = GetConstraintTypeFromAllowedName(constraintName); SetRestrictionFlag(restrictionType,constraints,TRUE); if (strcmp(constraintName,"allowed-classes") == 0) { expectedType = SYMBOL; } else { expectedType = restrictionType; } /*=================================================*/ /* Get the last value in the restriction list (the */ /* allowed values will be appended there). */ /*=================================================*/ if (strcmp(constraintName,"allowed-classes") == 0) { lastValue = constraints->classList; } else { lastValue = constraints->restrictionList; } if (lastValue != NULL) { while (lastValue->nextArg != NULL) lastValue = lastValue->nextArg; } /*==================================================*/ /* Read the allowed values and add them to the list */ /* until a right parenthesis is encountered. */ /*==================================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); while (inputToken.type != RPAREN) { SavePPBuffer(theEnv," "); /*=============================================*/ /* Determine the type of the token just parsed */ /* and if it is an appropriate value. */ /*=============================================*/ switch(inputToken.type) { case INTEGER: if ((expectedType != UNKNOWN_VALUE) && (expectedType != INTEGER) && (expectedType != INTEGER_OR_FLOAT)) error = TRUE; constantParsed = TRUE; break; case FLOAT: if ((expectedType != UNKNOWN_VALUE) && (expectedType != FLOAT) && (expectedType != INTEGER_OR_FLOAT)) error = TRUE; constantParsed = TRUE; break; case STRING: if ((expectedType != UNKNOWN_VALUE) && (expectedType != STRING) && (expectedType != SYMBOL_OR_STRING)) error = TRUE; constantParsed = TRUE; break; case SYMBOL: if ((expectedType != UNKNOWN_VALUE) && (expectedType != SYMBOL) && (expectedType != SYMBOL_OR_STRING)) error = TRUE; constantParsed = TRUE; break; #if OBJECT_SYSTEM case INSTANCE_NAME: if ((expectedType != UNKNOWN_VALUE) && (expectedType != INSTANCE_NAME)) error = TRUE; constantParsed = TRUE; break; #endif case SF_VARIABLE: if (strcmp(inputToken.printForm,"?VARIABLE") == 0) { variableParsed = TRUE; } else { char tempBuffer[120]; sprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } break; default: { char tempBuffer[120]; sprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); } return(FALSE); } /*=====================================*/ /* Signal an error if an inappropriate */ /* value was found. */ /*=====================================*/ if (error) { PrintErrorID(theEnv,"CSTRNPSR",4,TRUE); EnvPrintRouter(theEnv,WERROR,"Value does not match the expected type for the "); EnvPrintRouter(theEnv,WERROR,constraintName); EnvPrintRouter(theEnv,WERROR," attribute\n"); return(FALSE); } /*======================================*/ /* The ?VARIABLE argument can't be used */ /* in conjunction with constants. */ /*======================================*/ if (constantParsed && variableParsed) { char tempBuffer[120]; sprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } /*===========================================*/ /* Add the constant to the restriction list. */ /*===========================================*/ newValue = GenConstant(theEnv,inputToken.type,inputToken.value); if (lastValue == NULL) { if (strcmp(constraintName,"allowed-classes") == 0) { constraints->classList = newValue; } else { constraints->restrictionList = newValue; } } else { lastValue->nextArg = newValue; } lastValue = newValue; /*=======================================*/ /* Begin parsing the next allowed value. */ /*=======================================*/ GetToken(theEnv,readSource,&inputToken); } /*======================================================*/ /* There must be at least one value for this attribute. */ /*======================================================*/ if ((! constantParsed) && (! variableParsed)) { char tempBuffer[120]; sprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } /*======================================*/ /* If ?VARIABLE was parsed, then remove */ /* the restrictions for the type being */ /* restricted. */ /*======================================*/ if (variableParsed) { switch(restrictionType) { case UNKNOWN_VALUE: constraints->anyRestriction = FALSE; break; case SYMBOL: constraints->symbolRestriction = FALSE; break; case STRING: constraints->stringRestriction = FALSE; break; case INTEGER: constraints->integerRestriction = FALSE; break; case FLOAT: constraints->floatRestriction = FALSE; break; case INTEGER_OR_FLOAT: constraints->floatRestriction = FALSE; constraints->integerRestriction = FALSE; break; case SYMBOL_OR_STRING: constraints->symbolRestriction = FALSE; constraints->stringRestriction = FALSE; break; case INSTANCE_NAME: constraints->instanceNameRestriction = FALSE; break; case INSTANCE_OR_INSTANCE_NAME: constraints->classRestriction = FALSE; break; } } /*=====================================*/ /* Fix up pretty print representation. */ /*=====================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); /*=======================================*/ /* Return TRUE to indicate the attribute */ /* was successfully parsed. */ /*=======================================*/ return(TRUE); } /***********************************************************/ /* NoConjunctiveUseError: Generic error message indicating */ /* that two attributes can't be used in conjunction. */ /***********************************************************/ static void NoConjunctiveUseError( void *theEnv, char *attribute1, char *attribute2) { PrintErrorID(theEnv,"CSTRNPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"The "); EnvPrintRouter(theEnv,WERROR,attribute1); EnvPrintRouter(theEnv,WERROR," attribute cannot be used\n"); EnvPrintRouter(theEnv,WERROR,"in conjunction with the "); EnvPrintRouter(theEnv,WERROR,attribute2); EnvPrintRouter(theEnv,WERROR," attribute.\n"); } /**************************************************/ /* ParseTypeAttribute: Parses the type attribute. */ /**************************************************/ static intBool ParseTypeAttribute( void *theEnv, char *readSource, CONSTRAINT_RECORD *constraints) { int typeParsed = FALSE; int variableParsed = FALSE; int theType; struct token inputToken; /*======================================*/ /* Continue parsing types until a right */ /* parenthesis is encountered. */ /*======================================*/ SavePPBuffer(theEnv," "); for (GetToken(theEnv,readSource,&inputToken); inputToken.type != RPAREN; GetToken(theEnv,readSource,&inputToken)) { SavePPBuffer(theEnv," "); /*==================================*/ /* If the token is a symbol then... */ /*==================================*/ if (inputToken.type == SYMBOL) { /*==============================================*/ /* ?VARIABLE can't be used with type constants. */ /*==============================================*/ if (variableParsed == TRUE) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*========================================*/ /* Check for an appropriate type constant */ /* (e.g. SYMBOL, FLOAT, INTEGER, etc.). */ /*========================================*/ theType = GetConstraintTypeFromTypeName(ValueToString(inputToken.value)); if (theType < 0) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*==================================================*/ /* Change the type restriction flags to reflect the */ /* type restriction. If the type restriction was */ /* already specified, then a error is generated. */ /*==================================================*/ if (SetConstraintType(theType,constraints)) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } constraints->anyAllowed = FALSE; /*===========================================*/ /* Remember that a type constant was parsed. */ /*===========================================*/ typeParsed = TRUE; } /*==============================================*/ /* Otherwise if the token is a variable then... */ /*==============================================*/ else if (inputToken.type == SF_VARIABLE) { /*========================================*/ /* The only variable allowd is ?VARIABLE. */ /*========================================*/ if (strcmp(inputToken.printForm,"?VARIABLE") != 0) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*===================================*/ /* ?VARIABLE can't be used more than */ /* once or with type constants. */ /*===================================*/ if (typeParsed || variableParsed) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*======================================*/ /* Remember that a variable was parsed. */ /*======================================*/ variableParsed = TRUE; } /*====================================*/ /* Otherwise this is an invalid value */ /* for the type attribute. */ /*====================================*/ else { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } } /*=====================================*/ /* Fix up pretty print representation. */ /*=====================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); /*=======================================*/ /* The type attribute must have a value. */ /*=======================================*/ if ((! typeParsed) && (! variableParsed)) { SyntaxErrorMessage(theEnv,"type attribute"); return(FALSE); } /*===========================================*/ /* Return TRUE indicating the type attibuted */ /* was successfully parsed. */ /*===========================================*/ return(TRUE); } /***************************************************************************/ /* ParseRangeCardinalityAttribute: Parses the range/cardinality attribute. */ /***************************************************************************/ static intBool ParseRangeCardinalityAttribute( void *theEnv, char *readSource, CONSTRAINT_RECORD *constraints, CONSTRAINT_PARSE_RECORD *parsedConstraints, char *constraintName, int multipleValuesAllowed) { struct token inputToken; int range; char *tempPtr = NULL; /*=================================*/ /* Determine if we're parsing the */ /* range or cardinality attribute. */ /*=================================*/ if (strcmp(constraintName,"range") == 0) { parsedConstraints->range = TRUE; range = TRUE; } else { parsedConstraints->cardinality = TRUE; range = FALSE; } /*===================================================================*/ /* The cardinality attribute can only be used with multifield slots. */ /*===================================================================*/ if ((range == FALSE) && (multipleValuesAllowed == FALSE)) { PrintErrorID(theEnv,"CSTRNPSR",5,TRUE); EnvPrintRouter(theEnv,WERROR,"The cardinality attribute "); EnvPrintRouter(theEnv,WERROR,"can only be used with multifield slots.\n"); return(FALSE); } /*====================================================*/ /* The range attribute is not allowed with the */ /* allowed-values/numbers/integers/floats attributes. */ /*====================================================*/ if ((range == TRUE) && (parsedConstraints->allowedValues || parsedConstraints->allowedNumbers || parsedConstraints->allowedIntegers || parsedConstraints->allowedFloats)) { if (parsedConstraints->allowedValues) tempPtr = "allowed-values"; else if (parsedConstraints->allowedIntegers) tempPtr = "allowed-integers"; else if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats"; else if (parsedConstraints->allowedNumbers) tempPtr = "allowed-numbers"; NoConjunctiveUseError(theEnv,"range",tempPtr); return(FALSE); } /*==========================*/ /* Parse the minimum value. */ /*==========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); if ((inputToken.type == INTEGER) || ((inputToken.type == FLOAT) && range)) { if (range) { ReturnExpression(theEnv,constraints->minValue); constraints->minValue = GenConstant(theEnv,inputToken.type,inputToken.value); } else { ReturnExpression(theEnv,constraints->minFields); constraints->minFields = GenConstant(theEnv,inputToken.type,inputToken.value); } } else if ((inputToken.type == SF_VARIABLE) && (strcmp(inputToken.printForm,"?VARIABLE") == 0)) { /* Do nothing. */ } else { char tempBuffer[120]; sprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } /*==========================*/ /* Parse the maximum value. */ /*==========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&inputToken); if ((inputToken.type == INTEGER) || ((inputToken.type == FLOAT) && range)) { if (range) { ReturnExpression(theEnv,constraints->maxValue); constraints->maxValue = GenConstant(theEnv,inputToken.type,inputToken.value); } else { ReturnExpression(theEnv,constraints->maxFields); constraints->maxFields = GenConstant(theEnv,inputToken.type,inputToken.value); } } else if ((inputToken.type == SF_VARIABLE) && (strcmp(inputToken.printForm,"?VARIABLE") == 0)) { /* Do nothing. */ } else { char tempBuffer[120]; sprintf(tempBuffer,"%s attribute",constraintName); SyntaxErrorMessage(theEnv,tempBuffer); return(FALSE); } /*================================*/ /* Parse the closing parenthesis. */ /*================================*/ GetToken(theEnv,readSource,&inputToken); if (inputToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"range attribute"); return(FALSE); } /*====================================================*/ /* Minimum value must be less than the maximum value. */ /*====================================================*/ if (range) { if (CompareNumbers(theEnv,constraints->minValue->type, constraints->minValue->value, constraints->maxValue->type, constraints->maxValue->value) == GREATER_THAN) { PrintErrorID(theEnv,"CSTRNPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Minimum range value must be less than\n"); EnvPrintRouter(theEnv,WERROR,"or equal to the maximum range value\n"); return(FALSE); } } else { if (CompareNumbers(theEnv,constraints->minFields->type, constraints->minFields->value, constraints->maxFields->type, constraints->maxFields->value) == GREATER_THAN) { PrintErrorID(theEnv,"CSTRNPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Minimum cardinality value must be less than\n"); EnvPrintRouter(theEnv,WERROR,"or equal to the maximum cardinality value\n"); return(FALSE); } } /*====================================*/ /* Return TRUE to indicate that the */ /* attribute was successfully parsed. */ /*====================================*/ return(TRUE); } /******************************************************************/ /* GetConstraintTypeFromAllowedName: Returns the type restriction */ /* associated with an allowed-... attribute. */ /******************************************************************/ static int GetConstraintTypeFromAllowedName( char *constraintName) { if (strcmp(constraintName,"allowed-values") == 0) return(UNKNOWN_VALUE); else if (strcmp(constraintName,"allowed-symbols") == 0) return(SYMBOL); else if (strcmp(constraintName,"allowed-strings") == 0) return(STRING); else if (strcmp(constraintName,"allowed-lexemes") == 0) return(SYMBOL_OR_STRING); else if (strcmp(constraintName,"allowed-integers") == 0) return(INTEGER); else if (strcmp(constraintName,"allowed-numbers") == 0) return(INTEGER_OR_FLOAT); else if (strcmp(constraintName,"allowed-instance-names") == 0) return(INSTANCE_NAME); else if (strcmp(constraintName,"allowed-classes") == 0) return(INSTANCE_OR_INSTANCE_NAME); else if (strcmp(constraintName,"allowed-floats") == 0) return(FLOAT); return(-1); } /*******************************************************/ /* GetConstraintTypeFromTypeName: Converts a type name */ /* to its equivalent integer type restriction. */ /*******************************************************/ static int GetConstraintTypeFromTypeName( char *constraintName) { if (strcmp(constraintName,"SYMBOL") == 0) return(SYMBOL); else if (strcmp(constraintName,"STRING") == 0) return(STRING); else if (strcmp(constraintName,"LEXEME") == 0) return(SYMBOL_OR_STRING); else if (strcmp(constraintName,"INTEGER") == 0) return(INTEGER); else if (strcmp(constraintName,"FLOAT") == 0) return(FLOAT); else if (strcmp(constraintName,"NUMBER") == 0) return(INTEGER_OR_FLOAT); else if (strcmp(constraintName,"INSTANCE-NAME") == 0) return(INSTANCE_NAME); else if (strcmp(constraintName,"INSTANCE-ADDRESS") == 0) return(INSTANCE_ADDRESS); else if (strcmp(constraintName,"INSTANCE") == 0) return(INSTANCE_OR_INSTANCE_NAME); else if (strcmp(constraintName,"EXTERNAL-ADDRESS") == 0) return(EXTERNAL_ADDRESS); else if (strcmp(constraintName,"FACT-ADDRESS") == 0) return(FACT_ADDRESS); return(-1); } /**************************************************************/ /* GetAttributeParseValue: Returns a boolean value indicating */ /* whether a specific attribute has already been parsed. */ /**************************************************************/ static int GetAttributeParseValue( char *constraintName, CONSTRAINT_PARSE_RECORD *parsedConstraints) { if (strcmp(constraintName,"type") == 0) { return(parsedConstraints->type); } else if (strcmp(constraintName,"range") == 0) { return(parsedConstraints->range); } else if (strcmp(constraintName,"cardinality") == 0) { return(parsedConstraints->cardinality); } else if (strcmp(constraintName,"allowed-values") == 0) { return(parsedConstraints->allowedValues); } else if (strcmp(constraintName,"allowed-symbols") == 0) { return(parsedConstraints->allowedSymbols); } else if (strcmp(constraintName,"allowed-strings") == 0) { return(parsedConstraints->allowedStrings); } else if (strcmp(constraintName,"allowed-lexemes") == 0) { return(parsedConstraints->allowedLexemes); } else if (strcmp(constraintName,"allowed-instance-names") == 0) { return(parsedConstraints->allowedInstanceNames); } else if (strcmp(constraintName,"allowed-classes") == 0) { return(parsedConstraints->allowedClasses); } else if (strcmp(constraintName,"allowed-integers") == 0) { return(parsedConstraints->allowedIntegers); } else if (strcmp(constraintName,"allowed-floats") == 0) { return(parsedConstraints->allowedFloats); } else if (strcmp(constraintName,"allowed-numbers") == 0) { return(parsedConstraints->allowedNumbers); } return(TRUE); } /**********************************************************/ /* SetRestrictionFlag: Sets the restriction flag of a */ /* constraint record indicating whether a specific */ /* type has an associated allowed-... restriction list. */ /**********************************************************/ static void SetRestrictionFlag( int restriction, CONSTRAINT_RECORD *constraints, int value) { switch (restriction) { case UNKNOWN_VALUE: constraints->anyRestriction = value; break; case SYMBOL: constraints->symbolRestriction = value; break; case STRING: constraints->stringRestriction = value; break; case INTEGER: constraints->integerRestriction = value; break; case FLOAT: constraints->floatRestriction = value; break; case INTEGER_OR_FLOAT: constraints->integerRestriction = value; constraints->floatRestriction = value; break; case SYMBOL_OR_STRING: constraints->symbolRestriction = value; constraints->stringRestriction = value; break; case INSTANCE_NAME: constraints->instanceNameRestriction = value; break; case INSTANCE_OR_INSTANCE_NAME: constraints->classRestriction = value; break; } } /********************************************************************/ /* SetParseFlag: Sets the flag in a parsed constraints data */ /* structure indicating that a specific attribute has been parsed. */ /********************************************************************/ static void SetParseFlag( CONSTRAINT_PARSE_RECORD *parsedConstraints, char *constraintName) { if (strcmp(constraintName,"range") == 0) { parsedConstraints->range = TRUE; } else if (strcmp(constraintName,"type") == 0) { parsedConstraints->type = TRUE; } else if (strcmp(constraintName,"cardinality") == 0) { parsedConstraints->cardinality = TRUE; } else if (strcmp(constraintName,"allowed-symbols") == 0) { parsedConstraints->allowedSymbols = TRUE; } else if (strcmp(constraintName,"allowed-strings") == 0) { parsedConstraints->allowedStrings = TRUE; } else if (strcmp(constraintName,"allowed-lexemes") == 0) { parsedConstraints->allowedLexemes = TRUE; } else if (strcmp(constraintName,"allowed-integers") == 0) { parsedConstraints->allowedIntegers = TRUE; } else if (strcmp(constraintName,"allowed-floats") == 0) { parsedConstraints->allowedFloats = TRUE; } else if (strcmp(constraintName,"allowed-numbers") == 0) { parsedConstraints->allowedNumbers = TRUE; } else if (strcmp(constraintName,"allowed-values") == 0) { parsedConstraints->allowedValues = TRUE; } else if (strcmp(constraintName,"allowed-classes") == 0) { parsedConstraints->allowedClasses = TRUE; } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ clips-6.24/clipssrc/cstrnops.h0000755000175000017500000000360507422635013014564 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* CONSTRAINT OPERATIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for performing operations on */ /* constraint records including computing the intersection */ /* and union of constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrnops #define _H_cstrnops #if (! RUN_TIME) #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNOPS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct constraintRecord *IntersectConstraints(void *,struct constraintRecord *,struct constraintRecord *); #if (! BLOAD_ONLY) LOCALE struct constraintRecord *UnionConstraints(void *,struct constraintRecord *,struct constraintRecord *); LOCALE void RemoveConstantFromConstraint(void *,int,void *,CONSTRAINT_RECORD *); #endif #endif #endif clips-6.24/clipssrc/._main.c0000400000175000017500000000075410441602240014021 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoUkUknx TTFL,fFMPSRMWBBLclips-6.24/clipssrc/network.h0000755000175000017500000000436507422634761014417 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* NETWORK HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_network #define _H_network struct patternNodeHeader; struct joinNode; #ifndef _H_match #include "match.h" #endif struct patternNodeHeader { struct partialMatch *alphaMemory; struct partialMatch *endOfQueue; struct joinNode *entryJoin; unsigned int singlefieldNode : 1; unsigned int multifieldNode : 1; unsigned int stopNode : 1; unsigned int initialize : 1; unsigned int marked : 1; unsigned int beginSlot : 1; unsigned int endSlot : 1; }; #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_ruledef #include "ruledef.h" #endif struct joinNode { unsigned int firstJoin : 1; unsigned int logicalJoin : 1; unsigned int joinFromTheRight : 1; unsigned int patternIsNegated : 1; unsigned int initialize : 1; unsigned int marked : 1; unsigned int rhsType : 3; unsigned int depth : 7; long bsaveID; struct partialMatch *beta; struct expr *networkTest; void *rightSideEntryStructure; struct joinNode *nextLevel; struct joinNode *lastLevel; struct joinNode *rightDriveNode; struct joinNode *rightMatchNode; struct defrule *ruleToActivate; }; #endif clips-6.24/clipssrc/globlcom.c0000755000175000017500000002135410441143622014476 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFGLOBAL COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the show-defglobals, set-reset-globals, */ /* and get-reset-globals commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _GLOBLCOM_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT #include "extnfunc.h" #include "argacces.h" #include "prntutil.h" #include "router.h" #include "envrnmnt.h" #include "globldef.h" #include "globlcom.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if DEBUGGING_FUNCTIONS static void PrintDefglobalValueForm(void *,char *,void *); #endif /************************************************************/ /* DefglobalCommandDefinitions: Defines defglobal commands. */ /************************************************************/ globle void DefglobalCommandDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"set-reset-globals",'b', SetResetGlobalsCommand,"SetResetGlobalsCommand", "11"); EnvDefineFunction2(theEnv,"get-reset-globals",'b', GetResetGlobalsCommand,"GetResetGlobalsCommand", "00"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"show-defglobals",'v', PTIEF ShowDefglobalsCommand,"ShowDefglobalsCommand", "01w"); #endif #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /************************************************/ /* SetResetGlobalsCommand: H/L access routine */ /* for the get-reset-globals command. */ /************************************************/ globle int SetResetGlobalsCommand( void *theEnv) { int oldValue; DATA_OBJECT arg_ptr; /*===========================================*/ /* Remember the old value of this attribute. */ /*===========================================*/ oldValue = EnvGetResetGlobals(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-reset-globals",EXACTLY,1) == -1) { return(oldValue); } /*===========================================*/ /* Determine the new value of the attribute. */ /*===========================================*/ EnvRtnUnknown(theEnv,1,&arg_ptr); if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL)) { EnvSetResetGlobals(theEnv,FALSE); } else { EnvSetResetGlobals(theEnv,TRUE); } /*========================================*/ /* Return the old value of the attribute. */ /*========================================*/ return(oldValue); } /****************************************/ /* EnvSetResetGlobals: C access routine */ /* for the set-reset-globals command. */ /****************************************/ globle intBool EnvSetResetGlobals( void *theEnv, int value) { int ov; ov = DefglobalData(theEnv)->ResetGlobals; DefglobalData(theEnv)->ResetGlobals = value; return(ov); } /************************************************/ /* GetResetGlobalsCommand: H/L access routine */ /* for the get-reset-globals command. */ /************************************************/ globle int GetResetGlobalsCommand( void *theEnv) { int oldValue; oldValue = EnvGetResetGlobals(theEnv); if (EnvArgCountCheck(theEnv,"get-reset-globals",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } /****************************************/ /* EnvGetResetGlobals: C access routine */ /* for the get-reset-globals command. */ /****************************************/ globle intBool EnvGetResetGlobals( void *theEnv) { return(DefglobalData(theEnv)->ResetGlobals); } #if DEBUGGING_FUNCTIONS /***********************************************/ /* ShowDefglobalsCommand: H/L access routine */ /* for the show-defglobals command. */ /***********************************************/ globle void ShowDefglobalsCommand( void *theEnv) { struct defmodule *theModule; int numArgs, error; if ((numArgs = EnvArgCountCheck(theEnv,"show-defglobals",NO_MORE_THAN,1)) == -1) return; if (numArgs == 1) { theModule = GetModuleName(theEnv,"show-defglobals",1,&error); if (error) return; } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } EnvShowDefglobals(theEnv,WDISPLAY,theModule); } /***************************************/ /* EnvShowDefglobals: C access routine */ /* for the show-defglobals command. */ /***************************************/ globle void EnvShowDefglobals( void *theEnv, char *logicalName, void *vTheModule) { struct defmodule *theModule = (struct defmodule *) vTheModule; struct constructHeader *constructPtr; int allModules = FALSE; struct defmoduleItemHeader *theModuleItem; /*=======================================*/ /* If the module specified is NULL, then */ /* list all constructs in all modules. */ /*=======================================*/ if (theModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); allModules = TRUE; } /*======================================================*/ /* Print out the constructs in the specified module(s). */ /*======================================================*/ for (; theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*===========================================*/ /* Print the module name before every group */ /* of defglobals listed if we're listing the */ /* defglobals from every module. */ /*===========================================*/ if (allModules) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule)); EnvPrintRouter(theEnv,logicalName,":\n"); } /*=====================================*/ /* Print every defglobal in the module */ /* currently being examined. */ /*=====================================*/ theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,DefglobalData(theEnv)->DefglobalModuleIndex); for (constructPtr = theModuleItem->firstItem; constructPtr != NULL; constructPtr = constructPtr->next) { if (EvaluationData(theEnv)->HaltExecution == TRUE) return; if (allModules) EnvPrintRouter(theEnv,logicalName," "); PrintDefglobalValueForm(theEnv,logicalName,(void *) constructPtr); EnvPrintRouter(theEnv,logicalName,"\n"); } /*===================================*/ /* If we're only listing the globals */ /* for one module, then return. */ /*===================================*/ if (! allModules) return; } } /*****************************************************/ /* PrintDefglobalValueForm: Prints the value form of */ /* a defglobal (the current value). For example, */ /* ?*x* = 3 */ /*****************************************************/ static void PrintDefglobalValueForm( void *theEnv, char *logicalName, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; EnvPrintRouter(theEnv,logicalName,"?*"); EnvPrintRouter(theEnv,logicalName,ValueToString(theGlobal->header.name)); EnvPrintRouter(theEnv,logicalName,"* = "); PrintDataObject(theEnv,logicalName,&theGlobal->current); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFGLOBAL_CONSTRUCT */ clips-6.24/clipssrc/msgpsr.c0000755000175000017500000006147010441150154014214 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* MESSAGE-HANDLER PARSER FUNCTIONS */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS */ /* compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #include #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "classcom.h" #include "classfun.h" #include "memalloc.h" #include "constrct.h" #include "cstrcpsr.h" #include "cstrnchk.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "insfun.h" #include "msgcom.h" #include "msgfun.h" #include "pprint.h" #include "prccode.h" #include "router.h" #include "scanner.h" #include "strngrtr.h" #define _MSGPSR_SOURCE_ #include "msgpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define SELF_LEN 4 #define SELF_SLOT_REF ':' /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool IsParameterSlotReference(void *,char *); static int SlotReferenceVar(void *,EXPRESSION *,void *); static int BindSlotReference(void *,EXPRESSION *,void *); static SLOT_DESC *CheckSlotReference(void *,DEFCLASS *,int,void *,intBool,EXPRESSION *); static void GenHandlerSlotReference(void *,EXPRESSION *,unsigned short,SLOT_DESC *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************************** NAME : ParseDefmessageHandler DESCRIPTION : Parses a message-handler for a class of objects INPUTS : The logical name of the input source RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Handler allocated and inserted into class NOTES : H/L Syntax: (defmessage-handler [] [] () *) ::= * | * $? ***********************************************************************/ globle int ParseDefmessageHandler( void *theEnv, char *readSource) { DEFCLASS *cls; SYMBOL_HN *cname,*mname,*wildcard; unsigned mtype = MPRIMARY; int min,max,error,lvars; EXPRESSION *hndParams,*actions; HANDLER *hnd; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmessage-handler "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmessage-handler"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler", NULL,NULL,"~",TRUE,FALSE,TRUE); if (cname == NULL) return(TRUE); cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname)); if (cls == NULL) { PrintErrorID(theEnv,"MSGPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n"); return(TRUE); } if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,"MSGPSR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls)); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } if (HandlersExecuting(cls)) { PrintErrorID(theEnv,"MSGPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n"); EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n"); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SavePPBuffer(theEnv," "); if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken)); if (mtype == MERROR) return(TRUE); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } else { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } PPBackup(theEnv); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); hnd = FindHandlerByAddress(cls,mname,mtype); if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv)) { EnvPrintRouter(theEnv,WDIALOG," Handler "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname)); EnvPrintRouter(theEnv,WDIALOG," "); EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]); EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n")); } if ((hnd != NULL) ? hnd->system : FALSE) { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); return(TRUE); } hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL); hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams, &wildcard,&min,&max,&error,IsParameterSlotReference); if (error) return(TRUE); PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"message-handler",readSource, &DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard, SlotReferenceVar,BindSlotReference,&lvars, (void *) cls); if (actions == NULL) { ReturnExpression(theEnv,hndParams); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"defmessage-handler"); ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv,"\n"); /* =================================================== If we're only checking syntax, don't add the successfully parsed defmessage-handler to the KB. =================================================== */ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(FALSE); } if (hnd != NULL) { ExpressionDeinstall(theEnv,hnd->actions); ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else { hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype); IncrementSymbolCount(hnd->name); } ReturnExpression(theEnv,hndParams); hnd->minParams = min; hnd->maxParams = max; hnd->localVarCount = lvars; hnd->actions = actions; ExpressionInstall(theEnv,hnd->actions); #if DEBUGGING_FUNCTIONS /* =================================================== Old handler trace status is automatically preserved =================================================== */ if (EnvGetConserveMemory(theEnv) == FALSE) hnd->ppForm = CopyPPBuffer(theEnv); else #endif hnd->ppForm = NULL; return(FALSE); } /******************************************************************************* NAME : CreateGetAndPutHandlers DESCRIPTION : Creates two message-handlers with the following syntax for the slot: (defmessage-handler get- primary () ?self:) For single-field slots: (defmessage-handler put- primary (?value) (bind ?self: ?value)) For multifield slots: (defmessage-handler put- primary ($?value) (bind ?self: ?value)) INPUTS : The class slot descriptor RETURNS : Nothing useful SIDE EFFECTS : Message-handlers created NOTES : A put handler is not created for read-only slots *******************************************************************************/ globle void CreateGetAndPutHandlers( void *theEnv, SLOT_DESC *sd) { char *className,*slotName; unsigned bufsz; char *buf,*handlerRouter = "*** Default Public Handlers ***"; int oldPWL,oldCM; char *oldRouter; char *oldString; long oldIndex; if ((sd->createReadAccessor == 0) && (sd->createWriteAccessor == 0)) return; className = ValueToString(sd->cls->header.name); slotName = ValueToString(sd->slotName->name); bufsz = (sizeof(char) * (strlen(className) + (strlen(slotName) * 2) + 80)); buf = (char *) gm2(theEnv,bufsz); oldPWL = GetPrintWhileLoading(theEnv); SetPrintWhileLoading(theEnv,FALSE); oldCM = EnvSetConserveMemory(theEnv,TRUE); if (sd->createReadAccessor) { sprintf(buf,"%s get-%s () ?self:%s)",className,slotName,slotName); oldRouter = RouterData(theEnv)->FastCharGetRouter; oldString = RouterData(theEnv)->FastCharGetString; oldIndex = RouterData(theEnv)->FastCharGetIndex; RouterData(theEnv)->FastCharGetRouter = handlerRouter; RouterData(theEnv)->FastCharGetIndex = 0; RouterData(theEnv)->FastCharGetString = buf; ParseDefmessageHandler(theEnv,handlerRouter); DestroyPPBuffer(theEnv); /* if (OpenStringSource(theEnv,handlerRouter,buf,0)) { ParseDefmessageHandler(handlerRouter); DestroyPPBuffer(); CloseStringSource(theEnv,handlerRouter); } */ RouterData(theEnv)->FastCharGetRouter = oldRouter; RouterData(theEnv)->FastCharGetIndex = oldIndex; RouterData(theEnv)->FastCharGetString = oldString; } if (sd->createWriteAccessor) { sprintf(buf,"%s put-%s ($?value) (bind ?self:%s ?value))", className,slotName,slotName); oldRouter = RouterData(theEnv)->FastCharGetRouter; oldString = RouterData(theEnv)->FastCharGetString; oldIndex = RouterData(theEnv)->FastCharGetIndex; RouterData(theEnv)->FastCharGetRouter = handlerRouter; RouterData(theEnv)->FastCharGetIndex = 0; RouterData(theEnv)->FastCharGetString = buf; ParseDefmessageHandler(theEnv,handlerRouter); DestroyPPBuffer(theEnv); /* if (OpenStringSource(theEnv,handlerRouter,buf,0)) { ParseDefmessageHandler(handlerRouter); DestroyPPBuffer(); CloseStringSource(theEnv,handlerRouter); } */ RouterData(theEnv)->FastCharGetRouter = oldRouter; RouterData(theEnv)->FastCharGetIndex = oldIndex; RouterData(theEnv)->FastCharGetString = oldString; } SetPrintWhileLoading(theEnv,oldPWL); EnvSetConserveMemory(theEnv,oldCM); rm(theEnv,(void *) buf,bufsz); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************************** NAME : IsParameterSlotReference DESCRIPTION : Determines if a message-handler parameter is of the form ?self:, which is not allowed since this is slot reference syntax INPUTS : The paramter name RETURNS : TRUE if the parameter is a slot reference, FALSE otherwise SIDE EFFECTS : None NOTES : None *****************************************************************/ static intBool IsParameterSlotReference( void *theEnv, char *pname) { if ((strncmp(pname,SELF_STRING,SELF_LEN) == 0) ? (pname[SELF_LEN] == SELF_SLOT_REF) : FALSE) { PrintErrorID(theEnv,"MSGPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Illegal slot reference in parameter list.\n"); return(TRUE); } return(FALSE); } /**************************************************************************** NAME : SlotReferenceVar DESCRIPTION : Replaces direct slot references in handler body with special function calls to reference active instance at run-time The slot in in the class bound at parse-time is always referenced (early binding). Slot references of the form ?self: directly reference ProcParamArray[0] (the message object - ?self) to find the specified slot at run-time INPUTS : 1) Variable expression 2) The class of the handler being parsed RETURNS : 0 if not recognized, 1 if so, -1 on errors SIDE EFFECTS : Handler body SF_VARIABLE and MF_VARIABLE replaced with direct slot access function NOTES : Objects are allowed to directly access their own slots without sending a message to themselves. Since the object is "within the boundary of its internals", this does not violate the encapsulation principle of OOP. ****************************************************************************/ static int SlotReferenceVar( void *theEnv, EXPRESSION *varexp, void *userBuffer) { struct token itkn; int oldpp; SLOT_DESC *sd; if ((varexp->type != SF_VARIABLE) && (varexp->type != MF_VARIABLE)) return(0); if ((strncmp(ValueToString(varexp->value),SELF_STRING,SELF_LEN) == 0) ? (ValueToString(varexp->value)[SELF_LEN] == SELF_SLOT_REF) : FALSE) { OpenStringSource(theEnv,"hnd-var",ValueToString(varexp->value) + SELF_LEN + 1,0); oldpp = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,OFF); GetToken(theEnv,"hnd-var",&itkn); SetPPBufferStatus(theEnv,oldpp); CloseStringSource(theEnv,"hnd-var"); if (itkn.type != STOP) { sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value, FALSE,NULL); if (sd == NULL) return(-1); GenHandlerSlotReference(theEnv,varexp,HANDLER_GET,sd); return(1); } } return(0); } /**************************************************************************** NAME : BindSlotReference DESCRIPTION : Replaces direct slot binds in handler body with special function calls to reference active instance at run-time The slot in in the class bound at parse-time is always referenced (early binding). Slot references of the form ?self: directly reference ProcParamArray[0] (the message object - ?self) to find the specified slot at run-time INPUTS : 1) Variable expression 2) The class for the message-handler being parsed RETURNS : 0 if not recognized, 1 if so, -1 on errors SIDE EFFECTS : Handler body "bind" call replaced with direct slot access function NOTES : Objects are allowed to directly access their own slots without sending a message to themselves. Since the object is "within the boundary of its internals", this does not violate the encapsulation principle of OOP. ****************************************************************************/ static int BindSlotReference( void *theEnv, EXPRESSION *bindExp, void *userBuffer) { char *bindName; struct token itkn; int oldpp; SLOT_DESC *sd; EXPRESSION *saveExp; bindName = ValueToString(bindExp->argList->value); if (strcmp(bindName,SELF_STRING) == 0) { PrintErrorID(theEnv,"MSGPSR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Active instance parameter cannot be changed.\n"); return(-1); } if ((strncmp(bindName,SELF_STRING,SELF_LEN) == 0) ? (bindName[SELF_LEN] == SELF_SLOT_REF) : FALSE) { OpenStringSource(theEnv,"hnd-var",bindName + SELF_LEN + 1,0); oldpp = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,OFF); GetToken(theEnv,"hnd-var",&itkn); SetPPBufferStatus(theEnv,oldpp); CloseStringSource(theEnv,"hnd-var"); if (itkn.type != STOP) { saveExp = bindExp->argList->nextArg; sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value, TRUE,saveExp); if (sd == NULL) return(-1); GenHandlerSlotReference(theEnv,bindExp,HANDLER_PUT,sd); bindExp->argList->nextArg = NULL; ReturnExpression(theEnv,bindExp->argList); bindExp->argList = saveExp; return(1); } } return(0); } /********************************************************* NAME : CheckSlotReference DESCRIPTION : Examines a ?self: reference If the reference is a single-field or global variable, checking and evaluation is delayed until run-time. If the reference is a symbol, this routine verifies that the slot is a legal slot for the reference (i.e., it exists in the class to which the message-handler is being attached, it is visible and it is writable for write reference) INPUTS : 1) A buffer holding the class of the handler being parsed 2) The type of the slot reference 3) The value of the slot reference 4) A flag indicating if this is a read or write access 5) Value expression for write RETURNS : Class slot on success, NULL on errors SIDE EFFECTS : Messages printed on errors. NOTES : For static references, this function insures that the slot is either publicly visible or that the handler is being attached to the same class in which the private slot is defined. *********************************************************/ static SLOT_DESC *CheckSlotReference( void *theEnv, DEFCLASS *theDefclass, int theType, void *theValue, intBool writeFlag, EXPRESSION *writeExpression) { int slotIndex; SLOT_DESC *sd; int vCode; if (theType != SYMBOL) { PrintErrorID(theEnv,"MSGPSR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Illegal value for ?self reference.\n"); return(NULL); } slotIndex = FindInstanceTemplateSlot(theEnv,theDefclass,(SYMBOL_HN *) theValue); if (slotIndex == -1) { PrintErrorID(theEnv,"MSGPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"No such slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(theValue)); EnvPrintRouter(theEnv,WERROR," in class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) theDefclass)); EnvPrintRouter(theEnv,WERROR," for ?self reference.\n"); return(NULL); } sd = theDefclass->instanceTemplate[slotIndex]; if ((sd->publicVisibility == 0) && (sd->cls != theDefclass)) { SlotVisibilityViolationError(theEnv,sd,theDefclass); return(NULL); } if (! writeFlag) return(sd); /* ================================================= If a slot is initialize-only, the WithinInit flag still needs to be checked at run-time, for the handler could be called out of the context of an init. ================================================= */ if (sd->noWrite && (sd->initializeOnly == 0)) { SlotAccessViolationError(theEnv,ValueToString(theValue), FALSE,(void *) theDefclass); return(NULL); } if (EnvGetStaticConstraintChecking(theEnv)) { vCode = ConstraintCheckExpressionChain(theEnv,writeExpression,sd->constraint); if (vCode != NO_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expression for "); PrintSlot(theEnv,WERROR,sd,NULL,"direct slot write"); ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0, vCode,sd->constraint,FALSE); return(NULL); } } return(sd); } /*************************************************** NAME : GenHandlerSlotReference DESCRIPTION : Creates a bitmap of the class id and slot index for the get or put operation. The bitmap and operation type are stored in the given expression. INPUTS : 1) The expression 2) The operation type 3) The class slot RETURNS : Nothing useful SIDE EFFECTS : Bitmap created and expression initialized NOTES : None ***************************************************/ static void GenHandlerSlotReference( void *theEnv, EXPRESSION *theExp, unsigned short theType, SLOT_DESC *sd) { HANDLER_SLOT_REFERENCE handlerReference; ClearBitString(&handlerReference,sizeof(HANDLER_SLOT_REFERENCE)); handlerReference.classID = (unsigned short) sd->cls->id; handlerReference.slotID = (unsigned) sd->slotName->id; theExp->type = theType; theExp->value = AddBitMap(theEnv,(void *) &handlerReference, (int) sizeof(HANDLER_SLOT_REFERENCE)); } #endif /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips-6.24/clipssrc/._filecom.h0000400000175000017500000000075410441143503014522 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0z1s,,TTFS FMWBBMPSRclips-6.24/clipssrc/inspsr.c0000755000175000017500000005242010441147610014215 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* INSTANCE PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Instance Function Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include #include "classcom.h" #include "classfun.h" #include "classinf.h" #include "constant.h" #include "envrnmnt.h" #include "evaluatn.h" #include "exprnpsr.h" #include "extnfunc.h" #include "moduldef.h" #include "prntutil.h" #include "router.h" #define _INSPSR_SOURCE_ #include "inspsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MAKE_TYPE 0 #define INITIALIZE_TYPE 1 #define MODIFY_TYPE 2 #define DUPLICATE_TYPE 3 #define CLASS_RLN "of" #define DUPLICATE_NAME_REF "to" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool ReplaceClassNameWithReference(void *,EXPRESSION *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if ! RUN_TIME /************************************************************************************* NAME : ParseInitializeInstance DESCRIPTION : Parses initialize-instance and make-instance function calls into an EXPRESSION form that can later be evaluated with EvaluateExpression(theEnv,) INPUTS : 1) The address of the top node of the expression containing the initialize-instance function call 2) The logical name of the input source RETURNS : The address of the modified expression, or NULL if there is an error SIDE EFFECTS : The expression is enhanced to include all aspects of the initialize-instance call (slot-overrides etc.) The "top" expression is deleted on errors. NOTES : This function parses a initialize-instance call into an expression of the following form : (initialize-instance *) where ::= ( +) goes to --> initialize-instance | V ->->... | V ... (make-instance of *) goes to --> make-instance | V ->->->... | V ... (make-instance of *) goes to --> make-instance | V (gensym*)->->->... | V ... (modify-instance *) goes to --> modify-instance | V ->->... | V ... (duplicate-instance [to ] *) goes to --> duplicate-instance | V ->->->... OR | (gensym*) V ... *************************************************************************************/ globle EXPRESSION *ParseInitializeInstance( void *theEnv, EXPRESSION *top, char *readSource) { int error,fcalltype,readclass; if ((top->value == (void *) FindFunction(theEnv,"make-instance")) || (top->value == (void *) FindFunction(theEnv,"active-make-instance"))) fcalltype = MAKE_TYPE; else if ((top->value == (void *) FindFunction(theEnv,"initialize-instance")) || (top->value == (void *) FindFunction(theEnv,"active-initialize-instance"))) fcalltype = INITIALIZE_TYPE; else if ((top->value == (void *) FindFunction(theEnv,"modify-instance")) || (top->value == (void *) FindFunction(theEnv,"active-modify-instance")) || (top->value == (void *) FindFunction(theEnv,"message-modify-instance")) || (top->value == (void *) FindFunction(theEnv,"active-message-modify-instance"))) fcalltype = MODIFY_TYPE; else fcalltype = DUPLICATE_TYPE; IncrementIndentDepth(theEnv,3); error = FALSE; if (top->type == UNKNOWN_VALUE) top->type = FCALL; else SavePPBuffer(theEnv," "); top->argList = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; else if (top->argList == NULL) { SyntaxErrorMessage(theEnv,"instance"); goto ParseInitializeInstanceError; } SavePPBuffer(theEnv," "); if (fcalltype == MAKE_TYPE) { /* ====================================== Handle the case of anonymous instances where the name was not specified ====================================== */ if ((top->argList->type != SYMBOL) ? FALSE : (strcmp(ValueToString(top->argList->value),CLASS_RLN) == 0)) { top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error == TRUE) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance class"); goto ParseInitializeInstanceError; } if ((top->argList->nextArg->type != SYMBOL) ? TRUE : (strcmp(ValueToString(top->argList->nextArg->value),CLASS_RLN) != 0)) { top->argList->type = FCALL; top->argList->value = (void *) FindFunction(theEnv,"gensym*"); readclass = FALSE; } else readclass = TRUE; } else { GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0)) { SyntaxErrorMessage(theEnv,"make-instance"); goto ParseInitializeInstanceError; } SavePPBuffer(theEnv," "); readclass = TRUE; } if (readclass) { top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance class"); goto ParseInitializeInstanceError; } } /* ============================================== If the class name is a constant, go ahead and look it up now and replace it with the pointer ============================================== */ if (ReplaceClassNameWithReference(theEnv,top->argList->nextArg) == FALSE) goto ParseInitializeInstanceError; PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } else { PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (fcalltype == DUPLICATE_TYPE) { if ((DefclassData(theEnv)->ObjectParseToken.type != SYMBOL) ? FALSE : (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DUPLICATE_NAME_REF) == 0)) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance name"); goto ParseInitializeInstanceError; } PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } else top->argList->nextArg = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"gensym*")); top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } else top->argList->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } if (error) goto ParseInitializeInstanceError; if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"slot-override"); goto ParseInitializeInstanceError; } DecrementIndentDepth(theEnv,3); return(top); ParseInitializeInstanceError: SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,top); DecrementIndentDepth(theEnv,3); return(NULL); } /******************************************************************************** NAME : ParseSlotOverrides DESCRIPTION : Forms expressions for slot-overrides INPUTS : 1) The logical name of the input 2) Caller's buffer for error flkag RETURNS : Address override expressions, NULL if none or error. SIDE EFFECTS : Slot-expression built Caller's error flag set NOTES : ::= ( *)* goes to --> --> --> ... | V --> --> ... Assumes first token has already been scanned ********************************************************************************/ globle EXPRESSION *ParseSlotOverrides( void *theEnv, char *readSource, int *error) { EXPRESSION *top = NULL,*bot = NULL,*theExp; while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { *error = FALSE; theExp = ArgumentParse(theEnv,readSource,error); if (*error == TRUE) { ReturnExpression(theEnv,top); return(NULL); } else if (theExp == NULL) { SyntaxErrorMessage(theEnv,"slot-override"); *error = TRUE; ReturnExpression(theEnv,top); SetEvaluationError(theEnv,TRUE); return(NULL); } theExp->nextArg = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv)); if (CollectArguments(theEnv,theExp->nextArg,readSource) == NULL) { *error = TRUE; ReturnExpression(theEnv,top); return(NULL); } if (top == NULL) top = theExp; else bot->nextArg = theExp; bot = theExp->nextArg; PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); return(top); } #endif /**************************************************************************** NAME : ParseSimpleInstance DESCRIPTION : Parses instances from file for load-instances into an EXPRESSION forms that can later be evaluated with EvaluateExpression(theEnv,) INPUTS : 1) The address of the top node of the expression containing the make-instance function call 2) The logical name of the input source RETURNS : The address of the modified expression, or NULL if there is an error SIDE EFFECTS : The expression is enhanced to include all aspects of the make-instance call (slot-overrides etc.) The "top" expression is deleted on errors. NOTES : The name, class, values etc. must be constants. This function parses a make-instance call into an expression of the following form : (make-instance of *) where ::= ( +) goes to --> make-instance | V ->->->... | V ... ****************************************************************************/ globle EXPRESSION *ParseSimpleInstance( void *theEnv, EXPRESSION *top, char *readSource) { EXPRESSION *theExp,*vals = NULL,*vbot,*tval; unsigned short type; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != INSTANCE_NAME) && (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)) goto MakeInstanceError; if ((GetType(DefclassData(theEnv)->ObjectParseToken) == SYMBOL) && (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) == 0)) { top->argList = GenConstant(theEnv,FCALL, (void *) FindFunction(theEnv,"gensym*")); } else { top->argList = GenConstant(theEnv,INSTANCE_NAME, (void *) GetValue(DefclassData(theEnv)->ObjectParseToken)); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0)) goto MakeInstanceError; } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) goto MakeInstanceError; top->argList->nextArg = GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken)); theExp = top->argList->nextArg; if (ReplaceClassNameWithReference(theEnv,theExp) == FALSE) goto MakeInstanceError; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) goto SlotOverrideError; theExp->nextArg = GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken)); theExp->nextArg->nextArg = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv)); theExp = theExp->nextArg->nextArg; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); vbot = NULL; while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { type = GetType(DefclassData(theEnv)->ObjectParseToken); if (type == LPAREN) { GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (strcmp(ValueToString(DefclassData(theEnv)->ObjectParseToken.value),"create$") != 0)) goto SlotOverrideError; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) goto SlotOverrideError; tval = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$")); } else { if ((type != SYMBOL) && (type != STRING) && (type != FLOAT) && (type != INTEGER) && (type != INSTANCE_NAME)) goto SlotOverrideError; tval = GenConstant(theEnv,type,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken)); } if (vals == NULL) vals = tval; else vbot->nextArg = tval; vbot = tval; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } theExp->argList = vals; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); vals = NULL; } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) goto SlotOverrideError; return(top); MakeInstanceError: SyntaxErrorMessage(theEnv,"make-instance"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,top); return(NULL); SlotOverrideError: SyntaxErrorMessage(theEnv,"slot-override"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,top); ReturnExpression(theEnv,vals); return(NULL); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing a make instance call, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current nd imported modules for reference ***************************************************/ static intBool ReplaceClassNameWithReference( void *theEnv, EXPRESSION *theExp) { char *theClassName; void *theDefclass; if (theExp->type == SYMBOL) { theClassName = ValueToString(theExp->value); theDefclass = (void *) LookupDefclassInScope(theEnv,theClassName); if (theDefclass == NULL) { CantFindItemErrorMessage(theEnv,"class",theClassName); return(FALSE); } if (EnvClassAbstractP(theEnv,theDefclass)) { PrintErrorID(theEnv,"INSMNGR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class "); EnvPrintRouter(theEnv,WERROR,theClassName); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); } theExp->type = DEFCLASS_PTR; theExp->value = theDefclass; } return(TRUE); } #endif clips-6.24/clipssrc/dffctcmp.h0000755000175000017500000000266507422634717014516 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFFACTS CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_dffctcmp #define _H_dffctcmp #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DeffactsCompilerSetup(void *); LOCALE void DeffactsCModuleReference(void *,FILE *,int,int,int); #endif clips-6.24/clipssrc/._userfunctions.c0000400000175000017500000000075410443377372016025 0ustar jfsjfsMac OS X  2 RTEXTCWIETTFH Monaco,di,dinw a aTTFLrFMPSRMWBBLclips-6.24/clipssrc/prdctfun.c0000755000175000017500000006275510441150603014534 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* PREDICATE FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several predicate */ /* functions including not, and, or, eq, neq, <=, >=, <, */ /* >, =, <>, symbolp, stringp, lexemep, numberp, integerp, */ /* floatp, oddp, evenp, multifieldp, sequencep, and */ /* pointerp. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _PRDCTFUN_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "argacces.h" #include "multifld.h" #include "router.h" #include "prdctfun.h" /**************************************************/ /* PredicateFunctionDefinitions: Defines standard */ /* math and predicate functions. */ /**************************************************/ globle void PredicateFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"not", 'b', NotFunction, "NotFunction", "11"); EnvDefineFunction2(theEnv,"and", 'b', AndFunction, "AndFunction", "2*"); EnvDefineFunction2(theEnv,"or", 'b', OrFunction, "OrFunction", "2*"); EnvDefineFunction2(theEnv,"eq", 'b', EqFunction, "EqFunction", "2*"); EnvDefineFunction2(theEnv,"neq", 'b', NeqFunction, "NeqFunction", "2*"); EnvDefineFunction2(theEnv,"<=", 'b', LessThanOrEqualFunction, "LessThanOrEqualFunction", "2*n"); EnvDefineFunction2(theEnv,">=", 'b', GreaterThanOrEqualFunction, "GreaterThanOrEqualFunction", "2*n"); EnvDefineFunction2(theEnv,"<", 'b', LessThanFunction, "LessThanFunction", "2*n"); EnvDefineFunction2(theEnv,">", 'b', GreaterThanFunction, "GreaterThanFunction", "2*n"); EnvDefineFunction2(theEnv,"=", 'b', NumericEqualFunction, "NumericEqualFunction", "2*n"); EnvDefineFunction2(theEnv,"<>", 'b', NumericNotEqualFunction, "NumericNotEqualFunction", "2*n"); EnvDefineFunction2(theEnv,"!=", 'b', NumericNotEqualFunction, "NumericNotEqualFunction", "2*n"); EnvDefineFunction2(theEnv,"symbolp", 'b', SymbolpFunction, "SymbolpFunction", "11"); EnvDefineFunction2(theEnv,"wordp", 'b', SymbolpFunction, "SymbolpFunction", "11"); EnvDefineFunction2(theEnv,"stringp", 'b', StringpFunction, "StringpFunction", "11"); EnvDefineFunction2(theEnv,"lexemep", 'b', LexemepFunction, "LexemepFunction", "11"); EnvDefineFunction2(theEnv,"numberp", 'b', NumberpFunction, "NumberpFunction", "11"); EnvDefineFunction2(theEnv,"integerp", 'b', IntegerpFunction, "IntegerpFunction", "11"); EnvDefineFunction2(theEnv,"floatp", 'b', FloatpFunction, "FloatpFunction", "11"); EnvDefineFunction2(theEnv,"oddp", 'b', OddpFunction, "OddpFunction", "11i"); EnvDefineFunction2(theEnv,"evenp", 'b', EvenpFunction, "EvenpFunction", "11i"); EnvDefineFunction2(theEnv,"multifieldp",'b', MultifieldpFunction, "MultifieldpFunction", "11"); EnvDefineFunction2(theEnv,"sequencep",'b', MultifieldpFunction, "MultifieldpFunction", "11"); EnvDefineFunction2(theEnv,"pointerp", 'b', PointerpFunction, "PointerpFunction", "11"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /************************************/ /* EqFunction: H/L access routine */ /* for the eq function. */ /************************************/ globle intBool EqFunction( void *theEnv) { DATA_OBJECT item, nextItem; int numArgs, i; struct expr *theExpression; /*====================================*/ /* Determine the number of arguments. */ /*====================================*/ numArgs = EnvRtnArgCount(theEnv); if (numArgs == 0) return(FALSE); /*==============================================*/ /* Get the value of the first argument against */ /* which subsequent arguments will be compared. */ /*==============================================*/ theExpression = GetFirstArgument(); EvaluateExpression(theEnv,theExpression,&item); /*=====================================*/ /* Compare all arguments to the first. */ /* If any are the same, return FALSE. */ /*=====================================*/ theExpression = GetNextArgument(theExpression); for (i = 2 ; i <= numArgs ; i++) { EvaluateExpression(theEnv,theExpression,&nextItem); if (GetType(nextItem) != GetType(item)) { return(FALSE); } if (GetType(nextItem) == MULTIFIELD) { if (MultifieldDOsEqual(&nextItem,&item) == FALSE) { return(FALSE); } } else if (nextItem.value != item.value) { return(FALSE); } theExpression = GetNextArgument(theExpression); } /*=====================================*/ /* All of the arguments were different */ /* from the first. Return TRUE. */ /*=====================================*/ return(TRUE); } /*************************************/ /* NeqFunction: H/L access routine */ /* for the neq function. */ /*************************************/ globle intBool NeqFunction( void *theEnv) { DATA_OBJECT item, nextItem; int numArgs, i; struct expr *theExpression; /*====================================*/ /* Determine the number of arguments. */ /*====================================*/ numArgs = EnvRtnArgCount(theEnv); if (numArgs == 0) return(FALSE); /*==============================================*/ /* Get the value of the first argument against */ /* which subsequent arguments will be compared. */ /*==============================================*/ theExpression = GetFirstArgument(); EvaluateExpression(theEnv,theExpression,&item); /*=====================================*/ /* Compare all arguments to the first. */ /* If any are different, return FALSE. */ /*=====================================*/ for (i = 2, theExpression = GetNextArgument(theExpression); i <= numArgs; i++, theExpression = GetNextArgument(theExpression)) { EvaluateExpression(theEnv,theExpression,&nextItem); if (GetType(nextItem) != GetType(item)) { continue; } else if (nextItem.type == MULTIFIELD) { if (MultifieldDOsEqual(&nextItem,&item) == TRUE) { return(FALSE); } } else if (nextItem.value == item.value) { return(FALSE); } } /*=====================================*/ /* All of the arguments were identical */ /* to the first. Return TRUE. */ /*=====================================*/ return(TRUE); } /*****************************************/ /* StringpFunction: H/L access routine */ /* for the stringp function. */ /*****************************************/ globle intBool StringpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"stringp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) == STRING) { return(TRUE); } else { return(FALSE); } } /*****************************************/ /* SymbolpFunction: H/L access routine */ /* for the symbolp function. */ /*****************************************/ globle intBool SymbolpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"symbolp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) == SYMBOL) { return(TRUE); } else { return(FALSE); } } /*****************************************/ /* LexemepFunction: H/L access routine */ /* for the lexemep function. */ /*****************************************/ globle intBool LexemepFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"lexemep",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if ((GetType(item) == SYMBOL) || (GetType(item) == STRING)) { return(TRUE); } else { return(FALSE); } } /*****************************************/ /* NumberpFunction: H/L access routine */ /* for the numberp function. */ /*****************************************/ globle intBool NumberpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"numberp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if ((GetType(item) == FLOAT) || (GetType(item) == INTEGER)) { return(TRUE); } else { return(FALSE); } } /****************************************/ /* FloatpFunction: H/L access routine */ /* for the floatp function. */ /****************************************/ globle intBool FloatpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"floatp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) == FLOAT) { return(TRUE); } else { return(FALSE); } } /******************************************/ /* IntegerpFunction: H/L access routine */ /* for the integerp function. */ /******************************************/ globle intBool IntegerpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"integerp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) != INTEGER) return(FALSE); return(TRUE); } /*********************************************/ /* MultifieldpFunction: H/L access routine */ /* for the multifieldp function. */ /*********************************************/ globle intBool MultifieldpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"multifieldp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) != MULTIFIELD) return(FALSE); return(TRUE); } /******************************************/ /* PointerpFunction: H/L access routine */ /* for the pointerp function. */ /******************************************/ globle intBool PointerpFunction( void *theEnv) { DATA_OBJECT item; if (EnvArgCountCheck(theEnv,"pointerp",EXACTLY,1) == -1) return(FALSE); EnvRtnUnknown(theEnv,1,&item); if (GetType(item) != EXTERNAL_ADDRESS) return(FALSE); return(TRUE); } /*************************************/ /* NotFunction: H/L access routine */ /* for the not function. */ /*************************************/ globle intBool NotFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT result; theArgument = GetFirstArgument(); if (theArgument == NULL) { return(FALSE); } if (EvaluateExpression(theEnv,theArgument,&result)) return(FALSE); if ((result.value == EnvFalseSymbol(theEnv)) && (result.type == SYMBOL)) { return(TRUE); } return(FALSE); } /*************************************/ /* AndFunction: H/L access routine */ /* for the and function. */ /*************************************/ globle intBool AndFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT result; for (theArgument = GetFirstArgument(); theArgument != NULL; theArgument = GetNextArgument(theArgument)) { if (EvaluateExpression(theEnv,theArgument,&result)) return(FALSE); if ((result.value == EnvFalseSymbol(theEnv)) && (result.type == SYMBOL)) { return(FALSE); } } return(TRUE); } /************************************/ /* OrFunction: H/L access routine */ /* for the or function. */ /************************************/ globle intBool OrFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT result; for (theArgument = GetFirstArgument(); theArgument != NULL; theArgument = GetNextArgument(theArgument)) { if (EvaluateExpression(theEnv,theArgument,&result)) return(FALSE); if ((result.value != EnvFalseSymbol(theEnv)) || (result.type != SYMBOL)) { return(TRUE); } } return(FALSE); } /*****************************************/ /* LessThanOrEqualFunction: H/L access */ /* routine for the <= function. */ /*****************************************/ globle intBool LessThanOrEqualFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,"<=",&rv1,FALSE,pos)) return(FALSE); pos++; /*====================================================*/ /* Compare each of the subsequent arguments to its */ /* predecessor. If any is greater, then return FALSE. */ /*====================================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,"<=",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) > ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) > ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) > (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) > ValueToDouble(rv2.value)) { return(FALSE); } } } rv1.type = rv2.type; rv1.value = rv2.value; } /*======================================*/ /* Each argument was less than or equal */ /* to it predecessor. Return TRUE. */ /*======================================*/ return(TRUE); } /********************************************/ /* GreaterThanOrEqualFunction: H/L access */ /* routine for the >= function. */ /********************************************/ globle intBool GreaterThanOrEqualFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,">=",&rv1,FALSE,pos)) return(FALSE); pos++; /*===================================================*/ /* Compare each of the subsequent arguments to its */ /* predecessor. If any is lesser, then return FALSE. */ /*===================================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,">=",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) < ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) < ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) < (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) < ValueToDouble(rv2.value)) { return(FALSE); } } } rv1.type = rv2.type; rv1.value = rv2.value; } /*=========================================*/ /* Each argument was greater than or equal */ /* to its predecessor. Return TRUE. */ /*=========================================*/ return(TRUE); } /**********************************/ /* LessThanFunction: H/L access */ /* routine for the < function. */ /**********************************/ globle intBool LessThanFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,"<",&rv1,FALSE,pos)) return(FALSE); pos++; /*==========================================*/ /* Compare each of the subsequent arguments */ /* to its predecessor. If any is greater or */ /* equal, then return FALSE. */ /*==========================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,"<",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) >= ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) >= ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) >= (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) >= ValueToDouble(rv2.value)) { return(FALSE); } } } rv1.type = rv2.type; rv1.value = rv2.value; } /*=================================*/ /* Each argument was less than its */ /* predecessor. Return TRUE. */ /*=================================*/ return(TRUE); } /*************************************/ /* GreaterThanFunction: H/L access */ /* routine for the > function. */ /*************************************/ globle intBool GreaterThanFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,">",&rv1,FALSE,pos)) return(FALSE); pos++; /*==========================================*/ /* Compare each of the subsequent arguments */ /* to its predecessor. If any is lesser or */ /* equal, then return FALSE. */ /*==========================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,">",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) <= ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) <= ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) <= (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) <= ValueToDouble(rv2.value)) { return(FALSE); } } } rv1.type = rv2.type; rv1.value = rv2.value; } /*================================*/ /* Each argument was greater than */ /* its predecessor. Return TRUE. */ /*================================*/ return(TRUE); } /**************************************/ /* NumericEqualFunction: H/L access */ /* routine for the = function. */ /**************************************/ globle intBool NumericEqualFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,"=",&rv1,FALSE,pos)) return(FALSE); pos++; /*=================================================*/ /* Compare each of the subsequent arguments to the */ /* first. If any is unequal, then return FALSE. */ /*=================================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,"=",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) != ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) != ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) != (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) != ValueToDouble(rv2.value)) { return(FALSE); } } } } /*=================================*/ /* All arguments were equal to the */ /* first argument. Return TRUE. */ /*=================================*/ return(TRUE); } /*****************************************/ /* NumericNotEqualFunction: H/L access */ /* routine for the <> function. */ /*****************************************/ globle intBool NumericNotEqualFunction( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT rv1, rv2; int pos = 1; /*=========================*/ /* Get the first argument. */ /*=========================*/ theArgument = GetFirstArgument(); if (theArgument == NULL) { return(TRUE); } if (! GetNumericArgument(theEnv,theArgument,"<>",&rv1,FALSE,pos)) return(FALSE); pos++; /*=================================================*/ /* Compare each of the subsequent arguments to the */ /* first. If any is equal, then return FALSE. */ /*=================================================*/ for (theArgument = GetNextArgument(theArgument); theArgument != NULL; theArgument = GetNextArgument(theArgument), pos++) { if (! GetNumericArgument(theEnv,theArgument,"<>",&rv2,FALSE,pos)) return(FALSE); if (rv1.type == INTEGER) { if (rv2.type == INTEGER) { if (ValueToLong(rv1.value) == ValueToLong(rv2.value)) { return(FALSE); } } else { if ((double) ValueToLong(rv1.value) == ValueToDouble(rv2.value)) { return(FALSE); } } } else { if (rv2.type == INTEGER) { if (ValueToDouble(rv1.value) == (double) ValueToLong(rv2.value)) { return(FALSE); } } else { if (ValueToDouble(rv1.value) == ValueToDouble(rv2.value)) { return(FALSE); } } } } /*===================================*/ /* All arguments were unequal to the */ /* first argument. Return TRUE. */ /*===================================*/ return(TRUE); } /**************************************/ /* OddpFunction: H/L access routine */ /* for the oddp function. */ /**************************************/ globle intBool OddpFunction( void *theEnv) { DATA_OBJECT item; long num, halfnum; if (EnvArgCountCheck(theEnv,"oddp",EXACTLY,1) == -1) return(FALSE); if (EnvArgTypeCheck(theEnv,"oddp",1,INTEGER,&item) == FALSE) return(FALSE); num = DOToLong(item); halfnum = (num / 2) * 2; if (num == halfnum) return(FALSE); return(TRUE); } /***************************************/ /* EvenpFunction: H/L access routine */ /* for the evenp function. */ /***************************************/ globle intBool EvenpFunction( void *theEnv) { DATA_OBJECT item; long num, halfnum; if (EnvArgCountCheck(theEnv,"evenp",EXACTLY,1) == -1) return(FALSE); if (EnvArgTypeCheck(theEnv,"evenp",1,INTEGER,&item) == FALSE) return(FALSE); num = DOToLong(item); halfnum = (num / 2) * 2; if (num != halfnum) return(FALSE); return(TRUE); } clips-6.24/clipssrc/miscfun.h0000755000175000017500000000624410441150005014343 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* MISCELLANEOUS FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_miscfun #define _H_miscfun #ifdef LOCALE #undef LOCALE #endif #ifdef _MISCFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void MiscFunctionDefinitions(void *); LOCALE void CreateFunction(void *,DATA_OBJECT_PTR); LOCALE long int SetgenFunction(void *); LOCALE void *GensymFunction(void *); LOCALE void *GensymStarFunction(void *); LOCALE long RandomFunction(void *); LOCALE void SeedFunction(void *); LOCALE long int LengthFunction(void *); LOCALE void ConserveMemCommand(void *); LOCALE long int ReleaseMemCommand(void *); LOCALE long int MemUsedCommand(void *); LOCALE long int MemRequestsCommand(void *); LOCALE void OptionsCommand(void *); LOCALE void ExpandFuncCall(void *,DATA_OBJECT *); LOCALE void DummyExpandFuncMultifield(void *,DATA_OBJECT *); LOCALE void *CauseEvaluationError(void *); LOCALE intBool SetSORCommand(void *); LOCALE void *GetFunctionRestrictions(void *); LOCALE void AproposCommand(void *); LOCALE void *GensymStar(void *); LOCALE void GetFunctionListFunction(void *,DATA_OBJECT *); LOCALE void FuncallFunction(void *,DATA_OBJECT *); LOCALE double TimerFunction(void *); LOCALE double TimeFunction(void *); #endif clips-6.24/clipssrc/insmoddp.h0000755000175000017500000000503410441072624014522 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INSTANCE MODIFY AND DUPLICATE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /*************************************************************/ #ifndef _H_insmoddp #define _H_insmoddp #define DIRECT_MODIFY_STRING "direct-modify" #define MSG_MODIFY_STRING "message-modify" #define DIRECT_DUPLICATE_STRING "direct-duplicate" #define MSG_DUPLICATE_STRING "message-duplicate" #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSMODDP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if (! RUN_TIME) LOCALE void SetupInstanceModDupCommands(void *); #endif LOCALE void ModifyInstance(void *,DATA_OBJECT *); LOCALE void MsgModifyInstance(void *,DATA_OBJECT *); LOCALE void DuplicateInstance(void *,DATA_OBJECT *); LOCALE void MsgDuplicateInstance(void *,DATA_OBJECT *); #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM LOCALE void InactiveModifyInstance(void *,DATA_OBJECT *); LOCALE void InactiveMsgModifyInstance(void *,DATA_OBJECT *); LOCALE void InactiveDuplicateInstance(void *,DATA_OBJECT *); LOCALE void InactiveMsgDuplicateInstance(void *,DATA_OBJECT *); #endif LOCALE void DirectModifyMsgHandler(void *,DATA_OBJECT *); LOCALE void MsgModifyMsgHandler(void *,DATA_OBJECT *); LOCALE void DirectDuplicateMsgHandler(void *,DATA_OBJECT *); LOCALE void MsgDuplicateMsgHandler(void *,DATA_OBJECT *); #ifndef _INSMODDP_SOURCE_ #endif #endif clips-6.24/clipssrc/._inherpsr.c0000400000175000017500000000075407422634713014746 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zpTTF:rFMWBBMPSRclips-6.24/clipssrc/pattern.c0000755000175000017500000011754210441150460014360 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* RULE PATTERN MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the mechanism for recognizing and */ /* parsing the various types of patterns that can be used */ /* in the LHS of a rule. In version 6.0, the only pattern */ /* types provided are for deftemplate and instance */ /* patterns. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _PATTERN_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #if DEFRULE_CONSTRUCT #include "constant.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnutl.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "match.h" #include "memalloc.h" #include "reteutil.h" #include "router.h" #include "rulecmp.h" #include "pattern.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct lhsParseNode *ConjuctiveRestrictionParse(void *,char *,struct token *,int *); static struct lhsParseNode *LiteralRestrictionParse(void *,char *,struct token *,int *); static int CheckForVariableMixing(void *,struct lhsParseNode *); static void TallyFieldTypes(struct lhsParseNode *); #endif static void DeallocatePatternData(void *); /*****************************************************************************/ /* InitializePatterns: Initializes the global data associated with patterns. */ /*****************************************************************************/ globle void InitializePatterns( void *theEnv) { AllocateEnvironmentData(theEnv,PATTERN_DATA,sizeof(struct patternData),DeallocatePatternData); } /**************************************************/ /* DeallocatePatternData: Deallocates environment */ /* data for rule pattern registration. */ /**************************************************/ static void DeallocatePatternData( void *theEnv) { struct reservedSymbol *tmpRSPtr, *nextRSPtr; struct patternParser *tmpPPPtr, *nextPPPtr; tmpRSPtr = PatternData(theEnv)->ListOfReservedPatternSymbols; while (tmpRSPtr != NULL) { nextRSPtr = tmpRSPtr->next; rtn_struct(theEnv,reservedSymbol,tmpRSPtr); tmpRSPtr = nextRSPtr; } tmpPPPtr = PatternData(theEnv)->ListOfPatternParsers; while (tmpPPPtr != NULL) { nextPPPtr = tmpPPPtr->next; rtn_struct(theEnv,patternParser,tmpPPPtr); tmpPPPtr = nextPPPtr; } } /******************************************************************/ /* AddReservedPatternSymbol: Adds a symbol to the list of symbols */ /* that are restricted for use in patterns. For example, the */ /* deftemplate construct cannot use the symbol "object", since */ /* this needs to be reserved for object patterns. Some symbols, */ /* such as "exists" are completely reserved and can not be used */ /* to start any type of pattern CE. */ /******************************************************************/ void AddReservedPatternSymbol( void *theEnv, char *theSymbol, char *reservedBy) { struct reservedSymbol *newSymbol; newSymbol = get_struct(theEnv,reservedSymbol); newSymbol->theSymbol = theSymbol; newSymbol->reservedBy = reservedBy; newSymbol->next = PatternData(theEnv)->ListOfReservedPatternSymbols; PatternData(theEnv)->ListOfReservedPatternSymbols = newSymbol; } /******************************************************************/ /* ReservedPatternSymbol: Returns TRUE if the specified symbol is */ /* a reserved pattern symbol, otherwise FALSE is returned. If */ /* the construct which is trying to use the symbol is the same */ /* construct that reserved the symbol, then FALSE is returned. */ /******************************************************************/ intBool ReservedPatternSymbol( void *theEnv, char *theSymbol, char *checkedBy) { struct reservedSymbol *currentSymbol; for (currentSymbol = PatternData(theEnv)->ListOfReservedPatternSymbols; currentSymbol != NULL; currentSymbol = currentSymbol->next) { if (strcmp(theSymbol,currentSymbol->theSymbol) == 0) { if ((currentSymbol->reservedBy == NULL) || (checkedBy == NULL)) { return(TRUE); } if (strcmp(checkedBy,currentSymbol->reservedBy) == 0) return(FALSE); return(TRUE); } } return(FALSE); } /********************************************************/ /* ReservedPatternSymbolErrorMsg: Generic error message */ /* for attempting to use a reserved pattern symbol. */ /********************************************************/ void ReservedPatternSymbolErrorMsg( void *theEnv, char *theSymbol, char *usedFor) { PrintErrorID(theEnv,"PATTERN",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The symbol "); EnvPrintRouter(theEnv,WERROR,theSymbol); EnvPrintRouter(theEnv,WERROR," has special meaning\n"); EnvPrintRouter(theEnv,WERROR,"and may not be used as "); EnvPrintRouter(theEnv,WERROR,usedFor); EnvPrintRouter(theEnv,WERROR,".\n"); } /************************************************************/ /* GetNextEntity: Utility routine for accessing all of the */ /* data entities that can match patterns. Currently facts */ /* and instances are the only data entities available. */ /************************************************************/ globle void GetNextPatternEntity( void *theEnv, struct patternParser **theParser, struct patternEntity **theEntity) { /*=============================================================*/ /* If the current parser is NULL, then we want to retrieve the */ /* very first data entity. The traversal of entities is done */ /* by entity type (e.g. all facts are traversed followed by */ /* all instances). To get the first entity type to traverse, */ /* the current parser is set to the first parser on the list */ /* of pattern parsers. */ /*=============================================================*/ if (*theParser == NULL) { *theParser = PatternData(theEnv)->ListOfPatternParsers; *theEntity = NULL; } /*================================================================*/ /* Otherwise try to retrieve the next entity following the entity */ /* returned by the last call to GetNextEntity. If that entity was */ /* the last of its data type, then move on to the next pattern */ /* parser, otherwise return that entity as the next one. */ /*================================================================*/ else if (theEntity != NULL) { *theEntity = (struct patternEntity *) (*(*theParser)->entityType->base.getNextFunction)(theEnv,*theEntity); if ((*theEntity) != NULL) return; *theParser = (*theParser)->next; } /*===============================================================*/ /* Otherwise, we encountered a situation which should not occur. */ /* Once a NULL entity is returned from GetNextEntity, it should */ /* not be passed back to GetNextEntity. */ /*===============================================================*/ else { SystemError(theEnv,"PATTERN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*================================================*/ /* Keep looping through the lists of entities and */ /* pattern parsers until an entity is found. */ /*================================================*/ while ((*theEntity == NULL) && (*theParser != NULL)) { *theEntity = (struct patternEntity *) (*(*theParser)->entityType->base.getNextFunction)(theEnv,*theEntity); if (*theEntity != NULL) return; *theParser = (*theParser)->next; } return; } /**************************************************************/ /* DetachPattern: Detaches a pattern from the pattern network */ /* by calling the appropriate function for the data type */ /* associated with the pattern. */ /**************************************************************/ void DetachPattern( void *theEnv, int rhsType, struct patternNodeHeader *theHeader) { if (PatternData(theEnv)->PatternParserArray[rhsType] != NULL) { FlushAlphaBetaMemory(theEnv,theHeader->alphaMemory); (*PatternData(theEnv)->PatternParserArray[rhsType]->removePatternFunction)(theEnv,theHeader); } } /**************************************************/ /* AddPatternParser: Adds a pattern type to the */ /* list of pattern parsers used to detect valid */ /* patterns in the LHS of a rule. */ /**************************************************/ globle intBool AddPatternParser( void *theEnv, struct patternParser *newPtr) { struct patternParser *currentPtr, *lastPtr = NULL; /*============================================*/ /* Check to see that the limit for the number */ /* of pattern parsers has not been exceeded. */ /*============================================*/ if (PatternData(theEnv)->NextPosition >= MAX_POSITIONS) return(FALSE); /*================================*/ /* Create the new pattern parser. */ /*================================*/ newPtr->positionInArray = PatternData(theEnv)->NextPosition; PatternData(theEnv)->PatternParserArray[PatternData(theEnv)->NextPosition] = newPtr; PatternData(theEnv)->NextPosition++; /*================================*/ /* Add the parser to the list of */ /* parsers based on its priority. */ /*================================*/ if (PatternData(theEnv)->ListOfPatternParsers == NULL) { newPtr->next = NULL; PatternData(theEnv)->ListOfPatternParsers = newPtr; return(TRUE); } currentPtr = PatternData(theEnv)->ListOfPatternParsers; while ((currentPtr != NULL) ? (newPtr->priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = PatternData(theEnv)->ListOfPatternParsers; PatternData(theEnv)->ListOfPatternParsers = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(TRUE); } /****************************************************/ /* FindPatternParser: Searches for a pattern parser */ /* that can parse a pattern beginning with the */ /* specified keyword (e.g. "object"). */ /****************************************************/ globle struct patternParser *FindPatternParser( void *theEnv, char *name) { struct patternParser *tempParser; for (tempParser = PatternData(theEnv)->ListOfPatternParsers; tempParser != NULL; tempParser = tempParser->next) { if (strcmp(tempParser->name,name) == 0) return(tempParser); } return(NULL); } /******************************************************/ /* GetPatternParser: Returns a pointer to the pattern */ /* parser for the specified data entity. */ /******************************************************/ struct patternParser *GetPatternParser( void *theEnv, int rhsType) { return(PatternData(theEnv)->PatternParserArray[rhsType]); } #if CONSTRUCT_COMPILER && (! RUN_TIME) /*************************************************************/ /* PatternNodeHeaderToCode: Writes the C code representation */ /* of a patternNodeHeader data structure. */ /*************************************************************/ globle void PatternNodeHeaderToCode( void *theEnv, FILE *fp, struct patternNodeHeader *theHeader, int imageID, int maxIndices) { fprintf(fp,"{NULL,NULL,"); if (theHeader->entryJoin == NULL) { fprintf(fp,"NULL,"); } else { fprintf(fp,"&%s%d_%d[%d],", JoinPrefix(),imageID, (((int) theHeader->entryJoin->bsaveID) / maxIndices) + 1, ((int) theHeader->entryJoin->bsaveID) % maxIndices); } fprintf(fp,"%d,%d,%d,0,0,%d,%d}",theHeader->singlefieldNode, theHeader->multifieldNode, theHeader->stopNode, theHeader->beginSlot, theHeader->endSlot); } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ #if (! RUN_TIME) && (! BLOAD_ONLY) /****************************************************************/ /* PostPatternAnalysis: Calls the post analysis routines for */ /* each of the pattern parsers to allow additional processing */ /* by the pattern parser after the variable analysis routines */ /* have analyzed the LHS patterns. */ /****************************************************************/ globle intBool PostPatternAnalysis( void *theEnv, struct lhsParseNode *theLHS) { struct lhsParseNode *patternPtr; struct patternParser *tempParser; for (patternPtr = theLHS; patternPtr != NULL; patternPtr = patternPtr->bottom) { if ((patternPtr->type == PATTERN_CE) && (patternPtr->patternType != NULL)) { tempParser = patternPtr->patternType; if (tempParser->postAnalysisFunction != NULL) { if ((*tempParser->postAnalysisFunction)(theEnv,patternPtr)) return(TRUE); } } } return(FALSE); } /******************************************************************/ /* RestrictionParse: Parses a single field within a pattern. This */ /* field may either be a single field wildcard, a multifield */ /* wildcard, a single field variable, a multifield variable, */ /* or a series of connected constraints. */ /* */ /* ::= ? | */ /* $? | */ /* */ /******************************************************************/ struct lhsParseNode *RestrictionParse( void *theEnv, char *readSource, struct token *theToken, int multifieldSlot, struct symbolHashNode *theSlot, short slotNumber, CONSTRAINT_RECORD *theConstraints, short position) { struct lhsParseNode *topNode = NULL, *lastNode = NULL, *nextNode; int numberOfSingleFields = 0; int numberOfMultifields = 0; short startPosition = position; int error = FALSE; CONSTRAINT_RECORD *tempConstraints; /*==================================================*/ /* Keep parsing fields until a right parenthesis is */ /* encountered. This will either indicate the end */ /* of an instance or deftemplate slot or the end of */ /* an ordered fact. */ /*==================================================*/ while (theToken->type != RPAREN) { /*========================================*/ /* Look for either a single or multifield */ /* wildcard or a conjuctive restriction. */ /*========================================*/ if ((theToken->type == SF_WILDCARD) || (theToken->type == MF_WILDCARD)) { nextNode = GetLHSParseNode(theEnv); nextNode->type = theToken->type; nextNode->negated = FALSE; GetToken(theEnv,readSource,theToken); } else { nextNode = ConjuctiveRestrictionParse(theEnv,readSource,theToken,&error); if (nextNode == NULL) { ReturnLHSParseNodes(theEnv,topNode); return(NULL); } } /*========================================================*/ /* Fix up the pretty print representation of a multifield */ /* slot so that the fields don't run together. */ /*========================================================*/ if ((theToken->type != RPAREN) && (multifieldSlot == TRUE)) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); } /*========================================*/ /* Keep track of the number of single and */ /* multifield restrictions encountered. */ /*========================================*/ if ((nextNode->type == SF_WILDCARD) || (nextNode->type == SF_VARIABLE)) { numberOfSingleFields++; } else { numberOfMultifields++; } /*===================================*/ /* Assign the slot name and indices. */ /*===================================*/ nextNode->slot = theSlot; nextNode->slotNumber = slotNumber; nextNode->index = position++; /*==============================================*/ /* If we're not dealing with a multifield slot, */ /* attach the constraints directly to the node */ /* and return. */ /*==============================================*/ if (! multifieldSlot) { if (theConstraints == NULL) { if (nextNode->type == SF_VARIABLE) { nextNode->constraints = GetConstraintRecord(theEnv); } else nextNode->constraints = NULL; } else nextNode->constraints = theConstraints; return(nextNode); } /*====================================================*/ /* Attach the restriction to the list of restrictions */ /* already parsed for this slot or ordered fact. */ /*====================================================*/ if (lastNode == NULL) topNode = nextNode; else lastNode->right = nextNode; lastNode = nextNode; } /*=====================================================*/ /* Once we're through parsing, check to make sure that */ /* a single field slot was given a restriction. If the */ /* following test fails, then we know we're dealing */ /* with a multifield slot. */ /*=====================================================*/ if ((topNode == NULL) && (! multifieldSlot)) { SyntaxErrorMessage(theEnv,"defrule"); return(NULL); } /*===============================================*/ /* Loop through each of the restrictions in the */ /* list of restrictions for the multifield slot. */ /*===============================================*/ for (nextNode = topNode; nextNode != NULL; nextNode = nextNode->right) { /*===================================================*/ /* Assign a constraint record to each constraint. If */ /* the slot has an explicit constraint, then copy */ /* this and store it with the constraint. Otherwise, */ /* create a constraint record for a single field */ /* constraint and skip the constraint modifications */ /* for a multifield constraint. */ /*===================================================*/ if (theConstraints == NULL) { if (nextNode->type == SF_VARIABLE) { nextNode->constraints = GetConstraintRecord(theEnv); } else { continue; } } else { nextNode->constraints = CopyConstraintRecord(theEnv,theConstraints); } /*==========================================*/ /* Remove the min and max field constraints */ /* for the entire slot from the constraint */ /* record for this single constraint. */ /*==========================================*/ ReturnExpression(theEnv,nextNode->constraints->minFields); ReturnExpression(theEnv,nextNode->constraints->maxFields); nextNode->constraints->minFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->NegativeInfinity); nextNode->constraints->maxFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity); nextNode->derivedConstraints = TRUE; /*====================================================*/ /* If we're not dealing with a multifield constraint, */ /* then no further modifications are needed to the */ /* min and max constraints for this constraint. */ /*====================================================*/ if ((nextNode->type != MF_WILDCARD) && (nextNode->type != MF_VARIABLE)) { continue; } /*==========================================================*/ /* Create a separate constraint record to keep track of the */ /* cardinality information for this multifield constraint. */ /*==========================================================*/ tempConstraints = GetConstraintRecord(theEnv); SetConstraintType(MULTIFIELD,tempConstraints); tempConstraints->singlefieldsAllowed = FALSE; tempConstraints->multifield = nextNode->constraints; nextNode->constraints = tempConstraints; /*=====================================================*/ /* Adjust the min and max field values for this single */ /* multifield constraint based on the min and max */ /* fields for the entire slot and the number of single */ /* field values contained in the slot. */ /*=====================================================*/ if (theConstraints->maxFields->value != SymbolData(theEnv)->PositiveInfinity) { ReturnExpression(theEnv,tempConstraints->maxFields); tempConstraints->maxFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,ValueToLong(theConstraints->maxFields->value) - numberOfSingleFields)); } if ((numberOfMultifields == 1) && (theConstraints->minFields->value != SymbolData(theEnv)->NegativeInfinity)) { ReturnExpression(theEnv,tempConstraints->minFields); tempConstraints->minFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,ValueToLong(theConstraints->minFields->value) - numberOfSingleFields)); } } /*================================================*/ /* If a multifield slot is being parsed, place a */ /* node on top of the list of constraints parsed. */ /*================================================*/ if (multifieldSlot) { nextNode = GetLHSParseNode(theEnv); nextNode->type = MF_WILDCARD; nextNode->multifieldSlot = TRUE; nextNode->bottom = topNode; nextNode->slot = theSlot; nextNode->slotNumber = slotNumber; nextNode->index = startPosition; nextNode->constraints = theConstraints; topNode = nextNode; TallyFieldTypes(topNode->bottom); } /*=================================*/ /* Return the list of constraints. */ /*=================================*/ return(topNode); } /***************************************************************/ /* TallyFieldTypes: Determines the number of single field and */ /* multifield variables and wildcards that appear before and */ /* after each restriction found in a multifield slot. */ /***************************************************************/ static void TallyFieldTypes( struct lhsParseNode *theRestrictions) { struct lhsParseNode *tempNode1, *tempNode2, *tempNode3; unsigned short totalSingleFields = 0, totalMultiFields = 0; unsigned short runningSingleFields = 0, runningMultiFields = 0; /*========================================*/ /* Compute the total number of single and */ /* multifield variables and wildcards. */ /*========================================*/ for (tempNode1 = theRestrictions; tempNode1 != NULL; tempNode1 = tempNode1->right) { if ((tempNode1->type == SF_VARIABLE) || (tempNode1->type == SF_WILDCARD)) { totalSingleFields++; } else { totalMultiFields++; } } /*======================================================*/ /* Loop through each constraint tallying the numbers of */ /* the variable types before and after along the way. */ /*======================================================*/ for (tempNode1 = theRestrictions; tempNode1 != NULL; tempNode1 = tempNode1->right) { /*===================================*/ /* Assign the values to the "binding */ /* variable" node of the constraint. */ /*===================================*/ tempNode1->singleFieldsBefore = runningSingleFields; tempNode1->multiFieldsBefore = runningMultiFields; tempNode1->withinMultifieldSlot = TRUE; if ((tempNode1->type == SF_VARIABLE) || (tempNode1->type == SF_WILDCARD)) { tempNode1->singleFieldsAfter = (unsigned short) (totalSingleFields - (runningSingleFields + 1)); tempNode1->multiFieldsAfter = (unsigned short) (totalMultiFields - runningMultiFields); } else { tempNode1->singleFieldsAfter = (unsigned short) (totalSingleFields - runningSingleFields); tempNode1->multiFieldsAfter = (unsigned short) (totalMultiFields - (runningMultiFields + 1)); } /*=====================================================*/ /* Assign the values to each of the and (&) and or (|) */ /* connected constraints within the constraint. */ /*=====================================================*/ for (tempNode2 = tempNode1->bottom; tempNode2 != NULL; tempNode2 = tempNode2->bottom) { for (tempNode3 = tempNode2; tempNode3 != NULL; tempNode3 = tempNode3->right) { tempNode3->singleFieldsBefore = tempNode1->singleFieldsBefore; tempNode3->singleFieldsAfter = tempNode1->singleFieldsAfter; tempNode3->multiFieldsBefore = tempNode1->multiFieldsBefore; tempNode3->multiFieldsAfter = tempNode1->multiFieldsAfter; tempNode3->withinMultifieldSlot = TRUE; } } /*=======================================*/ /* Calculate the running total of single */ /* and multifield constraints. */ /*=======================================*/ if ((tempNode1->type == SF_VARIABLE) || (tempNode1->type == SF_WILDCARD)) { runningSingleFields++; } else { runningMultiFields++; } } } /*******************************************************************/ /* ConjuctiveRestrictionParse: Parses a single constraint field in */ /* a pattern that is not a single field wildcard, multifield */ /* wildcard, or multifield variable. The field may consist of a */ /* number of subfields tied together using the & connective */ /* constraint and/or the | connective constraint. */ /* */ /* */ /* ::= | */ /* & | */ /* | */ /*******************************************************************/ static struct lhsParseNode *ConjuctiveRestrictionParse( void *theEnv, char *readSource, struct token *theToken, int *error) { struct lhsParseNode *bindNode; struct lhsParseNode *theNode, *nextOr, *nextAnd; int connectorType; /*=====================================*/ /* Get the first node and determine if */ /* it is a binding variable. */ /*=====================================*/ theNode = LiteralRestrictionParse(theEnv,readSource,theToken,error); if (*error == TRUE) { return(NULL); } GetToken(theEnv,readSource,theToken); if (((theNode->type == SF_VARIABLE) || (theNode->type == MF_VARIABLE)) && (theNode->negated == FALSE) && (theToken->type != OR_CONSTRAINT)) { theNode->bindingVariable = TRUE; bindNode = theNode; nextOr = NULL; nextAnd = NULL; } else { bindNode = GetLHSParseNode(theEnv); if (theNode->type == MF_VARIABLE) bindNode->type = MF_WILDCARD; else bindNode->type = SF_WILDCARD; bindNode->negated = FALSE; bindNode->bottom = theNode; nextOr = theNode; nextAnd = theNode; } /*===================================*/ /* Process the connected constraints */ /* within the constraint */ /*===================================*/ while ((theToken->type == OR_CONSTRAINT) || (theToken->type == AND_CONSTRAINT)) { /*==========================*/ /* Get the next constraint. */ /*==========================*/ connectorType = theToken->type; GetToken(theEnv,readSource,theToken); theNode = LiteralRestrictionParse(theEnv,readSource,theToken,error); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,bindNode); return(NULL); } /*=======================================*/ /* Attach the new constraint to the list */ /* of constraints for this field. */ /*=======================================*/ if (connectorType == OR_CONSTRAINT) { if (nextOr == NULL) { bindNode->bottom = theNode; } else { nextOr->bottom = theNode; } nextOr = theNode; nextAnd = theNode; } else if (connectorType == AND_CONSTRAINT) { if (nextAnd == NULL) { bindNode->bottom = theNode; nextOr = theNode; } else { nextAnd->right = theNode; } nextAnd = theNode; } else { SystemError(theEnv,"RULEPSR",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*==================================================*/ /* Determine if any more restrictions are connected */ /* to the current list of restrictions. */ /*==================================================*/ GetToken(theEnv,readSource,theToken); } /*==========================================*/ /* Check for illegal mixing of single and */ /* multifield values within the constraint. */ /*==========================================*/ if (CheckForVariableMixing(theEnv,bindNode)) { *error = TRUE; ReturnLHSParseNodes(theEnv,bindNode); return(NULL); } /*========================*/ /* Return the constraint. */ /*========================*/ return(bindNode); } /*****************************************************/ /* CheckForVariableMixing: Checks a field constraint */ /* to determine if single and multifield variables */ /* are illegally mixed within it. */ /*****************************************************/ static int CheckForVariableMixing( void *theEnv, struct lhsParseNode *theRestriction) { struct lhsParseNode *tempRestriction; CONSTRAINT_RECORD *theConstraint; int multifield = FALSE; int singlefield = FALSE; int constant = FALSE; int singleReturnValue = FALSE; int multiReturnValue = FALSE; /*================================================*/ /* If the constraint contains a binding variable, */ /* determine whether it is a single field or */ /* multifield variable. */ /*================================================*/ if (theRestriction->type == SF_VARIABLE) singlefield = TRUE; else if (theRestriction->type == MF_VARIABLE) multifield = TRUE; /*===========================================*/ /* Loop through each of the or (|) connected */ /* constraints within the constraint. */ /*===========================================*/ for (theRestriction = theRestriction->bottom; theRestriction != NULL; theRestriction = theRestriction->bottom) { /*============================================*/ /* Loop through each of the and (&) connected */ /* constraints within the or (|) constraint. */ /*============================================*/ for (tempRestriction = theRestriction; tempRestriction != NULL; tempRestriction = tempRestriction->right) { /*=====================================================*/ /* Determine if the constraint contains a single field */ /* variable, multifield variable, constant (a single */ /* field), a return value constraint of a function */ /* returning a single field value, or a return value */ /* constraint of a function returning a multifield */ /* value. */ /*=====================================================*/ if (tempRestriction->type == SF_VARIABLE) singlefield = TRUE; else if (tempRestriction->type == MF_VARIABLE) multifield = TRUE; else if (ConstantType(tempRestriction->type)) constant = TRUE; else if (tempRestriction->type == RETURN_VALUE_CONSTRAINT) { theConstraint = FunctionCallToConstraintRecord(theEnv,tempRestriction->expression->value); if (theConstraint->anyAllowed) { /* Do nothing. */ } else if (theConstraint->multifieldsAllowed) multiReturnValue = TRUE; else singleReturnValue = TRUE; RemoveConstraint(theEnv,theConstraint); } } } /*================================================================*/ /* Using a single field value (a single field variable, constant, */ /* or function returning a single field value) together with a */ /* multifield value (a multifield variable or function returning */ /* a multifield value) is illegal. Return TRUE if this occurs. */ /*================================================================*/ if ((singlefield || constant || singleReturnValue) && (multifield || multiReturnValue)) { PrintErrorID(theEnv,"PATTERN",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Single and multifield constraints cannot be mixed in a field constraint\n"); return(TRUE); } /*=======================================*/ /* Otherwise return FALSE to indicate no */ /* illegal variable mixing was detected. */ /*=======================================*/ return(FALSE); } /***********************************************************/ /* LiteralRestrictionParse: Parses a single constraint. */ /* The constraint may be a literal constraint, a */ /* predicate constraint, a return value constraint, or a */ /* variable constraint. The constraints may also be */ /* negated using the ~ connective constraint. */ /* */ /* ::= | ~ */ /* */ /* ::= | */ /* | */ /* | */ /* : | */ /* = */ /***********************************************************/ static struct lhsParseNode *LiteralRestrictionParse( void *theEnv, char *readSource, struct token *theToken, int *error) { struct lhsParseNode *topNode; struct expr *theExpression; /*============================================*/ /* Create a node to represent the constraint. */ /*============================================*/ topNode = GetLHSParseNode(theEnv); /*=================================================*/ /* Determine if the constraint has a '~' preceding */ /* it. If it does, then the field is negated */ /* (e.g. ~red means "not the constant red." */ /*=================================================*/ if (theToken->type == NOT_CONSTRAINT) { GetToken(theEnv,readSource,theToken); topNode->negated = TRUE; } else { topNode->negated = FALSE; } /*===========================================*/ /* Determine if the constraint is one of the */ /* recognized types. These are ?variables, */ /* symbols, strings, numbers, :(expression), */ /* and =(expression). */ /*===========================================*/ topNode->type = theToken->type; /*============================================*/ /* Any symbol is valid, but an = signifies a */ /* return value constraint and an : signifies */ /* a predicate constraint. */ /*============================================*/ if (theToken->type == SYMBOL) { /*==============================*/ /* If the symbol is an =, parse */ /* a return value constraint. */ /*==============================*/ if (strcmp(ValueToString(theToken->value),"=") == 0) { theExpression = Function0Parse(theEnv,readSource); if (theExpression == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } topNode->type = RETURN_VALUE_CONSTRAINT; topNode->expression = ExpressionToLHSParseNodes(theEnv,theExpression); ReturnExpression(theEnv,theExpression); } /*=============================*/ /* If the symbol is a :, parse */ /* a predicate constraint. */ /*=============================*/ else if (strcmp(ValueToString(theToken->value),":") == 0) { theExpression = Function0Parse(theEnv,readSource); if (theExpression == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } topNode->type = PREDICATE_CONSTRAINT; topNode->expression = ExpressionToLHSParseNodes(theEnv,theExpression); ReturnExpression(theEnv,theExpression); } /*==============================================*/ /* Otherwise, treat the constraint as a symbol. */ /*==============================================*/ else { topNode->value = theToken->value; } } /*=====================================================*/ /* Single and multifield variables and float, integer, */ /* string, and instance name constants are also valid. */ /*=====================================================*/ else if ((theToken->type == SF_VARIABLE) || (theToken->type == MF_VARIABLE) || (theToken->type == FLOAT) || (theToken->type == INTEGER) || (theToken->type == STRING) || (theToken->type == INSTANCE_NAME)) { topNode->value = theToken->value; } /*===========================*/ /* Anything else is invalid. */ /*===========================*/ else { SyntaxErrorMessage(theEnv,"defrule"); *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } /*===============================*/ /* Return the parsed constraint. */ /*===============================*/ return(topNode); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._rulepsr.c0000400000175000017500000000075410441073232014574 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco]*]*k)AA=TTFSFMPSRMWBBLclips-6.24/clipssrc/._factqpsr.h0000400000175000017500000000075410171555005014733 0ustar jfsjfsMac OS X  2 RTEXTCWIETTFH MonacoP6(P6( 6%TTFUBD#bFMWBBMPSRclips-6.24/clipssrc/edmain.c0000755000175000017500000006021510441163372014140 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Corrected code generating compilation warnings */ /* with run-time programs. */ /* */ /*************************************************************/ /* * This program is in public domain; written by Dave G. Conroy. * This file contains the main driving routine, and some keyboard processing * code, for the MicroEMACS screen editor. * * REVISION HISTORY: * * 1.0 Steve Wilhite, 30-Nov-85 * - Removed the old LK201 and VT100 logic. Added code to support the * DEC Rainbow keyboard (which is a LK201 layout) using the the Level * 1 Console In ROM INT. * See "rainbow.h" for the function key definitions. * * 2.0 George Jones, 12-Dec-85 * - Ported to Amiga. * * 2.1 Chris Culbert, 25-Jul-86 * - Ported to HP9000 computers and modified commands to look more * like the Zmacs editor used on the Symbolics. * * 2.2 Bebe Ly, 09-Jan-87 * - Added functions for global search and replace, query search * and replace, and parenthesis matching. * * * 3.0 Chris Culbert, August 1987 * - Integrated with CLIPS tool. Added functions to do rule * compiling and editor entry and exit clean up. * Massive rearranging of code and general clean up. */ #include "setup.h" #if EMACS_EDITOR #if ! RUN_TIME #define _EDMAIN_SOURCE_ #include "ed.h" #include "sysdep.h" #include "extnfunc.h" #if VAX_VMS #include #define GOOD (SS$_NORMAL) #endif #ifndef GOOD #define GOOD 0 #endif #define EXIT -999 globle int currow; /* Working cursor row */ globle int curcol; /* Working cursor column */ globle int fillcol; /* Current fill column */ globle int thisflag; /* Flags, this command */ globle int lastflag; /* Flags, last command */ globle int curgoal; /* Goal column */ globle BUFFER *curbp; /* Current buffer */ globle WINDOW *curwp; /* Current window */ globle BUFFER *bheadp = NULL; /* BUFFER listhead */ globle WINDOW *wheadp; /* WINDOW listhead */ globle BUFFER *blistp; /* Buffer list BUFFER */ globle short kbdm[NKBDM] = {CTLX|')'};/* Macro */ globle short *kbdmip; /* Input for above */ globle short *kbdmop; /* Output for above */ globle char pat[NPAT]; /* Pattern */ globle char lastbufn[NBUFN]; /* Last buffer name */ globle BUFFER *CompileBufferp; /* CLIPS Compile Output Buffer */ typedef struct { short k_code; /* Key code */ int (*k_fp)(void *,int,int); /* Routine to handle it */ } KEYTAB; /* * Command table. * This table is *roughly* in ASCII order, left to right across the * characters of the command. This expains the funny location of the * control-X commands. */ globle KEYTAB keytab[] = { { COTL|'@',setmark }, { COTL|'A',gotobol }, { COTL|'B',backchar }, { COTL|'C',spawncli }, /* Run CLI in subjob. */ { COTL|'D',forwdel }, { COTL|'E',gotoeol }, { COTL|'F',forwchar }, { COTL|'G',ctrlg }, { COTL|'H',backdel }, { COTL|'I',tab }, { COTL|'J',indent }, { COTL|'K',kill_fwd }, { COTL|'L',EditorRefresh }, { COTL|'M',newline }, { COTL|'N',forwline }, { COTL|'O',openline }, { COTL|'P',backline }, { COTL|'Q',quote }, /* Often unreachable */ { COTL|'R',backsearch }, { COTL|'S',forwsearch }, /* Often unreachable */ { COTL|'T',twiddle }, { COTL|'V',forwpage }, { COTL|'W',killregion }, { COTL|'Y',yank }, { COTL|'Z',quickexit }, /* quick save and exit */ { CTLX|COTL|'B',listbuffers }, { CTLX|COTL|'C',edquit }, /* Hard quit. */ { CTLX|COTL|'F',filevisit }, { CTLX|COTL|'L',lowerregion }, { CTLX|COTL|'O',deblank }, { CTLX|COTL|'N',mvdnwind }, { CTLX|COTL|'P',mvupwind }, { CTLX|COTL|'R',filename }, { CTLX|COTL|'S',filesave }, /* Often unreachable */ { CTLX|COTL|'T',compile_region }, { CTLX|COTL|'U',upperregion }, { CTLX|COTL|'V',fileread }, { CTLX|COTL|'W',filewrite }, { CTLX|COTL|'X',swapmark }, { CTLX|COTL|'Z',shrinkwind }, { CTLX|'!',spawn }, /* Run 1 command. */ { CTLX|'=',showcpos }, { CTLX|':',gotoline }, { CTLX|'(',ctlxlp }, { CTLX|')',ctlxrp }, { CTLX|'1',onlywind }, { CTLX|'2',splitwind }, { CTLX|'B',usebuffer }, { CTLX|'E',ctlxe }, { CTLX|'F',setfillcol }, { CTLX|'K',killbuffer }, { CTLX|'M',smatchb }, { CTLX|'N',nextwind }, { CTLX|'P',prevwind }, { CTLX|'Q',temp_quit }, { CTLX|'R',bkwrdrpl }, { CTLX|'S',frwsr }, { CTLX|'Z',enlargewind }, { META|COTL|'H',delbword }, { META|'!',reposition }, { META|'.',setmark }, { META|'>',gotoeob }, { META|'<',gotobob }, { META|'B',backword }, { META|'C',capword }, { META|'D',delfword }, { META|'F',forwword }, { META|'J',forwsearch }, /* To replace C-S */ { META|'L',lowerword }, { META|'R',bkwrdcr }, { META|'S',querysr }, { META|'T',compile_file }, { META|'U',upperword }, { META|'V',backpage }, { META|'W',copyregion }, { META|'Z',filesave }, /* To replace C-S */ { META|DEL_KEY,delbword }, { DEL_KEY,backdel } }; #define NKEYTAB (sizeof(keytab)/sizeof(keytab[0])) static void PerformEditCommand(void *); static void PerformEditCommand( void *theEnv) { register int c; register int f; register int n; register int mflag; register int rtn_flag; char bname[NBUFN]; int num_a; char *fileName = NULL; DATA_OBJECT arg_ptr; /*====================*/ /* Get the file name. */ /*====================*/ if ((num_a = EnvArgCountCheck(theEnv,"edit",NO_MORE_THAN,1)) == -1) return; if (num_a == 1) { if (EnvArgTypeCheck(theEnv,"edit",1,SYMBOL_OR_STRING,&arg_ptr) == FALSE) return; fileName = DOToString(arg_ptr); } if(bheadp == NULL) { /**********************************************/ /* Initial entry, set up buffers and pointers */ /**********************************************/ strcpy(bname, "main"); /* Work out the name of */ if (num_a > 0) /* the default buffer. */ makename(bname,fileName); edinit(theEnv,bname); /* Buffers, windows. */ vtinit(theEnv); /* Displays. */ if (num_a > 0) { update(); /* You have to update */ readin(theEnv,fileName); /* in case "[New file]" */ } init_cmp_router(theEnv); /* Prepare the compile */ EnvDeactivateRouter(theEnv,"cmp_router"); /* router. */ } else { /**********************************************************/ /* Return from temporary exit, reset necessary stuff only */ /**********************************************************/ (*term.t_open)(); if (num_a > 0) { filevisit_guts(theEnv,fileName); } } sgarbf = TRUE; /* Force screen update */ lastbufn[0] = '\0'; /* Make sure last name */ /* is cleared out */ lastflag = 0; /* Fake last flags. */ loop: update(); /* Fix up the screen */ c = getkey(); if (mpresf != FALSE) { mlerase(); update(); if (c == ' ') /* ITS EMACS does this */ goto loop; } f = FALSE; n = 1; if (c == (COTL|'U')) { /* ^U, start argument */ f = TRUE; n = 4; /* with argument of 4 */ mflag = 0; /* that can be discarded. */ mlwrite("Arg: 4"); while ((((c=getkey()) >='0') && (c<='9')) || (c==(COTL|'U')) || (c=='-')){ if (c == (COTL|'U')) n = n*4; /* * If dash, and start of argument string, set arg. * to -1. Otherwise, insert it. */ else if (c == '-') { if (mflag) break; n = 0; mflag = -1; } /* * If first digit entered, replace previous argument * with digit and set sign. Otherwise, append to arg. */ else { if (!mflag) { n = 0; mflag = 1; } n = 10*n + c - '0'; } mlwrite("Arg: %d", (mflag >=0) ? n : (n ? -n : -1)); } /* * Make arguments preceded by a minus sign negative and change * the special argument "^U -" to an effective "^U -1". */ if (mflag == -1) { if (n == 0) n++; n = -n; } } if (c == (COTL|'X')) /* ^X is a prefix */ c = CTLX | getctl(); if (kbdmip != NULL) { /* Save macro strokes. */ if (c!=(CTLX|')') && kbdmip>&kbdm[NKBDM-6]) { ctrlg(theEnv,FALSE, 0); goto loop; } if (f != FALSE) { *kbdmip++ = (COTL|'U'); *kbdmip++ = n; } *kbdmip++ = c; } rtn_flag = execute(theEnv,c, f, n); /* Do it. */ if(rtn_flag == EXIT) return; else goto loop; } /* * Initialize all of the buffers and windows. The buffer name is passed down * as an argument, because the main routine may have been told to read in a * file by default, and we want the buffer name to be right. */ globle void edinit( void *theEnv, char bname[]) { register BUFFER *bp; register WINDOW *wp; bp = bfind(theEnv,bname, TRUE, 0); /* First buffer */ blistp = bfind(theEnv,"[List]", TRUE, BFTEMP); /* Buffer list buffer */ wp = (WINDOW *) genalloc(theEnv,(unsigned) sizeof(WINDOW)); /* First window */ curbp = bp; /* Make this current */ wheadp = wp; curwp = wp; wp->w_wndp = NULL; /* Initialize window */ wp->w_bufp = bp; bp->b_nwnd = 1; /* Displayed. */ wp->w_linep = bp->b_linep; wp->w_dotp = bp->b_linep; wp->w_doto = 0; wp->w_markp = NULL; wp->w_marko = 0; wp->w_toprow = 0; wp->w_ntrows = (char) term.t_nrow-1; /* "-1" for mode line. */ wp->w_force = 0; wp->w_flag = WFMODE|WFHARD; /* Full. */ /* Secret Buffer for CLIPS Compile output */ CompileBufferp = bfind(theEnv,"[Compilations]",TRUE,BFTEMP); } /* * This is the general command execution routine. It handles the fake binding * of all the keys to "self-insert". It also clears out the "thisflag" word, * and arranges to move it to the "lastflag", so that the next command can * look at it. Return the status of command. */ globle int execute( void *theEnv, int c, int f, int n) { register KEYTAB *ktp; register int status; ktp = &keytab[0]; /* Look in key table. */ while (ktp < &keytab[NKEYTAB]) { if (ktp->k_code == c) { thisflag = 0; status = (*ktp->k_fp)(theEnv,f, n); lastflag = thisflag; return (status); } ++ktp; } /* * If a space was typed, fill column is defined, the argument is non- * negative, and we are now past fill column, perform word wrap. */ if (c == ' ' && fillcol > 0 && n>=0 && getccol(FALSE) > fillcol) wrapword(theEnv); if ((c>=0x20 && c<=0x7E) /* Self inserting. */ || (c>=0xA0 && c<=0xFE)) { if (n <= 0) { /* Fenceposts. */ lastflag = 0; return (n<0 ? FALSE : TRUE); } thisflag = 0; /* For the future. */ status = linsert(theEnv,n, c); lastflag = thisflag; return (status); } lastflag = 0; /* Fake last flags. */ return (FALSE); } /* * Read in a key. * Do the standard keyboard preprocessing. Convert the keys to the internal * character set. */ globle int getkey() { register int c; c = (*term.t_getchar)(); if ((c & META) == META) return(c); #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC if (c > 255) { switch (c) { case UP_ARROW : return (COTL | 'P'); case DOWN_ARROW : return (COTL | 'N'); case LEFT_ARROW : return (COTL | 'B'); case RIGHT_ARROW : return (COTL | 'F'); case PGUP_KEY : return (META | 'V'); case PGDN_KEY : return (COTL | 'V'); case HOME_KEY : return (META | '<'); case END_KEY : return (META | '>'); case COTL_LEFT_ARROW : return (META | 'B'); case COTL_RIGHT_ARROW : return (META | 'F'); case COTL_AT_SIGN : return (COTL | '@'); default : return (COTL | 'G'); } } #endif if (c == METACH) { /* Apply M- prefix */ c = getctl(); return (META | c); } if (c>=0x00 && c<=0x1F) /* C0 control -> C- */ c = COTL | (c+'@'); return (c); } /* * Get a key. * Apply control modifications to the read key. */ globle int getctl() { register int c; c = (*term.t_getchar)(); if (c>='a' && c<='z') /* Force to upper */ c -= 0x20; if (c>=0x00 && c<=0x1F) /* C0 control -> C- */ c = COTL | (c+'@'); return (c); } /* * Fancy quit command, as implemented by Norm. If the current buffer has * changed do a write current buffer and exit emacs, otherwise simply exit. */ globle int quickexit( void *theEnv, int f, int n) { if ((curbp->b_flag&BFCHG) != 0 /* Changed. */ && (curbp->b_flag&BFTEMP) == 0) /* Real. */ filesave(theEnv,f, n); return(edquit(theEnv,f, n)); /* conditionally quit */ } /* * Quit command. If an argument, always quit. Otherwise confirm if a buffer * has been changed and not written out. Normally bound to "C-X C-C". */ #if IBM_TBC #pragma argsused #endif globle int edquit( void *theEnv, int f, int n) { register int s; if (f != FALSE /* Argument forces it. */ || anycb() == FALSE /* All buffers clean. */ /* User says it's OK. */ || (s=mlyesno(theEnv,"Modified Buffers! Quit")) == TRUE) { vttidy(); full_cleanup(theEnv); return(EXIT); } return (s); } /* * Temporary exit from editor. Leave all data structures * intact, but tidy up video interface. * Connected to "C-X Q". */ #if IBM_TBC #pragma argsused #endif globle int temp_quit( void *theEnv, int f, int n) { vttidy(); return(EXIT); } /* * Begin a keyboard macro. * Error if not at the top level in keyboard processing. Set up variables and * return. */ #if IBM_TBC #pragma argsused #endif globle int ctlxlp( void *theEnv, int f, int n) { if (kbdmip!=NULL || kbdmop!=NULL) { mlwrite("Not now"); return (FALSE); } mlwrite("[Start macro]"); kbdmip = &kbdm[0]; return (TRUE); } /* * End keyboard macro. Check for the same limit conditions as the above * routine. Set up the variables and return to the caller. */ #if IBM_TBC #pragma argsused #endif globle int ctlxrp( void *theEnv, int f, int n) { if (kbdmip == NULL) { mlwrite("Not now"); return (FALSE); } mlwrite("[End macro]"); kbdmip = NULL; return (TRUE); } /* * Execute a macro. * The command argument is the number of times to loop. Quit as soon as a * command gets an error. Return TRUE if all ok, else FALSE. */ #if IBM_TBC #pragma argsused #endif globle int ctlxe( void *theEnv, int f, int n) { register int c; register int af; register int an; register int s; if (kbdmip!=NULL || kbdmop!=NULL) { mlwrite("Not now"); return (FALSE); } if (n <= 0) return (TRUE); do { kbdmop = &kbdm[0]; do { af = FALSE; an = 1; if ((c = *kbdmop++) == (COTL|'U')) { af = TRUE; an = *kbdmop++; c = *kbdmop++; } s = TRUE; } while (c!=(CTLX|')') && (s=execute(theEnv,c, af, an))==TRUE); kbdmop = NULL; } while (s==TRUE && --n); return (s); } /* * Abort. * Beep the beeper. Kill off any keyboard macro, etc., that is in progress. * Sometimes called as a routine, to do general aborting of stuff. */ #if IBM_TBC #pragma argsused #endif globle int ctrlg( void *theEnv, int f, int n) { (*term.t_beep)(); if (kbdmip != NULL) { kbdm[0] = (CTLX|')'); kbdmip = NULL; } return (ABORT); } globle void full_cleanup( void *theEnv) { /* Clear all data structures */ kill_all_buffers(theEnv,&bheadp); /* Clear all existing buffers */ kill_all_windows(theEnv); /* Clear all windows */ kill_video_buffers(theEnv); /* Kill special video buffers */ kill_cmp_router(theEnv); /* Get rid of special router */ /* Clear all global pointers */ curwp = NULL; /* Current window */ curbp = NULL; /* Current buffer */ wheadp = NULL; /* Head of list of windows */ bheadp = NULL; /* Head of list of buffers */ blistp = NULL; /* Buffer for C-X C-B */ kbdmip = NULL; /* Input pointer for above */ kbdmop = NULL; /* Output pointer for above */ pat[0] = '\0'; /* Search pattern */ lastbufn[0] = '\0'; /* Name of Last buffer accessed */ CompileBufferp = NULL; /* CLIPS Compile Output Buffer */ } /* * Dispose of all buffers. Clear the buffer (ask first * if the buffer has been changed). Then free the header * line and the buffer header. Called for full cleanup. */ globle int kill_all_buffers( void *theEnv, BUFFER **top_buf) { register BUFFER *bp; bp = *top_buf; while(bp != NULL) { spec_clear(theEnv,bp); /* Blow text away. */ genfree(theEnv,(void *) bp->b_linep, /* And free pointer */ (unsigned) sizeof(LINE)+ bp->b_linep->l_size); *top_buf = bp->b_bufp; /* Find next buffer */ genfree(theEnv,(void *) bp, (unsigned) sizeof(BUFFER)); /* Release buffer block */ bp = *top_buf; } return (TRUE); } globle int kill_all_windows( void *theEnv) { register WINDOW *wp; register WINDOW *wp1; wp = wheadp; while(wp != NULL) { wp1 = wp->w_wndp; genfree(theEnv,(void *) wp, (unsigned) sizeof(WINDOW)); wp = wp1; } return (TRUE); } /* * This routine blows away all of the text in a * buffer. Does NOT care if text has been changed! */ globle int spec_clear( void *theEnv, BUFFER *bp) { register LINE *lp; bp->b_flag &= ~BFCHG; /* Not changed */ while ((lp=lforw(bp->b_linep)) != bp->b_linep) lfree(theEnv,lp); bp->b_dotp = bp->b_linep; /* Fix "." */ bp->b_doto = 0; bp->b_markp = NULL; /* Invalidate "mark" */ bp->b_marko = 0; return (TRUE); } globle void EditCommand( void *theEnv) { void (*redrawScreenFunction)(void *); void (*pauseEnvFunction)(void *); void (*continueEnvFunction)(void *,int); redrawScreenFunction = GetRedrawFunction(theEnv); pauseEnvFunction = GetPauseEnvFunction(theEnv); continueEnvFunction = GetContinueEnvFunction(theEnv); if (pauseEnvFunction != NULL) (*pauseEnvFunction)(theEnv) ; PerformEditCommand(theEnv); if (continueEnvFunction != NULL) (*continueEnvFunction)(theEnv,0) ; if (redrawScreenFunction != NULL) (*redrawScreenFunction)(theEnv) ; } /*******************************************/ /* EditorFunctionDefinition: */ /*******************************************/ globle void EditorFunctionDefinition( void *theEnv) { EnvDefineFunction2(theEnv,"edit",'v', PTIEF EditCommand,"EditCommand", "*1k"); } #else globle void EditCommand(void *); globle void EditorFunctionDefinition(void *); globle void EditCommand( void *theEnv) { /* Empty Stub */ } globle void EditorFunctionDefinition( void *theEnv) { } #endif #endif clips-6.24/clipssrc/tmpltdef.c0000755000175000017500000003672210441602342014523 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFTEMPLATE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic deftemplate primitive functions */ /* such as allocating and deallocating, traversing, and */ /* finding deftemplate data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /*************************************************************/ #define _TMPLTDEF_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "exprnops.h" #include "cstrccom.h" #include "network.h" #include "tmpltpsr.h" #include "tmpltbsc.h" #include "tmpltutl.h" #include "tmpltfun.h" #include "router.h" #include "modulpsr.h" #include "modulutl.h" #include "cstrnchk.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "tmpltbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "tmpltcmp.h" #endif #include "tmpltdef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *AllocateModule(void *); static void ReturnModule(void *,void *); static void ReturnDeftemplate(void *,void *); static void InitializeDeftemplateModules(void *); static void DeallocateDeftemplateData(void *); static void DestroyDeftemplateAction(void *,struct constructHeader *,void *); static void DestroyDeftemplate(void *,void *); /******************************************************************/ /* InitializeDeftemplates: Initializes the deftemplate construct. */ /******************************************************************/ globle void InitializeDeftemplates( void *theEnv) { globle struct entityRecord deftemplatePtrRecord = { "DEFTEMPLATE_PTR", DEFTEMPLATE_PTR,1,0,0, NULL, NULL,NULL, NULL, NULL, DecrementDeftemplateBusyCount, IncrementDeftemplateBusyCount, NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFTEMPLATE_DATA,sizeof(struct deftemplateData),DeallocateDeftemplateData); memcpy(&DeftemplateData(theEnv)->DeftemplatePtrRecord,&deftemplatePtrRecord,sizeof(struct entityRecord)); InitializeFacts(theEnv); InitializeDeftemplateModules(theEnv); DeftemplateBasicCommands(theEnv); DeftemplateFunctions(theEnv); DeftemplateData(theEnv)->DeftemplateConstruct = AddConstruct(theEnv,"deftemplate","deftemplates",ParseDeftemplate,EnvFindDeftemplate, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDeftemplate,SetNextConstruct, EnvIsDeftemplateDeletable,EnvUndeftemplate,ReturnDeftemplate); InstallPrimitive(theEnv,(ENTITY_RECORD_PTR) &DeftemplateData(theEnv)->DeftemplatePtrRecord,DEFTEMPLATE_PTR); } /******************************************************/ /* DeallocateDeftemplateData: Deallocates environment */ /* data for the deftemplate construct. */ /******************************************************/ static void DeallocateDeftemplateData( void *theEnv) { #if ! RUN_TIME struct deftemplateModule *theModuleItem; void *theModule; #endif #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDeftemplateAction,DeftemplateData(theEnv)->DeftemplateModuleIndex,FALSE,NULL); #if ! RUN_TIME for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct deftemplateModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DeftemplateData(theEnv)->DeftemplateModuleIndex); rtn_struct(theEnv,deftemplateModule,theModuleItem); } #endif } /*****************************************************/ /* DestroyDeftemplateAction: Action used to remove */ /* deftemplates as a result of DestroyEnvironment. */ /*****************************************************/ #if IBM_TBC #pragma argsused #endif static void DestroyDeftemplateAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif struct deftemplate *theDeftemplate = (struct deftemplate *) theConstruct; if (theDeftemplate == NULL) return; DestroyDeftemplate(theEnv,theDeftemplate); } /*************************************************************/ /* InitializeDeftemplateModules: Initializes the deftemplate */ /* construct for use with the defmodule construct. */ /*************************************************************/ static void InitializeDeftemplateModules( void *theEnv) { DeftemplateData(theEnv)->DeftemplateModuleIndex = RegisterModuleItem(theEnv,"deftemplate", AllocateModule, ReturnModule, #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDeftemplateModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeftemplateCModuleReference, #else NULL, #endif EnvFindDeftemplate); #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"deftemplate",SYMBOL); #endif } /***************************************************/ /* AllocateModule: Allocates a deftemplate module. */ /***************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,deftemplateModule)); } /*************************************************/ /* ReturnModule: Deallocates a deftemplate module. */ /*************************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DeftemplateData(theEnv)->DeftemplateConstruct); rtn_struct(theEnv,deftemplateModule,theItem); } /****************************************************************/ /* GetDeftemplateModuleItem: Returns a pointer to the defmodule */ /* item for the specified deftemplate or defmodule. */ /****************************************************************/ globle struct deftemplateModule *GetDeftemplateModuleItem( void *theEnv, struct defmodule *theModule) { return((struct deftemplateModule *) GetConstructModuleItemByIndex(theEnv,theModule,DeftemplateData(theEnv)->DeftemplateModuleIndex)); } /*****************************************************/ /* EnvFindDeftemplate: Searches for a deftemplate in */ /* the list of deftemplates. Returns a pointer to */ /* the deftemplate if found, otherwise NULL. */ /*****************************************************/ globle void *EnvFindDeftemplate( void *theEnv, char *deftemplateName) { return(FindNamedConstruct(theEnv,deftemplateName,DeftemplateData(theEnv)->DeftemplateConstruct)); } /***********************************************************************/ /* EnvGetNextDeftemplate: If passed a NULL pointer, returns the first */ /* deftemplate in the ListOfDeftemplates. Otherwise returns the next */ /* deftemplate following the deftemplate passed as an argument. */ /***********************************************************************/ globle void *EnvGetNextDeftemplate( void *theEnv, void *deftemplatePtr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) deftemplatePtr,DeftemplateData(theEnv)->DeftemplateModuleIndex)); } /***********************************************************/ /* EnvIsDeftemplateDeletable: Returns TRUE if a particular */ /* deftemplate can be deleted, otherwise returns FALSE. */ /***********************************************************/ globle intBool EnvIsDeftemplateDeletable( void *theEnv, void *vTheDeftemplate) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; if (! ConstructsDeletable(theEnv)) { return FALSE; } if (theDeftemplate->busyCount > 0) return(FALSE); if (theDeftemplate->patternNetwork != NULL) return(FALSE); return(TRUE); } /**************************************************************/ /* ReturnDeftemplate: Returns the data structures associated */ /* with a deftemplate construct to the pool of free memory. */ /**************************************************************/ static void ReturnDeftemplate( void *theEnv, void *vTheConstruct) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vTheConstruct) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct deftemplate *theConstruct = (struct deftemplate *) vTheConstruct; struct templateSlot *slotPtr; if (theConstruct == NULL) return; /*====================================================================*/ /* If a template is redefined, then we want to save its debug status. */ /*====================================================================*/ #if DEBUGGING_FUNCTIONS DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0; if (theConstruct->watch) BitwiseSet(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0); #endif /*===========================================*/ /* Free storage used by the templates slots. */ /*===========================================*/ slotPtr = theConstruct->slotList; while (slotPtr != NULL) { DecrementSymbolCount(theEnv,slotPtr->slotName); RemoveHashedExpression(theEnv,slotPtr->defaultList); slotPtr->defaultList = NULL; RemoveConstraint(theEnv,slotPtr->constraints); slotPtr->constraints = NULL; slotPtr = slotPtr->next; } ReturnSlots(theEnv,theConstruct->slotList); /*==================================*/ /* Free storage used by the header. */ /*==================================*/ DeinstallConstructHeader(theEnv,&theConstruct->header); rtn_struct(theEnv,deftemplate,theConstruct); #endif } /**************************************************************/ /* DestroyDeftemplate: Returns the data structures associated */ /* with a deftemplate construct to the pool of free memory. */ /**************************************************************/ static void DestroyDeftemplate( void *theEnv, void *vTheConstruct) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(vTheConstruct) #endif struct deftemplate *theConstruct = (struct deftemplate *) vTheConstruct; #if (! BLOAD_ONLY) && (! RUN_TIME) struct templateSlot *slotPtr, *nextSlot; #endif if (theConstruct == NULL) return; #if (! BLOAD_ONLY) && (! RUN_TIME) slotPtr = theConstruct->slotList; while (slotPtr != NULL) { nextSlot = slotPtr->next; rtn_struct(theEnv,templateSlot,slotPtr); slotPtr = nextSlot; } #endif DestroyFactPatternNetwork(theEnv,theConstruct->patternNetwork); /*==================================*/ /* Free storage used by the header. */ /*==================================*/ #if (! BLOAD_ONLY) && (! RUN_TIME) DeinstallConstructHeader(theEnv,&theConstruct->header); rtn_struct(theEnv,deftemplate,theConstruct); #endif } /***********************************************/ /* ReturnSlots: Returns the slot structures of */ /* a deftemplate to free memory. */ /***********************************************/ globle void ReturnSlots( void *theEnv, struct templateSlot *slotPtr) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,slotPtr) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct templateSlot *nextSlot; while (slotPtr != NULL) { nextSlot = slotPtr->next; ReturnExpression(theEnv,slotPtr->defaultList); RemoveConstraint(theEnv,slotPtr->constraints); rtn_struct(theEnv,templateSlot,slotPtr); slotPtr = nextSlot; } #endif } /*************************************************/ /* DecrementDeftemplateBusyCount: Decrements the */ /* busy count of a deftemplate data structure. */ /*************************************************/ globle void DecrementDeftemplateBusyCount( void *theEnv, void *vTheTemplate) { struct deftemplate *theTemplate = (struct deftemplate *) vTheTemplate; if (! ConstructData(theEnv)->ClearInProgress) theTemplate->busyCount--; } /*************************************************/ /* IncrementDeftemplateBusyCount: Increments the */ /* busy count of a deftemplate data structure. */ /*************************************************/ #if IBM_TBC #pragma argsused #endif globle void IncrementDeftemplateBusyCount( void *theEnv, void *vTheTemplate) { struct deftemplate *theTemplate = (struct deftemplate *) vTheTemplate; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif theTemplate->busyCount++; } /*******************************************************************/ /* EnvGetNextFactInTemplate: If passed a NULL pointer, returns the */ /* first fact in the template's fact-list. Otherwise returns the */ /* next template fact following the fact passed as an argument. */ /*******************************************************************/ #if IBM_TBC #pragma argsused #endif globle void *EnvGetNextFactInTemplate( void *theEnv, void *theTemplate, void *factPtr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (factPtr == NULL) { return((void *) ((struct deftemplate *) theTemplate)->factList); } if (((struct fact *) factPtr)->garbage) return(NULL); return((void *) ((struct fact *) factPtr)->nextTemplateFact); } #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/._defins.c0000400000175000017500000000075410441131540014345 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoS S HIE)TTFLbFMWBBMPSRclips-6.24/clipssrc/._constrct.h0000400000175000017500000000075410441131344014743 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco0z0zTTFS GFMWBBMPSRclips-6.24/clipssrc/._iofun.h0000400000175000017500000000075410441602236014227 0ustar jfsjfsMac OS X  2 RTEXT????`aTTFH MonacohhԾjTTFL,XFMPSRMWBBLclips-6.24/clipssrc/._globlcom.h0000400000175000017500000000075410441143630014703 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z1TTFS FMWBBMPSRclips-6.24/clipssrc/prccode.c0000755000175000017500000015521110441602270014316 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /***************************************************************/ /* Purpose: Procedural Code Support Routines for Deffunctions, */ /* Generic Function Methods,Message-Handlers */ /* and Rules */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /***************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #include #include #include "memalloc.h" #include "constant.h" #include "envrnmnt.h" #if DEFGLOBAL_CONSTRUCT #include "globlpsr.h" #endif #include "exprnpsr.h" #include "multifld.h" #if OBJECT_SYSTEM #include "object.h" #endif #include "prcdrpsr.h" #include "router.h" #include "utility.h" #define _PRCCODE_SOURCE_ #include "prccode.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef struct { unsigned firstFlag : 1; unsigned first : 15; unsigned secondFlag : 1; unsigned second : 15; } PACKED_PROC_VAR; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void EvaluateProcParameters(void *,EXPRESSION *,int,char *,char *); static intBool RtnProcParam(void *,void *,DATA_OBJECT *); static intBool GetProcBind(void *,void *,DATA_OBJECT *); static intBool PutProcBind(void *,void *,DATA_OBJECT *); static intBool RtnProcWild(void *,void *,DATA_OBJECT *); static void DeallocateProceduralPrimitiveData(void *); #if (! BLOAD_ONLY) && (! RUN_TIME) static int FindProcParameter(SYMBOL_HN *,EXPRESSION *,SYMBOL_HN *); static int ReplaceProcBinds(void *,EXPRESSION *, int (*)(void *,EXPRESSION *,void *),void *); static EXPRESSION *CompactActions(void *,EXPRESSION *); #endif #if (! DEFFUNCTION_CONSTRUCT) || (! DEFGENERIC_CONSTRUCT) static intBool EvaluateBadCall(void *,void *,DATA_OBJECT *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /**************************************************** NAME : InstallProcedurePrimitives DESCRIPTION : Installs primitive function handlers for accessing parameters and local variables within the bodies of message-handlers, methods, rules and deffunctions. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Primitive entities installed NOTES : None ****************************************************/ globle void InstallProcedurePrimitives( void *theEnv) { ENTITY_RECORD procParameterInfo = { "PROC_PARAM", PROC_PARAM,0,1,0,NULL,NULL,NULL, RtnProcParam,NULL,NULL,NULL,NULL,NULL,NULL }, procWildInfo = { "PROC_WILD_PARAM", PROC_WILD_PARAM,0,1,0,NULL,NULL,NULL, RtnProcWild,NULL,NULL,NULL,NULL,NULL,NULL }, procGetInfo = { "PROC_GET_BIND", PROC_GET_BIND,0,1,0,NULL,NULL,NULL, GetProcBind,NULL,NULL,NULL,NULL,NULL,NULL }, procBindInfo = { "PROC_BIND", PROC_BIND,0,1,0,NULL,NULL,NULL, PutProcBind,NULL,NULL,NULL,NULL,NULL,NULL }; #if ! DEFFUNCTION_CONSTRUCT ENTITY_RECORD deffunctionEntityRecord = { "PCALL", PCALL,0,0,1, NULL,NULL,NULL, EvaluateBadCall, NULL,NULL,NULL,NULL,NULL,NULL,NULL }; #endif #if ! DEFGENERIC_CONSTRUCT ENTITY_RECORD genericEntityRecord = { "GCALL", GCALL,0,0,1, NULL,NULL,NULL, EvaluateBadCall, NULL,NULL,NULL,NULL,NULL,NULL,NULL }; #endif AllocateEnvironmentData(theEnv,PROCEDURAL_PRIMITIVE_DATA,sizeof(struct proceduralPrimitiveData),DeallocateProceduralPrimitiveData); memcpy(&ProceduralPrimitiveData(theEnv)->ProcParameterInfo,&procParameterInfo,sizeof(struct entityRecord)); memcpy(&ProceduralPrimitiveData(theEnv)->ProcWildInfo,&procWildInfo,sizeof(struct entityRecord)); memcpy(&ProceduralPrimitiveData(theEnv)->ProcGetInfo,&procGetInfo,sizeof(struct entityRecord)); memcpy(&ProceduralPrimitiveData(theEnv)->ProcBindInfo,&procBindInfo,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParameterInfo,PROC_PARAM); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcWildInfo,PROC_WILD_PARAM); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcGetInfo,PROC_GET_BIND); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcBindInfo,PROC_BIND); ProceduralPrimitiveData(theEnv)->Oldindex = -1; /* =============================================== Make sure a default evaluation function is in place for deffunctions and generic functions in the event that a binary image containing these items is loaded into a configuration that does not support them. =============================================== */ #if ! DEFFUNCTION_CONSTRUCT memcpy(&ProceduralPrimitiveData(theEnv)->DeffunctionEntityRecord,&deffunctionEntityRecord,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->DeffunctionEntityRecord,PCALL); #endif #if ! DEFGENERIC_CONSTRUCT memcpy(&ProceduralPrimitiveData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->GenericEntityRecord,GCALL); #endif /* ============================================= Install the special empty multifield to let callers distinguish between no parameters and zero-length multifield parameters ============================================= */ ProceduralPrimitiveData(theEnv)->NoParamValue = CreateMultifield2(theEnv,0L); MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->NoParamValue); } /**************************************************************/ /* DeallocateProceduralPrimitiveData: Deallocates environment */ /* data for the procedural primitives functionality. */ /**************************************************************/ static void DeallocateProceduralPrimitiveData( void *theEnv) { ReturnMultifield(theEnv,(struct multifield *) ProceduralPrimitiveData(theEnv)->NoParamValue); } #if (! BLOAD_ONLY) && (! RUN_TIME) #if DEFFUNCTION_CONSTRUCT || OBJECT_SYSTEM /************************************************************ NAME : ParseProcParameters DESCRIPTION : Parses a parameter list for a procedural routine, such as a deffunction or message-handler INPUTS : 1) The logical name of the input 2) A buffer for scanned tokens 3) The partial list of parameters so far (can be NULL) 3) A buffer for a wildcard symbol (if any) 4) A buffer for a minimum of parameters 5) A buffer for a maximum of parameters (will be set to -1 if there is a wilcard) 6) A buffer for an error flag 7) The address of a function to do specialized checking on a parameter (can be NULL) The function should accept a string and return FALSE if the parameter is OK, TRUE otherwise. RETURNS : A list of expressions containing the parameter names SIDE EFFECTS : Parameters parsed and expressions formed NOTES : None ************************************************************/ globle EXPRESSION *ParseProcParameters( void *theEnv, char *readSource, struct token *tkn, EXPRESSION *parameterList, SYMBOL_HN **wildcard, int *min, int *max, int *error, int (*checkfunc)(void *,char *)) { EXPRESSION *nextOne,*lastOne,*check; int paramprintp = 0; *wildcard = NULL; *min = 0; *error = TRUE; lastOne = nextOne = parameterList; while (nextOne != NULL) { (*min)++; lastOne = nextOne; nextOne = nextOne->nextArg; } if (tkn->type != LPAREN) { SyntaxErrorMessage(theEnv,"parameter list"); ReturnExpression(theEnv,parameterList); return(NULL); } GetToken(theEnv,readSource,tkn); while ((tkn->type == SF_VARIABLE) || (tkn->type == MF_VARIABLE)) { for (check = parameterList ; check != NULL ; check = check->nextArg) if (check->value == tkn->value) { PrintErrorID(theEnv,"PRCCODE",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate parameter names not allowed.\n"); ReturnExpression(theEnv,parameterList); return(NULL); } if (*wildcard != NULL) { PrintErrorID(theEnv,"PRCCODE",8,FALSE); EnvPrintRouter(theEnv,WERROR,"No parameters allowed after wildcard parameter.\n"); ReturnExpression(theEnv,parameterList); return(NULL); } if ((checkfunc != NULL) ? (*checkfunc)(theEnv,ValueToString(tkn->value)) : FALSE) { ReturnExpression(theEnv,parameterList); return(NULL); } nextOne = GenConstant(theEnv,tkn->type,tkn->value); if (tkn->type == MF_VARIABLE) *wildcard = (SYMBOL_HN *) tkn->value; else (*min)++; if (lastOne == NULL) { parameterList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; SavePPBuffer(theEnv," "); paramprintp = 1; GetToken(theEnv,readSource,tkn); } if (tkn->type != RPAREN) { SyntaxErrorMessage(theEnv,"parameter list"); ReturnExpression(theEnv,parameterList); return(NULL); } if (paramprintp) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } *error = FALSE; *max = (*wildcard != NULL) ? -1 : *min; return(parameterList); } #endif /************************************************************************* NAME : ParseProcActions DESCRIPTION : Parses the bodies of deffunctions, generic function methods and message-handlers. Replaces parameter and local variable references with appropriate runtime access functions INPUTS : 1) The type of procedure body being parsed 2) The logical name of the input 3) A buffer for scanned tokens 4) A list of expressions containing the names of the parameters 5) The wilcard parameter symbol (NULL if none) 6) A pointer to a function to parse variables not recognized by the standard parser The function should accept the variable expression and a generic pointer for special data (can be NULL) as arguments. If the variable is recognized, the function should modify the expression to access this variable. Return 1 if recognized, 0 if not, -1 on errors This argument can be NULL. 7) A pointer to a function to handle binds in a special way. The function should accept the bind function call expression as an argument. If the variable is recognized and treated specially, the function should modify the expression appropriately (including attaching/removing any necessary argument expressions). Return 1 if recognized, 0 if not, -1 on errors. This argument can be NULL. 8) A buffer for holding the number of local vars used by this procedure body. 9) Special user data buffer to pass to variable reference and bind replacement functions RETURNS : A packed expression containing the body, NULL on errors. SIDE EFFECTS : Variable references replaced with runtime calls to access the paramter and local variable array NOTES : None *************************************************************************/ globle EXPRESSION *ParseProcActions( void *theEnv, char *bodytype, char *readSource, struct token *tkn, EXPRESSION *params, SYMBOL_HN *wildcard, int (*altvarfunc)(void *,EXPRESSION *,void *), int (*altbindfunc)(void *,EXPRESSION *,void *), int *lvarcnt, void *userBuffer) { EXPRESSION *actions,*pactions; /* ==================================================================== Clear parsed bind list - so that only local vars from this body will be on it. The position of vars on thsi list are used to generate indices into the LocalVarArray at runtime. The parsing of the "bind" function adds vars to this list. ==================================================================== */ ClearParsedBindNames(theEnv); actions = GroupActions(theEnv,readSource,tkn,TRUE,NULL,FALSE); if (actions == NULL) return(NULL); /* ==================================================================== Replace any bind functions with special functions before replacing any variable references. This allows those bind names to be removed before they can be seen by variable replacement and thus generate incorrect indices. ==================================================================== */ if (altbindfunc != NULL) { if (ReplaceProcBinds(theEnv,actions,altbindfunc,userBuffer)) { ClearParsedBindNames(theEnv); ReturnExpression(theEnv,actions); return(NULL); } } /* ====================================================================== The number of names left on the bind list is the number of local vars for this procedure body. Replace all variable reference with runtime access functions for ProcParamArray, LocalVarArray or other special items, such as direct slot references, global variables, or fact field references. ====================================================================== */ *lvarcnt = CountParsedBindNames(theEnv); if (ReplaceProcVars(theEnv,bodytype,actions,params,wildcard,altvarfunc,userBuffer)) { ClearParsedBindNames(theEnv); ReturnExpression(theEnv,actions); return(NULL); } /* ======================================================================= Normally, actions are grouped in a progn. If there is only one action, the progn is unnecessary and can be removed. Also, the actions are packed into a contiguous array to save on memory overhead. The intermediate parsed bind names are freed to avoid tying up memory. ======================================================================= */ actions = CompactActions(theEnv,actions); pactions = PackExpression(theEnv,actions); ReturnExpression(theEnv,actions); ClearParsedBindNames(theEnv); return(pactions); } /************************************************************************* NAME : ReplaceProcVars DESCRIPTION : Examines an expression for variables and replaces any that correspond to procedure parameters or globals with function calls that get these variables' values at run-time. For example, procedure arguments are stored an array at run-time, so at parse-time, parameter-references are replaced with function calls referencing this array at the appropriate position. INPUTS : 1) The type of procedure being parsed 2) The expression-actions to be examined 3) The parameter list 4) The wildcard parameter symbol (NULL if none) 5) A pointer to a function to parse variables not recognized by the standard parser The function should accept the variable expression and a generic pointer for special data (can be NULL) as arguments. If the variable is recognized, the function should modify the expression to access this variable. Return 1 if recognized, 0 if not, -1 on errors This argument can be NULL. 6) Data buffer to be passed to alternate parsing function RETURNS : FALSE if OK, TRUE on errors SIDE EFFECTS : Variable references replaced with function calls NOTES : This function works from the ParsedBindNames list in SPCLFORM.C to access local binds. Make sure that the list accurately reflects the binds by calling ClearParsedBindNames(theEnv) before the parse of the body in which variables are being replaced. *************************************************************************/ globle int ReplaceProcVars( void *theEnv, char *bodytype, EXPRESSION *actions, EXPRESSION *parameterList, SYMBOL_HN *wildcard, int (*altvarfunc)(void *,EXPRESSION *,void *), void *specdata) { int position,altcode; intBool boundPosn; EXPRESSION *arg_lvl,*altvarexp; SYMBOL_HN *bindName; PACKED_PROC_VAR pvar; while (actions != NULL) { if (actions->type == SF_VARIABLE) { /*===============================================*/ /* See if the variable is in the parameter list. */ /*===============================================*/ bindName = (SYMBOL_HN *) actions->value; position = FindProcParameter(bindName,parameterList,wildcard); /*=============================================================*/ /* Check to see if the variable is bound within the procedure. */ /*=============================================================*/ boundPosn = SearchParsedBindNames(theEnv,bindName); /*=============================================*/ /* If variable is not defined in the parameter */ /* list or as part of a bind action then... */ /*=============================================*/ if ((position == 0) && (boundPosn == 0)) { /*================================================================*/ /* Check to see if the variable has a special access function, */ /* such as direct slot reference or a rule RHS pattern reference. */ /*================================================================*/ if ((altvarfunc != NULL) ? ((*altvarfunc)(theEnv,actions,specdata) != 1) : TRUE) { PrintErrorID(theEnv,"PRCCODE",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Undefined variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(bindName)); EnvPrintRouter(theEnv,WERROR," referenced in "); EnvPrintRouter(theEnv,WERROR,bodytype); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } } /*===================================================*/ /* Else if variable is defined in the parameter list */ /* and not rebound within the procedure then... */ /*===================================================*/ else if ((position > 0) && (boundPosn == 0)) { actions->type = (unsigned short) ((bindName != wildcard) ? PROC_PARAM : PROC_WILD_PARAM); actions->value = AddBitMap(theEnv,(void *) &position,(int) sizeof(int)); } /*=========================================================*/ /* Else the variable is rebound within the procedure so... */ /*=========================================================*/ else { if (altvarfunc != NULL) { altvarexp = GenConstant(theEnv,actions->type,actions->value); altcode = (*altvarfunc)(theEnv,altvarexp,specdata); if (altcode == 0) { rtn_struct(theEnv,expr,altvarexp); altvarexp = NULL; } else if (altcode == -1) { rtn_struct(theEnv,expr,altvarexp); return(TRUE); } } else altvarexp = NULL; actions->type = PROC_GET_BIND; ClearBitString((void *) &pvar,(int) sizeof(PACKED_PROC_VAR)); pvar.first = boundPosn; pvar.second = position; pvar.secondFlag = (bindName != wildcard) ? 0 : 1; actions->value = AddBitMap(theEnv,(void *) &pvar,(int) sizeof(PACKED_PROC_VAR)); actions->argList = GenConstant(theEnv,SYMBOL,(void *) bindName); actions->argList->nextArg = altvarexp; } } #if DEFGLOBAL_CONSTRUCT else if (actions->type == GBL_VARIABLE) { if (ReplaceGlobalVariable(theEnv,actions) == FALSE) return(-1); } #endif if ((altvarfunc != NULL) ? ((*altvarfunc)(theEnv,actions,specdata) == -1) : FALSE) return(TRUE); if (actions->argList != NULL) { if (ReplaceProcVars(theEnv,bodytype,actions->argList,parameterList, wildcard,altvarfunc,specdata)) return(TRUE); /* ==================================================================== Check to see if this is a call to the bind function. If so (and the second argument is a symbol) then it is a locally bound variable (as opposed to a global). Replace the call to "bind" with a call to PROC_BIND - the special internal function for procedure local variables. ==================================================================== */ if ((actions->value == (void *) FindFunction(theEnv,"bind")) && (actions->argList->type == SYMBOL)) { actions->type = PROC_BIND; boundPosn = SearchParsedBindNames(theEnv,(SYMBOL_HN *) actions->argList->value); actions->value = AddBitMap(theEnv,(void *) &boundPosn,(int) sizeof(intBool)); arg_lvl = actions->argList->nextArg; rtn_struct(theEnv,expr,actions->argList); actions->argList = arg_lvl; } } actions = actions->nextArg; } return(FALSE); } #if DEFGENERIC_CONSTRUCT /***************************************************** NAME : GenProcWildcardReference DESCRIPTION : Returns an expression to access the wildcard parameter for a method INPUTS : The starting index of the wildcard RETURNS : An expression containing the wildcard reference SIDE EFFECTS : Expression allocated NOTES : None *****************************************************/ globle EXPRESSION *GenProcWildcardReference( void *theEnv, int theIndex) { return(GenConstant(theEnv,PROC_WILD_PARAM,AddBitMap(theEnv,(void *) &theIndex,(int) sizeof(int)))); } #endif #endif /******************************************************************* NAME : PushProcParameters DESCRIPTION : Given a list of parameter expressions, this function evaluates each expression and stores the results in a contiguous array of DATA_OBJECTS. Used in creating a new ProcParamArray for the execution of a procedure The current arrays are saved on a stack. INPUTS : 1) The paramter expression list 2) The number of parameters in the list 3) The name of the procedure for which these parameters are being evaluated 4) The type of procedure 5) A pointer to a function to print out a trace message about the currently executing procedure when unbound variables are detected at runtime (The function should take no arguments and have no return value. The function should print its synopsis to WERROR and include the final carriage-return.) RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of the evaluation of the parameter expressions DATA_OBJECT array allocated (deallocated on errors) ProcParamArray set NOTES : EvaluationError set on errors *******************************************************************/ globle void PushProcParameters( void *theEnv, EXPRESSION *parameterList, int numberOfParameters, char *pname, char *bodytype, void (*UnboundErrFunc)(void *)) { register PROC_PARAM_STACK *ptmp; ptmp = get_struct(theEnv,ProcParamStack); ptmp->ParamArray = ProceduralPrimitiveData(theEnv)->ProcParamArray; ptmp->ParamArraySize = ProceduralPrimitiveData(theEnv)->ProcParamArraySize; ptmp->UnboundErrFunc = ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc; ptmp->nxt = ProceduralPrimitiveData(theEnv)->pstack; ProceduralPrimitiveData(theEnv)->pstack = ptmp; EvaluateProcParameters(theEnv,parameterList,numberOfParameters,pname,bodytype); if (EvaluationData(theEnv)->EvaluationError) { ptmp = ProceduralPrimitiveData(theEnv)->pstack; ProceduralPrimitiveData(theEnv)->pstack = ProceduralPrimitiveData(theEnv)->pstack->nxt; rtn_struct(theEnv,ProcParamStack,ptmp); return; } /* ================================================================ Record ProcParamExpressions and WildcardValue for previous frame AFTER evaluating arguments for the new frame, because they could have gone from NULL to non-NULL (if they were already non-NULL, they would remain unchanged.) ================================================================ */ #if DEFGENERIC_CONSTRUCT ptmp->ParamExpressions = ProceduralPrimitiveData(theEnv)->ProcParamExpressions; ProceduralPrimitiveData(theEnv)->ProcParamExpressions = NULL; #endif ptmp->WildcardValue = ProceduralPrimitiveData(theEnv)->WildcardValue; ProceduralPrimitiveData(theEnv)->WildcardValue = NULL; ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc = UnboundErrFunc; } /****************************************************************** NAME : PopProcParameters DESCRIPTION : Restores old procedure arrays INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Stack popped and globals restored NOTES : Assumes pstack != NULL ******************************************************************/ globle void PopProcParameters( void *theEnv) { register PROC_PARAM_STACK *ptmp; if (ProceduralPrimitiveData(theEnv)->ProcParamArray != NULL) rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->ProcParamArray,(sizeof(DATA_OBJECT) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize)); #if DEFGENERIC_CONSTRUCT if (ProceduralPrimitiveData(theEnv)->ProcParamExpressions != NULL) rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->ProcParamExpressions,(sizeof(EXPRESSION) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize)); #endif ptmp = ProceduralPrimitiveData(theEnv)->pstack; ProceduralPrimitiveData(theEnv)->pstack = ProceduralPrimitiveData(theEnv)->pstack->nxt; ProceduralPrimitiveData(theEnv)->ProcParamArray = ptmp->ParamArray; ProceduralPrimitiveData(theEnv)->ProcParamArraySize = ptmp->ParamArraySize; #if DEFGENERIC_CONSTRUCT ProceduralPrimitiveData(theEnv)->ProcParamExpressions = ptmp->ParamExpressions; #endif if (ProceduralPrimitiveData(theEnv)->WildcardValue != NULL) { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue) AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); rtn_struct(theEnv,dataObject,ProceduralPrimitiveData(theEnv)->WildcardValue); } ProceduralPrimitiveData(theEnv)->WildcardValue = ptmp->WildcardValue; ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc = ptmp->UnboundErrFunc; rtn_struct(theEnv,ProcParamStack,ptmp); } #if DEFGENERIC_CONSTRUCT /*********************************************************** NAME : GetProcParamExpressions DESCRIPTION : Forms an array of expressions equivalent to the current procedure paramter array. Used to conveniently attach these parameters as arguments to a H/L system function call (used by the generic dispatch). INPUTS : None RETURNS : A pointer to an array of expressions SIDE EFFECTS : Expression array created NOTES : None ***********************************************************/ globle EXPRESSION *GetProcParamExpressions( void *theEnv) { register int i; if ((ProceduralPrimitiveData(theEnv)->ProcParamArray == NULL) || (ProceduralPrimitiveData(theEnv)->ProcParamExpressions != NULL)) return(ProceduralPrimitiveData(theEnv)->ProcParamExpressions); ProceduralPrimitiveData(theEnv)->ProcParamExpressions = (EXPRESSION *) gm2(theEnv,(sizeof(EXPRESSION) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize)); for (i = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type; if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type != MULTIFIELD) ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].value = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].value; else ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].value = (void *) &ProceduralPrimitiveData(theEnv)->ProcParamArray[i]; ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].argList = NULL; ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].nextArg = ((i + 1) != ProceduralPrimitiveData(theEnv)->ProcParamArraySize) ? &ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i+1] : NULL; } return(ProceduralPrimitiveData(theEnv)->ProcParamExpressions); } #endif /*********************************************************** NAME : EvaluateProcActions DESCRIPTION : Evaluates the actions of a deffunction, generic function method or message-handler. INPUTS : 1) The module where the actions should be executed 2) The actions (linked by nextArg fields) 3) The number of local variables to reserve space for. 4) A buffer to hold the result of evaluating the actions. 5) A function which prints out the name of the currently executing body for error messages (can be NULL). RETURNS : Nothing useful SIDE EFFECTS : Allocates and deallocates space for local variable array. NOTES : None ***********************************************************/ globle void EvaluateProcActions( void *theEnv, struct defmodule *theModule, EXPRESSION *actions, int lvarcnt, DATA_OBJECT *result, void (*crtproc)(void *)) { DATA_OBJECT *oldLocalVarArray; register int i; struct defmodule *oldModule; EXPRESSION *oldActions; oldLocalVarArray = ProceduralPrimitiveData(theEnv)->LocalVarArray; ProceduralPrimitiveData(theEnv)->LocalVarArray = (lvarcnt == 0) ? NULL : (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * lvarcnt)); for (i = 0 ; i < lvarcnt ; i++) ProceduralPrimitiveData(theEnv)->LocalVarArray[i].supplementalInfo = EnvFalseSymbol(theEnv); oldModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (oldModule != theModule) EnvSetCurrentModule(theEnv,(void *) theModule); oldActions = ProceduralPrimitiveData(theEnv)->CurrentProcActions; ProceduralPrimitiveData(theEnv)->CurrentProcActions = actions; if (EvaluateExpression(theEnv,actions,result)) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); } ProceduralPrimitiveData(theEnv)->CurrentProcActions = oldActions; if (oldModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) EnvSetCurrentModule(theEnv,(void *) oldModule); if ((crtproc != NULL) ? EvaluationData(theEnv)->HaltExecution : FALSE) { PrintErrorID(theEnv,"PRCCODE",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Execution halted during the actions of "); (*crtproc)(theEnv); } if ((ProceduralPrimitiveData(theEnv)->WildcardValue != NULL) ? (result->value == ProceduralPrimitiveData(theEnv)->WildcardValue->value) : FALSE) { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue) AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); rtn_struct(theEnv,dataObject,ProceduralPrimitiveData(theEnv)->WildcardValue); ProceduralPrimitiveData(theEnv)->WildcardValue = NULL; } if (lvarcnt != 0) { for (i = 0 ; i < lvarcnt ; i++) if (ProceduralPrimitiveData(theEnv)->LocalVarArray[i].supplementalInfo == EnvTrueSymbol(theEnv)) ValueDeinstall(theEnv,&ProceduralPrimitiveData(theEnv)->LocalVarArray[i]); rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->LocalVarArray,(sizeof(DATA_OBJECT) * lvarcnt)); } ProceduralPrimitiveData(theEnv)->LocalVarArray = oldLocalVarArray; } /**************************************************** NAME : PrintProcParamArray DESCRIPTION : Displays the contents of the current procedure parameter array INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ****************************************************/ globle void PrintProcParamArray( void *theEnv, char *logName) { register int i; EnvPrintRouter(theEnv,logName," ("); for (i = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { PrintDataObject(theEnv,logName,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]); if (i != ProceduralPrimitiveData(theEnv)->ProcParamArraySize-1) EnvPrintRouter(theEnv,logName," "); } EnvPrintRouter(theEnv,logName,")\n"); } /**************************************************************** NAME : GrabProcWildargs DESCRIPTION : Groups a portion of the ProcParamArray into a multi-field variable INPUTS : 1) Starting index in ProcParamArray for grouping of arguments into multi-field variable 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Multi-field variable allocated and set with corresponding values of ProcParamArray NOTES : Multi-field is NOT on list of ephemeral segments ****************************************************************/ globle void GrabProcWildargs( void *theEnv, DATA_OBJECT *result, int theIndex) { register int i,j; long k; /* 6.04 Bug Fix */ long size; DATA_OBJECT *val; result->type = MULTIFIELD; result->begin = 0; if (ProceduralPrimitiveData(theEnv)->WildcardValue == NULL) { ProceduralPrimitiveData(theEnv)->WildcardValue = get_struct(theEnv,dataObject); ProceduralPrimitiveData(theEnv)->WildcardValue->begin = 0; } else if (theIndex == ProceduralPrimitiveData(theEnv)->Oldindex) { result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end; result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value; return; } else { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue) AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); } ProceduralPrimitiveData(theEnv)->Oldindex = theIndex; size = ProceduralPrimitiveData(theEnv)->ProcParamArraySize - theIndex + 1; if (size <= 0) { result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end = -1; result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value = ProceduralPrimitiveData(theEnv)->NoParamValue; MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); return; } for (i = theIndex-1 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == MULTIFIELD) size += ProceduralPrimitiveData(theEnv)->ProcParamArray[i].end - ProceduralPrimitiveData(theEnv)->ProcParamArray[i].begin; } result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end = size-1; result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value = (void *) CreateMultifield2(theEnv,(unsigned long) size); for (i = theIndex-1 , j = 1 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++) { if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type != MULTIFIELD) { SetMFType(result->value,j,(short) ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type); SetMFValue(result->value,j,ProceduralPrimitiveData(theEnv)->ProcParamArray[i].value); j++; } else { val = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i]; for (k = val->begin + 1 ; k <= val->end + 1 ; k++ , j++) { SetMFType(result->value,j,GetMFType(val->value,k)); SetMFValue(result->value,j,GetMFValue(val->value,k)); } } } MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************************* NAME : EvaluateProcParameters DESCRIPTION : Given a list of parameter expressions, this function evaluates each expression and stores the results in a contiguous array of DATA_OBJECTS. Used in creating a new ProcParamArray for the execution of a procedure INPUTS : 1) The paramter expression list 2) The number of parameters in the list 3) The name of the procedure for which these parameters are being evaluated 4) The type of procedure RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of the evaluation of the parameter expressions DATA_OBJECT array allocated (deallocated on errors) ProcParamArray set NOTES : EvaluationError set on errors *******************************************************************/ static void EvaluateProcParameters( void *theEnv, EXPRESSION *parameterList, int numberOfParameters, char *pname, char *bodytype) { DATA_OBJECT *rva,temp; int i = 0; if (numberOfParameters == 0) { ProceduralPrimitiveData(theEnv)->ProcParamArray = NULL; ProceduralPrimitiveData(theEnv)->ProcParamArraySize = 0; return; } rva = (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * numberOfParameters)); while (parameterList != NULL) { if ((EvaluateExpression(theEnv,parameterList,&temp) == TRUE) ? TRUE : (temp.type == RVOID)) { if (temp.type == RVOID) { PrintErrorID(theEnv,"PRCCODE",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Functions without a return value are illegal as "); EnvPrintRouter(theEnv,WERROR,bodytype); EnvPrintRouter(theEnv,WERROR," arguments.\n"); SetEvaluationError(theEnv,TRUE); } PrintErrorID(theEnv,"PRCCODE",6,FALSE); EnvPrintRouter(theEnv,WERROR,"This error occurred while evaluating arguments "); EnvPrintRouter(theEnv,WERROR,"for the "); EnvPrintRouter(theEnv,WERROR,bodytype); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,pname); EnvPrintRouter(theEnv,WERROR,".\n"); rm(theEnv,(void *) rva,(sizeof(DATA_OBJECT) * numberOfParameters)); return; } rva[i].type = temp.type; rva[i].value = temp.value; rva[i].begin = temp.begin; rva[i].end = temp.end; parameterList = parameterList->nextArg; i++; } ProceduralPrimitiveData(theEnv)->ProcParamArraySize = numberOfParameters; ProceduralPrimitiveData(theEnv)->ProcParamArray = rva; } /*************************************************** NAME : RtnProcParam DESCRIPTION : Internal function for getting the value of an argument passed to a procedure INPUTS : 1) Expression to evaluate (PROC_PARAM index) 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's buffer set to specified node of ProcParamArray NOTES : None ***************************************************/ static intBool RtnProcParam( void *theEnv, void *value, DATA_OBJECT *result) { register DATA_OBJECT *src; src = &ProceduralPrimitiveData(theEnv)->ProcParamArray[*((int *) ValueToBitMap(value)) - 1]; result->type = src->type; result->value = src->value; result->begin = src->begin; result->end = src->end; return(TRUE); } /************************************************************** NAME : GetProcBind DESCRIPTION : Internal function for looking up the values of parameters or bound variables within procedures INPUTS : 1) Expression to evaluate (PROC_GET_BIND index) 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's buffer set to parameter value in ProcParamArray or the value in LocalVarArray NOTES : None **************************************************************/ static intBool GetProcBind( void *theEnv, void *value, DATA_OBJECT *result) { register DATA_OBJECT *src; PACKED_PROC_VAR *pvar; pvar = (PACKED_PROC_VAR *) ValueToBitMap(value); src = &ProceduralPrimitiveData(theEnv)->LocalVarArray[pvar->first - 1]; if (src->supplementalInfo == EnvTrueSymbol(theEnv)) { result->type = src->type; result->value = src->value; result->begin = src->begin; result->end = src->end; return(TRUE); } if (GetFirstArgument()->nextArg != NULL) { EvaluateExpression(theEnv,GetFirstArgument()->nextArg,result); return(TRUE); } if (pvar->second == 0) { PrintErrorID(theEnv,"PRCCODE",5,FALSE); SetEvaluationError(theEnv,TRUE); EnvPrintRouter(theEnv,WERROR,"Variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(GetFirstArgument()->value)); if (ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc != NULL) { EnvPrintRouter(theEnv,WERROR," unbound in "); (*ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc)(theEnv); } else EnvPrintRouter(theEnv,WERROR," unbound.\n"); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return(TRUE); } if (pvar->secondFlag == 0) { src = &ProceduralPrimitiveData(theEnv)->ProcParamArray[pvar->second - 1]; result->type = src->type; result->value = src->value; result->begin = src->begin; result->end = src->end; } else GrabProcWildargs(theEnv,result,(int) pvar->second); return(TRUE); } /************************************************************** NAME : PutProcBind DESCRIPTION : Internal function for setting the values of of locally bound variables within procedures INPUTS : 1) Expression to evaluate (PROC_PARAM index) 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Bound variable in LocalVarArray set to value in caller's buffer. NOTES : None **************************************************************/ static intBool PutProcBind( void *theEnv, void *value, DATA_OBJECT *result) { register DATA_OBJECT *dst; dst = &ProceduralPrimitiveData(theEnv)->LocalVarArray[*((int *) ValueToBitMap(value)) - 1]; if (GetFirstArgument() == NULL) { if (dst->supplementalInfo == EnvTrueSymbol(theEnv)) ValueDeinstall(theEnv,dst); dst->supplementalInfo = EnvFalseSymbol(theEnv); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); } else { if (GetFirstArgument()->nextArg != NULL) StoreInMultifield(theEnv,result,GetFirstArgument(),TRUE); else EvaluateExpression(theEnv,GetFirstArgument(),result); if (dst->supplementalInfo == EnvTrueSymbol(theEnv)) ValueDeinstall(theEnv,dst); dst->supplementalInfo = EnvTrueSymbol(theEnv); dst->type = result->type; dst->value = result->value; dst->begin = result->begin; dst->end = result->end; ValueInstall(theEnv,dst); } return(TRUE); } /**************************************************************** NAME : RtnProcWild DESCRIPTION : Groups a portion of the ProcParamArray into a multi-field variable INPUTS : 1) Starting index in ProcParamArray for grouping of arguments into multi-field variable (expression value) 2) Caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Multi-field variable allocated and set with corresponding values of ProcParamArray NOTES : Multi-field is NOT on list of ephemeral segments ****************************************************************/ static intBool RtnProcWild( void *theEnv, void *value, DATA_OBJECT *result) { GrabProcWildargs(theEnv,result,*(int *) ValueToBitMap(value)); return(TRUE); } #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : FindProcParameter DESCRIPTION : Determines the relative position in an n-element list of a certain parameter. The index is 1..n. INPUTS : 1) Parameter name 2) Parameter list 3) Wildcard symbol (NULL if none) RETURNS : Index of parameter in list, 0 if not found SIDE EFFECTS : None NOTES : None ***************************************************/ static int FindProcParameter( SYMBOL_HN *name, EXPRESSION *parameterList, SYMBOL_HN *wildcard) { int i = 1; while (parameterList != NULL) { if (parameterList->value == (void *) name) return(i); i++; parameterList = parameterList->nextArg; } /* =================================================================== Wildcard may not be stored in actual list but know is always at end =================================================================== */ if (name == wildcard) return(i); return(0); } /************************************************************************* NAME : ReplaceProcBinds DESCRIPTION : Examines an expression and replaces calls to the "bind" function which are specially recognized For example, in a message-handler, (bind ?self ) would be illegal and (bind ?self: ) would be replaced with (put ) INPUTS : 1) The actions in which to replace special binds 2) A pointer to a function to handle binds in a special way. The function should accept the bind function call expression and a specialized data buffer (can be NULL) as arguments. If the variable is recognized and treated specially, the function should modify the expression appropriately (including attaching/removing any necessary argument expressions). Return 1 if recognized, 0 if not, -1 on errors. This argument CANNOT be NULL. 3) Specialized user data buffer RETURNS : FALSE if OK, TRUE on errors SIDE EFFECTS : Some binds replaced with specialized calls NOTES : Local variable binds are replaced in ReplaceProcVars (after this routine has had a chance to replace all special binds and remove the names from the parsed bind list) *************************************************************************/ static int ReplaceProcBinds( void *theEnv, EXPRESSION *actions, int (*altbindfunc)(void *,EXPRESSION *,void *), void *userBuffer) { int bcode; SYMBOL_HN *bname; while (actions != NULL) { if (actions->argList != NULL) { if (ReplaceProcBinds(theEnv,actions->argList,altbindfunc,userBuffer)) return(TRUE); if ((actions->value == (void *) FindFunction(theEnv,"bind")) && (actions->argList->type == SYMBOL)) { bname = (SYMBOL_HN *) actions->argList->value; bcode = (*altbindfunc)(theEnv,actions,userBuffer); if (bcode == -1) return(TRUE); if (bcode == 1) RemoveParsedBindName(theEnv,bname); } } actions = actions->nextArg; } return(FALSE); } /***************************************************** NAME : CompactActions DESCRIPTION : Examines a progn expression chain, and if there is only one action, the progn header is deallocated and the action is returned. If there are no actions, the progn expression is modified to be the FALSE symbol and returned. Otherwise, the progn is simply returned. INPUTS : The action expression RETURNS : The compacted expression SIDE EFFECTS : Some expressions possibly deallocated NOTES : Assumes actions is a progn expression and actions->nextArg == NULL *****************************************************/ static EXPRESSION *CompactActions( void *theEnv, EXPRESSION *actions) { register struct expr *tmp; if (actions->argList == NULL) { actions->type = SYMBOL; actions->value = EnvFalseSymbol(theEnv); } else if (actions->argList->nextArg == NULL) { tmp = actions; actions = actions->argList; rtn_struct(theEnv,expr,tmp); } return(actions); } #endif #if (! DEFFUNCTION_CONSTRUCT) || (! DEFGENERIC_CONSTRUCT) /****************************************************** NAME : EvaluateBadCall DESCRIPTION : Default evaluation function for deffunctions and gneric functions in configurations where either capability is not present. INPUTS : 1) The function (ignored) 2) A data object buffer for the result RETURNS : FALSE SIDE EFFECTS : Data object buffer set to the symbol FALSE and evaluation error set NOTES : Used for binary images which contain deffunctions and generic functions which cannot be used ******************************************************/ #if IBM_TBC #pragma argsused #endif static intBool EvaluateBadCall( void *theEnv, void *value, DATA_OBJECT *result) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(value) #endif PrintErrorID(theEnv,"PRCCODE",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Attempted to call a deffunction/generic function "); EnvPrintRouter(theEnv,WERROR,"which does not exist.\n"); SetEvaluationError(theEnv,TRUE); SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return(FALSE); } #endif clips-6.24/clipssrc/genrccmp.h0000755000175000017500000000306007422634612014506 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Function Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_genrccmp #define _H_genrccmp #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include "genrcfun.h" LOCALE void SetupGenericsCompiler(void *); LOCALE void PrintGenericFunctionReference(void *,FILE *,DEFGENERIC *,int,int); LOCALE void DefgenericCModuleReference(void *,FILE *,int,int,int); #endif clips-6.24/clipssrc/._.DS_Store0000400000175000017500000000012210444326120014404 0ustar jfsjfsMac OS X  2 R@clips-6.24/clipssrc/memalloc.h0000755000175000017500000002110410441147760014476 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* MEMORY ALLOCATION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Memory allocation routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_memalloc #include #define _H_memalloc struct chunkInfo; struct blockInfo; struct memoryPtr; struct longMemoryPtr; #define MEM_TABLE_SIZE 500 #ifdef LOCALE #undef LOCALE #endif #ifdef _MEMORY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct chunkInfo { struct chunkInfo *prevChunk; struct chunkInfo *nextFree; struct chunkInfo *lastFree; long int size; }; struct blockInfo { struct blockInfo *nextBlock; struct blockInfo *prevBlock; struct chunkInfo *nextFree; long int size; }; struct memoryPtr { struct memoryPtr *next; }; struct longMemoryPtr { struct longMemoryPtr *prev; struct longMemoryPtr *next; long size; }; #define get_struct(theEnv,type) \ ((MemoryData(theEnv)->MemoryTable[sizeof(struct type)] == NULL) ? \ ((struct type *) genalloc(theEnv,(unsigned) sizeof(struct type))) :\ ((MemoryData(theEnv)->TempMemoryPtr = MemoryData(theEnv)->MemoryTable[sizeof(struct type)]),\ MemoryData(theEnv)->MemoryTable[sizeof(struct type)] = MemoryData(theEnv)->TempMemoryPtr->next,\ ((struct type *) MemoryData(theEnv)->TempMemoryPtr))) #define rtn_struct(theEnv,type,struct_ptr) \ (MemoryData(theEnv)->TempMemoryPtr = (struct memoryPtr *) struct_ptr,\ MemoryData(theEnv)->TempMemoryPtr->next = MemoryData(theEnv)->MemoryTable[sizeof(struct type)], \ MemoryData(theEnv)->MemoryTable[sizeof(struct type)] = MemoryData(theEnv)->TempMemoryPtr) #define rtn_sized_struct(theEnv,size,struct_ptr) \ (MemoryData(theEnv)->TempMemoryPtr = (struct memoryPtr *) struct_ptr,\ MemoryData(theEnv)->TempMemoryPtr->next = MemoryData(theEnv)->MemoryTable[size], \ MemoryData(theEnv)->MemoryTable[size] = MemoryData(theEnv)->TempMemoryPtr) #define get_var_struct(theEnv,type,vsize) \ ((((sizeof(struct type) + vsize) < MEM_TABLE_SIZE) ? \ (MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize] == NULL) : 1) ? \ ((struct type *) genalloc(theEnv,(unsigned) (sizeof(struct type) + vsize))) :\ ((MemoryData(theEnv)->TempMemoryPtr = MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize]),\ MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize] = MemoryData(theEnv)->TempMemoryPtr->next,\ ((struct type *) MemoryData(theEnv)->TempMemoryPtr))) #define rtn_var_struct(theEnv,type,vsize,struct_ptr) \ (MemoryData(theEnv)->TempSize = sizeof(struct type) + vsize, \ ((MemoryData(theEnv)->TempSize < MEM_TABLE_SIZE) ? \ (MemoryData(theEnv)->TempMemoryPtr = (struct memoryPtr *) struct_ptr,\ MemoryData(theEnv)->TempMemoryPtr->next = MemoryData(theEnv)->MemoryTable[MemoryData(theEnv)->TempSize], \ MemoryData(theEnv)->MemoryTable[MemoryData(theEnv)->TempSize] = MemoryData(theEnv)->TempMemoryPtr) : \ (genfree(theEnv,(void *) struct_ptr,(unsigned) MemoryData(theEnv)->TempSize),(struct memoryPtr *) struct_ptr))) #define get_var_struct2(theEnv,type,vsize) \ ((((sizeof(struct type) + vsize) < (unsigned long) MEM_TABLE_SIZE) ? \ (MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize] == NULL) : 1) ? \ ((struct type *) gm3(theEnv,(long) (sizeof(struct type) + vsize))) :\ ((MemoryData(theEnv)->TempMemoryPtr = MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize]),\ MemoryData(theEnv)->MemoryTable[sizeof(struct type) + vsize] = MemoryData(theEnv)->TempMemoryPtr->next,\ ((struct type *) MemoryData(theEnv)->TempMemoryPtr))) #define rtn_var_struct2(theEnv,type,vsize,struct_ptr) \ (MemoryData(theEnv)->TempSize2 = sizeof(struct type) + vsize, \ (((MemoryData(theEnv)->TempSize2 < (unsigned long) MEM_TABLE_SIZE) ? \ (MemoryData(theEnv)->TempMemoryPtr = (struct memoryPtr *) struct_ptr,\ MemoryData(theEnv)->TempMemoryPtr->next = MemoryData(theEnv)->MemoryTable[MemoryData(theEnv)->TempSize2], \ MemoryData(theEnv)->MemoryTable[MemoryData(theEnv)->TempSize2] = MemoryData(theEnv)->TempMemoryPtr) : \ (rm3(theEnv,(void *) struct_ptr,(long) (sizeof(struct type) + vsize)),(struct memoryPtr *) struct_ptr)))) #define GenCopyMemory(type,cnt,dst,src) \ memcpy((void *) (dst),(void *) (src),sizeof(type) * (size_t) (cnt)) #define MEMORY_DATA 59 struct memoryData { long int MemoryAmount; long int MemoryCalls; intBool ConserveMemory; int (*OutOfMemoryFunction)(void *,unsigned long); #if BLOCK_MEMORY struct longMemoryPtr *TopLongMemoryPtr; struct blockInfo *TopMemoryBlock; int BlockInfoSize; int ChunkInfoSize; int BlockMemoryInitialized; #endif struct memoryPtr *TempMemoryPtr; struct memoryPtr **MemoryTable; unsigned int TempSize; unsigned long TempSize2; }; #define MemoryData(theEnv) ((struct memoryData *) GetEnvironmentData(theEnv,MEMORY_DATA)) #if ENVIRONMENT_API_ONLY #define GetConserveMemory(theEnv) EnvGetConserveMemory(theEnv) #define MemRequests(theEnv) EnvMemRequests(theEnv) #define MemUsed(theEnv) EnvMemUsed(theEnv) #define ReleaseMem(theEnv,a,b) EnvReleaseMem(theEnv,a,b) #define SetConserveMemory(theEnv,a) EnvSetConserveMemory(theEnv,a) #define SetOutOfMemoryFunction(theEnv,a) EnvSetOutOfMemoryFunction(theEnv,a) #else #define GetConserveMemory() EnvGetConserveMemory(GetCurrentEnvironment()) #define MemRequests() EnvMemRequests(GetCurrentEnvironment()) #define MemUsed() EnvMemUsed(GetCurrentEnvironment()) #define ReleaseMem(a,b) EnvReleaseMem(GetCurrentEnvironment(),a,b) #define SetConserveMemory(a) EnvSetConserveMemory(GetCurrentEnvironment(),a) #define SetOutOfMemoryFunction(a) EnvSetOutOfMemoryFunction(GetCurrentEnvironment(),a) #endif LOCALE void InitializeMemory(void *); LOCALE void *genalloc(void *,unsigned int); LOCALE int DefaultOutOfMemoryFunction(void *,unsigned long); LOCALE int (*EnvSetOutOfMemoryFunction(void *,int (*)(void *,unsigned long)))(void *,unsigned long); LOCALE int genfree(void *,void *,unsigned int); LOCALE void *genrealloc(void *,void *,unsigned int,unsigned int); LOCALE long EnvMemUsed(void *); LOCALE long EnvMemRequests(void *); LOCALE long UpdateMemoryUsed(void *,long int); LOCALE long UpdateMemoryRequests(void *,long int); LOCALE long EnvReleaseMem(void *,long,int); LOCALE void *gm1(void *,int); LOCALE void *gm2(void *,unsigned int); LOCALE void *gm3(void *,long); LOCALE int rm(void *,void *,unsigned); LOCALE int rm3(void *,void *,long); LOCALE unsigned long PoolSize(void *); LOCALE unsigned long ActualPoolSize(void *); LOCALE void *RequestChunk(void *,unsigned int); LOCALE int ReturnChunk(void *,void *,unsigned int); LOCALE void *genlongalloc(void *,unsigned long); LOCALE int genlongfree(void *,void *,unsigned long); LOCALE intBool EnvSetConserveMemory(void *,intBool); LOCALE intBool EnvGetConserveMemory(void *); LOCALE void genmemcpy(char *,char *,unsigned long); LOCALE void ReturnAllBlocks(void *); #endif clips-6.24/clipssrc/insmoddp.c0000755000175000017500000011133210441072127014512 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INSTANCE MODIFY AND DUPLICATE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Instance modify and duplicate support routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #if DEFRULE_CONSTRUCT #include "network.h" #include "objrtmch.h" #endif #include "argacces.h" #include "memalloc.h" #include "envrnmnt.h" #include "extnfunc.h" #include "inscom.h" #include "insfun.h" #include "insmngr.h" #include "inspsr.h" #include "miscfun.h" #include "msgcom.h" #include "msgfun.h" #include "msgpass.h" #include "prccode.h" #include "router.h" #define _INSMODDP_SOURCE_ #include "insmoddp.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static DATA_OBJECT *EvaluateSlotOverrides(void *,EXPRESSION *,int *,int *); static void DeleteSlotOverrideEvaluations(void *,DATA_OBJECT *,int); static void ModifyMsgHandlerSupport(void *,DATA_OBJECT *,int); static void DuplicateMsgHandlerSupport(void *,DATA_OBJECT *,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if (! RUN_TIME) /*************************************************** NAME : SetupInstanceModDupCommands DESCRIPTION : Defines function interfaces for modify- and duplicate- instance functions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions defined to KB NOTES : None ***************************************************/ globle void SetupInstanceModDupCommands( void *theEnv) { #if DEFRULE_CONSTRUCT EnvDefineFunction2(theEnv,"modify-instance",'u',PTIEF InactiveModifyInstance,"InactiveModifyInstance",NULL); EnvDefineFunction2(theEnv,"active-modify-instance",'u',PTIEF ModifyInstance,"ModifyInstance",NULL); AddFunctionParser(theEnv,"active-modify-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"message-modify-instance",'u',PTIEF InactiveMsgModifyInstance, "InactiveMsgModifyInstance",NULL); EnvDefineFunction2(theEnv,"active-message-modify-instance",'u',PTIEF MsgModifyInstance, "MsgModifyInstance",NULL); AddFunctionParser(theEnv,"active-message-modify-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"duplicate-instance",'u', PTIEF InactiveDuplicateInstance,"InactiveDuplicateInstance",NULL); EnvDefineFunction2(theEnv,"active-duplicate-instance",'u',PTIEF DuplicateInstance,"DuplicateInstance",NULL); AddFunctionParser(theEnv,"active-duplicate-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"message-duplicate-instance",'u',PTIEF InactiveMsgDuplicateInstance, "InactiveMsgDuplicateInstance",NULL); EnvDefineFunction2(theEnv,"active-message-duplicate-instance",'u',PTIEF MsgDuplicateInstance, "MsgDuplicateInstance",NULL); AddFunctionParser(theEnv,"active-message-duplicate-instance",ParseInitializeInstance); #else EnvDefineFunction2(theEnv,"modify-instance",'u',PTIEF ModifyInstance,"ModifyInstance",NULL); EnvDefineFunction2(theEnv,"message-modify-instance",'u',PTIEF MsgModifyInstance, "MsgModifyInstance",NULL); EnvDefineFunction2(theEnv,"duplicate-instance",'u',PTIEF DuplicateInstance,"DuplicateInstance",NULL); EnvDefineFunction2(theEnv,"message-duplicate-instance",'u',PTIEF MsgDuplicateInstance, "MsgDuplicateInstance",NULL); #endif EnvDefineFunction2(theEnv,"(direct-modify)",'u',PTIEF DirectModifyMsgHandler,"DirectModifyMsgHandler",NULL); EnvDefineFunction2(theEnv,"(message-modify)",'u',PTIEF MsgModifyMsgHandler,"MsgModifyMsgHandler",NULL); EnvDefineFunction2(theEnv,"(direct-duplicate)",'u',PTIEF DirectDuplicateMsgHandler,"DirectDuplicateMsgHandler",NULL); EnvDefineFunction2(theEnv,"(message-duplicate)",'u',PTIEF MsgDuplicateMsgHandler,"MsgDuplicateMsgHandler",NULL); AddFunctionParser(theEnv,"modify-instance",ParseInitializeInstance); AddFunctionParser(theEnv,"message-modify-instance",ParseInitializeInstance); AddFunctionParser(theEnv,"duplicate-instance",ParseInitializeInstance); AddFunctionParser(theEnv,"message-duplicate-instance",ParseInitializeInstance); } #endif /************************************************************* NAME : ModifyInstance DESCRIPTION : Modifies slots of an instance via the direct-modify message INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed directly NOTES : H/L Syntax: (modify-instance *) *************************************************************/ globle void ModifyInstance( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; EXPRESSION theExp; DATA_OBJECT *overrides; int oldOMDMV,overrideCount,error; /* =========================================== The slot-overrides need to be evaluated now to resolve any variable references before a new frame is pushed for message-handler execution =========================================== */ overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg, &overrideCount,&error); if (error) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } /* ================================== Find the instance and make sure it wasn't deleted by the overrides ================================== */ ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression))); if (ins == NULL) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } /* ====================================== We are passing the slot override expression information along to whatever message-handler implements the modify ====================================== */ theExp.type = EXTERNAL_ADDRESS; theExp.value = (void *) overrides; theExp.argList = NULL; theExp.nextArg = NULL; oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid; InstanceData(theEnv)->ObjectModDupMsgValid = TRUE; DirectMessage(theEnv,FindSymbolHN(theEnv,DIRECT_MODIFY_STRING),ins,result,&theExp); InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV; DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); } /************************************************************* NAME : MsgModifyInstance DESCRIPTION : Modifies slots of an instance via the direct-modify message INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed with put- messages NOTES : H/L Syntax: (message-modify-instance *) *************************************************************/ globle void MsgModifyInstance( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; EXPRESSION theExp; DATA_OBJECT *overrides; int oldOMDMV,overrideCount,error; /* =========================================== The slot-overrides need to be evaluated now to resolve any variable references before a new frame is pushed for message-handler execution =========================================== */ overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg, &overrideCount,&error); if (error) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } /* ================================== Find the instance and make sure it wasn't deleted by the overrides ================================== */ ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression))); if (ins == NULL) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } /* ====================================== We are passing the slot override expression information along to whatever message-handler implements the modify ====================================== */ theExp.type = EXTERNAL_ADDRESS; theExp.value = (void *) overrides; theExp.argList = NULL; theExp.nextArg = NULL; oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid; InstanceData(theEnv)->ObjectModDupMsgValid = TRUE; DirectMessage(theEnv,FindSymbolHN(theEnv,MSG_MODIFY_STRING),ins,result,&theExp); InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV; DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); } /************************************************************* NAME : DuplicateInstance DESCRIPTION : Duplicates an instance via the direct-duplicate message INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed directly NOTES : H/L Syntax: (duplicate-instance [to ] *) *************************************************************/ globle void DuplicateInstance( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; DATA_OBJECT newName; EXPRESSION theExp[2]; DATA_OBJECT *overrides; int oldOMDMV,overrideCount,error; /* =========================================== The slot-overrides need to be evaluated now to resolve any variable references before a new frame is pushed for message-handler execution =========================================== */ overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg->nextArg, &overrideCount,&error); if (error) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } /* ================================== Find the instance and make sure it wasn't deleted by the overrides ================================== */ ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression))); if (ins == NULL) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } if (EnvArgTypeCheck(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), 2,INSTANCE_NAME,&newName) == FALSE) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } /* ====================================== We are passing the slot override expression information along to whatever message-handler implements the duplicate ====================================== */ theExp[0].type = INSTANCE_NAME; theExp[0].value = newName.value; theExp[0].argList = NULL; theExp[0].nextArg = &theExp[1]; theExp[1].type = EXTERNAL_ADDRESS; theExp[1].value = (void *) overrides; theExp[1].argList = NULL; theExp[1].nextArg = NULL; oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid; InstanceData(theEnv)->ObjectModDupMsgValid = TRUE; DirectMessage(theEnv,FindSymbolHN(theEnv,DIRECT_DUPLICATE_STRING),ins,result,&theExp[0]); InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV; DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); } /************************************************************* NAME : MsgDuplicateInstance DESCRIPTION : Duplicates an instance via the message-duplicate message INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed w/ int & put- messages NOTES : H/L Syntax: (duplicate-instance [to ] *) *************************************************************/ globle void MsgDuplicateInstance( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; DATA_OBJECT newName; EXPRESSION theExp[2]; DATA_OBJECT *overrides; int oldOMDMV,overrideCount,error; /* =========================================== The slot-overrides need to be evaluated now to resolve any variable references before a new frame is pushed for message-handler execution =========================================== */ overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg->nextArg, &overrideCount,&error); if (error) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } /* ================================== Find the instance and make sure it wasn't deleted by the overrides ================================== */ ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression))); if (ins == NULL) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } if (EnvArgTypeCheck(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), 2,INSTANCE_NAME,&newName) == FALSE) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); return; } /* ====================================== We are passing the slot override expression information along to whatever message-handler implements the duplicate ====================================== */ theExp[0].type = INSTANCE_NAME; theExp[0].value = newName.value; theExp[0].argList = NULL; theExp[0].nextArg = &theExp[1]; theExp[1].type = EXTERNAL_ADDRESS; theExp[1].value = (void *) overrides; theExp[1].argList = NULL; theExp[1].nextArg = NULL; oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid; InstanceData(theEnv)->ObjectModDupMsgValid = TRUE; DirectMessage(theEnv,FindSymbolHN(theEnv,MSG_DUPLICATE_STRING),ins,result,&theExp[0]); InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV; DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount); } #if DEFRULE_CONSTRUCT /************************************************************** NAME : InactiveModifyInstance DESCRIPTION : Modifies slots of an instance of a class Pattern-matching is automatically delayed until the slot updates are done INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed directly NOTES : H/L Syntax: (modify-instance *) **************************************************************/ globle void InactiveModifyInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); ModifyInstance(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } /************************************************************** NAME : InactiveMsgModifyInstance DESCRIPTION : Modifies slots of an instance of a class Pattern-matching is automatically delayed until the slot updates are done INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed with put- messages NOTES : H/L Syntax: (message-modify-instance *) **************************************************************/ globle void InactiveMsgModifyInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); MsgModifyInstance(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } /******************************************************************* NAME : InactiveDuplicateInstance DESCRIPTION : Duplicates an instance of a class Pattern-matching is automatically delayed until the slot updates are done INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed directly NOTES : H/L Syntax: (duplicate-instance [to ] *) *******************************************************************/ globle void InactiveDuplicateInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); DuplicateInstance(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } /************************************************************** NAME : InactiveMsgDuplicateInstance DESCRIPTION : Duplicates an instance of a class Pattern-matching is automatically delayed until the slot updates are done INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Slot updates performed with put- messages NOTES : H/L Syntax: (message-duplicate-instance [to ] *) **************************************************************/ globle void InactiveMsgDuplicateInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); MsgDuplicateInstance(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } #endif /***************************************************** NAME : DirectDuplicateMsgHandler DESCRIPTION : Implementation for the USER class handler direct-duplicate Implements duplicate-instance message with a series of direct slot placements INPUTS : A data object buffer to hold the result RETURNS : Nothing useful SIDE EFFECTS : Slot values updated NOTES : None *****************************************************/ globle void DirectDuplicateMsgHandler( void *theEnv, DATA_OBJECT *result) { DuplicateMsgHandlerSupport(theEnv,result,FALSE); } /***************************************************** NAME : MsgDuplicateMsgHandler DESCRIPTION : Implementation for the USER class handler message-duplicate Implements duplicate-instance message with a series of put- messages INPUTS : A data object buffer to hold the result RETURNS : Nothing useful SIDE EFFECTS : Slot values updated NOTES : None *****************************************************/ globle void MsgDuplicateMsgHandler( void *theEnv, DATA_OBJECT *result) { DuplicateMsgHandlerSupport(theEnv,result,TRUE); } /*************************************************** NAME : DirectModifyMsgHandler DESCRIPTION : Implementation for the USER class handler direct-modify Implements modify-instance message with a series of direct slot placements INPUTS : A data object buffer to hold the result RETURNS : Nothing useful SIDE EFFECTS : Slot values updated NOTES : None ***************************************************/ globle void DirectModifyMsgHandler( void *theEnv, DATA_OBJECT *result) { ModifyMsgHandlerSupport(theEnv,result,FALSE); } /*************************************************** NAME : MsgModifyMsgHandler DESCRIPTION : Implementation for the USER class handler message-modify Implements modify-instance message with a series of put- messages INPUTS : A data object buffer to hold the result RETURNS : Nothing useful SIDE EFFECTS : Slot values updated NOTES : None ***************************************************/ globle void MsgModifyMsgHandler( void *theEnv, DATA_OBJECT *result) { ModifyMsgHandlerSupport(theEnv,result,TRUE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : EvaluateSlotOverrides DESCRIPTION : Evaluates the slot-override expressions for modify-instance and duplicate-instance Evaluations are stored in an array of data objects, where the supplementalInfo field points at the name of the slot The data object next fields are used to link the array as well. INPUTS : 1) The slot override expressions 2) A buffer to hold the number of slot overrides 3) A buffer to hold an error flag RETURNS : The slot override data object array SIDE EFFECTS : Data object array allocated and initialized override count and error buffers set NOTES : Slot overrides must be evaluated before calling supporting message-handlers for modify- and duplicate-instance in the event that the overrides contain variable references to an outer frame ***********************************************************/ static DATA_OBJECT *EvaluateSlotOverrides( void *theEnv, EXPRESSION *ovExprs, int *ovCnt, int *error) { DATA_OBJECT *ovs; int ovi; void *slotName; *error = FALSE; /* ========================================== There are two expressions chains for every slot override: one for the slot name and one for the slot value ========================================== */ *ovCnt = CountArguments(ovExprs) / 2; if (*ovCnt == 0) return(NULL); /* =============================================== Evaluate all the slot override names and values and store them in a contiguous array =============================================== */ ovs = (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * (*ovCnt))); ovi = 0; while (ovExprs != NULL) { if (EvaluateExpression(theEnv,ovExprs,&ovs[ovi])) goto EvaluateOverridesError; if (ovs[ovi].type != SYMBOL) { ExpectedTypeError1(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), ovi+1,"slot name"); SetEvaluationError(theEnv,TRUE); goto EvaluateOverridesError; } slotName = ovs[ovi].value; if (ovExprs->nextArg->argList) { if (EvaluateAndStoreInDataObject(theEnv,FALSE,ovExprs->nextArg->argList, &ovs[ovi],TRUE) == FALSE) goto EvaluateOverridesError; } else { SetpDOBegin(&ovs[ovi],1); SetpDOEnd(&ovs[ovi],0); SetpType(&ovs[ovi],MULTIFIELD); SetpValue(&ovs[ovi],ProceduralPrimitiveData(theEnv)->NoParamValue); } ovs[ovi].supplementalInfo = slotName; ovExprs = ovExprs->nextArg->nextArg; ovs[ovi].next = (ovExprs != NULL) ? &ovs[ovi+1] : NULL; ovi++; } return(ovs); EvaluateOverridesError: rm(theEnv,(void *) ovs,(sizeof(DATA_OBJECT) * (*ovCnt))); *error = TRUE; return(NULL); } /********************************************************** NAME : DeleteSlotOverrideEvaluations DESCRIPTION : Deallocates slot override evaluation array INPUTS : 1) The data object array 2) The number of elements RETURNS : Nothing useful SIDE EFFECTS : Deallocates slot override data object array for modify- and duplicate- instance NOTES : None **********************************************************/ static void DeleteSlotOverrideEvaluations( void *theEnv, DATA_OBJECT *ovEvals, int ovCnt) { if (ovEvals != NULL) rm(theEnv,(void *) ovEvals,(sizeof(DATA_OBJECT) * ovCnt)); } /********************************************************** NAME : ModifyMsgHandlerSupport DESCRIPTION : Support routine for DirectModifyMsgHandler and MsgModifyMsgHandler Performs a series of slot updates directly or with messages INPUTS : 1) A data object buffer to hold the result 2) A flag indicating whether to use put- messages or direct placement RETURNS : Nothing useful SIDE EFFECTS : Slots updated (messages sent) NOTES : None **********************************************************/ static void ModifyMsgHandlerSupport( void *theEnv, DATA_OBJECT *result, int msgpass) { DATA_OBJECT *slotOverrides,*newval,temp,junk; EXPRESSION msgExp; INSTANCE_TYPE *ins; INSTANCE_SLOT *insSlot; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (InstanceData(theEnv)->ObjectModDupMsgValid == FALSE) { PrintErrorID(theEnv,"INSMODDP",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Direct/message-modify message valid only in modify-instance.\n"); SetEvaluationError(theEnv,TRUE); return; } InstanceData(theEnv)->ObjectModDupMsgValid = FALSE; ins = GetActiveInstance(theEnv); if (ins->garbage) { StaleInstanceAddress(theEnv,"modify-instance",0); SetEvaluationError(theEnv,TRUE); return; } /* ======================================= Retrieve the slot override data objects passed from ModifyInstance - the slot name is stored in the supplementalInfo field - and the next fields are links ======================================= */ slotOverrides = (DATA_OBJECT *) GetNthMessageArgument(theEnv,1)->value; while (slotOverrides != NULL) { /* =========================================================== No evaluation or error checking needs to be done since this has already been done by EvaluateSlotOverrides() =========================================================== */ insSlot = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) slotOverrides->supplementalInfo); if (insSlot == NULL) { SlotExistError(theEnv,ValueToString(slotOverrides->supplementalInfo),"modify-instance"); SetEvaluationError(theEnv,TRUE); return; } if (msgpass) { msgExp.type = slotOverrides->type; if (msgExp.type != MULTIFIELD) msgExp.value = slotOverrides->value; else msgExp.value = (void *) slotOverrides; msgExp.argList = NULL; msgExp.nextArg = NULL; DirectMessage(theEnv,insSlot->desc->overrideMessage,ins,&temp,&msgExp); if (EvaluationData(theEnv)->EvaluationError || ((temp.type == SYMBOL) && (temp.value == EnvFalseSymbol(theEnv)))) return; } else { if (insSlot->desc->multiple && (slotOverrides->type != MULTIFIELD)) { temp.type = MULTIFIELD; temp.value = EnvCreateMultifield(theEnv,1L); SetDOBegin(temp,1); SetDOEnd(temp,1); SetMFType(temp.value,1,(short) slotOverrides->type); SetMFValue(temp.value,1,slotOverrides->value); newval = &temp; } else newval = slotOverrides; if (PutSlotValue(theEnv,ins,insSlot,newval,&junk,"modify-instance") == FALSE) return; } slotOverrides = slotOverrides->next; } result->value = EnvTrueSymbol(theEnv); } /************************************************************* NAME : DuplicateMsgHandlerSupport DESCRIPTION : Support routine for DirectDuplicateMsgHandler and MsgDuplicateMsgHandler Performs a series of slot updates directly or with messages INPUTS : 1) A data object buffer to hold the result 2) A flag indicating whether to use put- messages or direct placement RETURNS : Nothing useful SIDE EFFECTS : Slots updated (messages sent) NOTES : None *************************************************************/ static void DuplicateMsgHandlerSupport( void *theEnv, DATA_OBJECT *result, int msgpass) { INSTANCE_TYPE *srcins,*dstins; SYMBOL_HN *newName; DATA_OBJECT *slotOverrides; EXPRESSION *valArg,msgExp; unsigned i; int oldMkInsMsgPass; INSTANCE_SLOT *dstInsSlot; DATA_OBJECT temp,junk,*newval; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (InstanceData(theEnv)->ObjectModDupMsgValid == FALSE) { PrintErrorID(theEnv,"INSMODDP",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Direct/message-duplicate message valid only in duplicate-instance.\n"); SetEvaluationError(theEnv,TRUE); return; } InstanceData(theEnv)->ObjectModDupMsgValid = FALSE; /* ================================== Grab the slot override expressions and determine the source instance and the name of the new instance ================================== */ srcins = GetActiveInstance(theEnv); newName = (SYMBOL_HN *) GetNthMessageArgument(theEnv,1)->value; slotOverrides = (DATA_OBJECT *) GetNthMessageArgument(theEnv,2)->value; if (srcins->garbage) { StaleInstanceAddress(theEnv,"duplicate-instance",0); SetEvaluationError(theEnv,TRUE); return; } if (newName == srcins->name) { PrintErrorID(theEnv,"INSMODDP",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Instance copy must have a different name in duplicate-instance.\n"); SetEvaluationError(theEnv,TRUE); return; } /* ========================================== Create an uninitialized new instance of the new name (delete old version - if any) ========================================== */ oldMkInsMsgPass = InstanceData(theEnv)->MkInsMsgPass; InstanceData(theEnv)->MkInsMsgPass = msgpass; dstins = BuildInstance(theEnv,newName,srcins->cls,TRUE); InstanceData(theEnv)->MkInsMsgPass = oldMkInsMsgPass; if (dstins == NULL) return; dstins->busy++; /* ================================ Place slot overrides directly or with put- messages ================================ */ while (slotOverrides != NULL) { /* =========================================================== No evaluation or error checking needs to be done since this has already been done by EvaluateSlotOverrides() =========================================================== */ dstInsSlot = FindInstanceSlot(theEnv,dstins,(SYMBOL_HN *) slotOverrides->supplementalInfo); if (dstInsSlot == NULL) { SlotExistError(theEnv,ValueToString(slotOverrides->supplementalInfo), "duplicate-instance"); goto DuplicateError; } if (msgpass) { msgExp.type = slotOverrides->type; if (msgExp.type != MULTIFIELD) msgExp.value = slotOverrides->value; else msgExp.value = (void *) slotOverrides; msgExp.argList = NULL; msgExp.nextArg = NULL; DirectMessage(theEnv,dstInsSlot->desc->overrideMessage,dstins,&temp,&msgExp); if (EvaluationData(theEnv)->EvaluationError || ((temp.type == SYMBOL) && (temp.value == EnvFalseSymbol(theEnv)))) goto DuplicateError; } else { if (dstInsSlot->desc->multiple && (slotOverrides->type != MULTIFIELD)) { temp.type = MULTIFIELD; temp.value = EnvCreateMultifield(theEnv,1L); SetDOBegin(temp,1); SetDOEnd(temp,1); SetMFType(temp.value,1,(short) slotOverrides->type); SetMFValue(temp.value,1,slotOverrides->value); newval = &temp; } else newval = slotOverrides; if (PutSlotValue(theEnv,dstins,dstInsSlot,newval,&junk,"duplicate-instance") == FALSE) goto DuplicateError; } dstInsSlot->override = TRUE; slotOverrides = slotOverrides->next; } /* ======================================= Copy values from source instance to new directly or with put- messages ======================================= */ for (i = 0 ; i < dstins->cls->localInstanceSlotCount ; i++) { if (dstins->slots[i].override == FALSE) { if (msgpass) { temp.type = (unsigned short) srcins->slots[i].type; temp.value = srcins->slots[i].value; if (temp.type == MULTIFIELD) { SetDOBegin(temp,1); SetDOEnd(temp,GetMFLength(temp.value)); } valArg = ConvertValueToExpression(theEnv,&temp); DirectMessage(theEnv,dstins->slots[i].desc->overrideMessage, dstins,&temp,valArg); ReturnExpression(theEnv,valArg); if (EvaluationData(theEnv)->EvaluationError || ((temp.type == SYMBOL) && (temp.value == EnvFalseSymbol(theEnv)))) goto DuplicateError; } else { temp.type = (unsigned short) srcins->slots[i].type; temp.value = srcins->slots[i].value; if (srcins->slots[i].type == MULTIFIELD) { SetDOBegin(temp,1); SetDOEnd(temp,GetMFLength(srcins->slots[i].value)); } if (PutSlotValue(theEnv,dstins,&dstins->slots[i],&temp,&junk,"duplicate-instance") == FALSE) goto DuplicateError; } } } /* ======================================= Send init message for message-duplicate ======================================= */ if (msgpass) { for (i = 0 ; i < dstins->cls->instanceSlotCount ; i++) dstins->slotAddresses[i]->override = TRUE; dstins->initializeInProgress = 1; DirectMessage(theEnv,MessageHandlerData(theEnv)->INIT_SYMBOL,dstins,result,NULL); } dstins->busy--; if (dstins->garbage) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); } else { result->type = INSTANCE_NAME; result->value = (void *) GetFullInstanceName(theEnv,dstins); } return; DuplicateError: dstins->busy--; QuashInstance(theEnv,dstins); SetEvaluationError(theEnv,TRUE); } #endif clips-6.24/clipssrc/strngfun.h0000755000175000017500000000526010357047750014564 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* STRING FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_strngfun #define _H_strngfun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _STRNGFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define Eval(theEnv,a,b) EnvEval(theEnv,a,b) #define Build(theEnv,a) EnvBuild(theEnv,a) #else #define Eval(a,b) EnvEval(GetCurrentEnvironment(),a,b) #define Build(a) EnvBuild(GetCurrentEnvironment(),a) #endif LOCALE void StringFunctionDefinitions(void *); LOCALE void StrCatFunction(void *,DATA_OBJECT_PTR); LOCALE void SymCatFunction(void *,DATA_OBJECT_PTR); LOCALE long int StrLengthFunction(void *); LOCALE void UpcaseFunction(void *,DATA_OBJECT_PTR); LOCALE void LowcaseFunction(void *,DATA_OBJECT_PTR); LOCALE long int StrCompareFunction(void *); LOCALE void *SubStringFunction(void *); LOCALE void StrIndexFunction(void *,DATA_OBJECT_PTR); LOCALE void EvalFunction(void *,DATA_OBJECT_PTR); LOCALE int EnvEval(void *,char *,DATA_OBJECT_PTR); LOCALE int BuildFunction(void *); LOCALE int EnvBuild(void *,char *); LOCALE void StringToFieldFunction(void *,DATA_OBJECT *); LOCALE void StringToField(void *,char *,DATA_OBJECT *); #endif clips-6.24/clipssrc/._tmpltpsr.c0000400000175000017500000000075410177533463015002 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacocvcv$SIIFTTFD*FMWBBMPSRclips-6.24/clipssrc/analysis.h0000755000175000017500000000341110441127650014525 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* ANALYSIS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Analyzes LHS patterns to check for semantic */ /* errors and to determine variable comparisons and other */ /* tests which must be performed either in the pattern or */ /* join networks. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_analysis #define _H_analysis #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _ANALYSIS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool VariableAnalysis(void *,struct lhsParseNode *); #endif clips-6.24/clipssrc/crstrtgy.h0000755000175000017500000000533210441071550014564 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* CONFLICT RESOLUTION STRATEGY HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Used to determine where a new activation is */ /* placed on the agenda based on the current conflict */ /* resolution strategy (depth, breadth, mea, lex, */ /* simplicity, or complexity). Also provides the */ /* set-strategy and get-strategy commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* compilation flag. */ /* */ /*************************************************************/ #ifndef _H_crstrtgy #define _H_crstrtgy #include "agenda.h" #include "symbol.h" #define DEPTH_STRATEGY 0 #define BREADTH_STRATEGY 1 #define LEX_STRATEGY 2 #define MEA_STRATEGY 3 #define COMPLEXITY_STRATEGY 4 #define SIMPLICITY_STRATEGY 5 #define RANDOM_STRATEGY 6 #define DEFAULT_STRATEGY DEPTH_STRATEGY #ifdef LOCALE #undef LOCALE #endif #ifdef _CRSTRTGY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetStrategy(theEnv) EnvGetStrategy(theEnv) #define SetStrategy(theEnv,a) EnvSetStrategy(theEnv,a) #else #define GetStrategy() EnvGetStrategy(GetCurrentEnvironment()) #define SetStrategy(a) EnvSetStrategy(GetCurrentEnvironment(),a) #endif LOCALE void PlaceActivation(void *,ACTIVATION **,ACTIVATION *); LOCALE int EnvSetStrategy(void *,int); LOCALE int EnvGetStrategy(void *); LOCALE void *SetStrategyCommand(void *); LOCALE void *GetStrategyCommand(void *); #endif clips-6.24/clipssrc/dffctdef.h0000755000175000017500000000766210441111705014455 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFFACTS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_dffctdef #define _H_dffctdef #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #define DEFFACTS_DATA 0 struct deffactsData { struct construct *DeffactsConstruct; int DeffactsModuleIndex; #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DeffactsCodeItem; #endif }; struct deffacts { struct constructHeader header; struct expr *assertList; }; struct deffactsModule { struct defmoduleItemHeader header; }; #define EnvGetDeffactsName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define EnvGetDeffactsPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define EnvDeffactsModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define DeffactsData(theEnv) ((struct deffactsData *) GetEnvironmentData(theEnv,DEFFACTS_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DeffactsModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define FindDeffacts(theEnv,a) EnvFindDeffacts(theEnv,a) #define GetDeffactsName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define GetDeffactsPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetNextDeffacts(theEnv,a) EnvGetNextDeffacts(theEnv,a) #define IsDeffactsDeletable(theEnv,a) EnvIsDeffactsDeletable(theEnv,a) #else #define DeffactsModule(x) GetConstructModuleName((struct constructHeader *) x) #define FindDeffacts(a) EnvFindDeffacts(GetCurrentEnvironment(),a) #define GetDeffactsName(x) GetConstructNameString((struct constructHeader *) x) #define GetDeffactsPPForm(x) GetConstructPPForm(GetCurrentEnvironment(),(struct constructHeader *) x) #define GetNextDeffacts(a) EnvGetNextDeffacts(GetCurrentEnvironment(),a) #define IsDeffactsDeletable(a) EnvIsDeffactsDeletable(GetCurrentEnvironment(),a) #endif LOCALE void InitializeDeffacts(void *); LOCALE void *EnvFindDeffacts(void *,char *); LOCALE void *EnvGetNextDeffacts(void *,void *); LOCALE void CreateInitialFactDeffacts(void); LOCALE intBool EnvIsDeffactsDeletable(void *,void *); LOCALE struct deffactsModule *GetDeffactsModuleItem(void *,struct defmodule *); #endif clips-6.24/clipssrc/prccode.h0000755000175000017500000001005110441150525014314 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_prccode #define _H_prccode #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_symbol #include "symbol.h" #endif typedef struct ProcParamStack { DATA_OBJECT *ParamArray; #if DEFGENERIC_CONSTRUCT EXPRESSION *ParamExpressions; #endif int ParamArraySize; DATA_OBJECT *WildcardValue; void (*UnboundErrFunc)(void *); struct ProcParamStack *nxt; } PROC_PARAM_STACK; #define PROCEDURAL_PRIMITIVE_DATA 37 struct proceduralPrimitiveData { void *NoParamValue; DATA_OBJECT *ProcParamArray; int ProcParamArraySize; EXPRESSION *CurrentProcActions; #if DEFGENERIC_CONSTRUCT EXPRESSION *ProcParamExpressions; #endif PROC_PARAM_STACK *pstack; DATA_OBJECT *WildcardValue; DATA_OBJECT *LocalVarArray; void (*ProcUnboundErrFunc)(void *); ENTITY_RECORD ProcParameterInfo; ENTITY_RECORD ProcWildInfo; ENTITY_RECORD ProcGetInfo; ENTITY_RECORD ProcBindInfo; #if ! DEFFUNCTION_CONSTRUCT ENTITY_RECORD DeffunctionEntityRecord; #endif #if ! DEFGENERIC_CONSTRUCT ENTITY_RECORD GenericEntityRecord; #endif int Oldindex; }; #define ProceduralPrimitiveData(theEnv) ((struct proceduralPrimitiveData *) GetEnvironmentData(theEnv,PROCEDURAL_PRIMITIVE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _PRCCODE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InstallProcedurePrimitives(void *); #if (! BLOAD_ONLY) && (! RUN_TIME) #if DEFFUNCTION_CONSTRUCT || OBJECT_SYSTEM LOCALE EXPRESSION *ParseProcParameters(void *,char *,struct token *,EXPRESSION *, SYMBOL_HN **,int *,int *,int *, int (*)(void *,char *)); #endif LOCALE EXPRESSION *ParseProcActions(void *,char *,char *,struct token *,EXPRESSION *,SYMBOL_HN *, int (*)(void *,EXPRESSION *,void *), int (*)(void *,EXPRESSION *,void *), int *,void *); LOCALE intBool ReplaceProcVars(void *,char *,EXPRESSION *,EXPRESSION *,SYMBOL_HN *, int (*)(void *,EXPRESSION *,void *),void *); #if DEFGENERIC_CONSTRUCT LOCALE EXPRESSION *GenProcWildcardReference(void *,int); #endif #endif LOCALE void PushProcParameters(void *,EXPRESSION *,int,char *,char *,void (*)(void *)); LOCALE void PopProcParameters(void *); #if DEFGENERIC_CONSTRUCT LOCALE EXPRESSION *GetProcParamExpressions(void *); #endif LOCALE void EvaluateProcActions(void *,struct defmodule *,EXPRESSION *,int, DATA_OBJECT *,void (*)(void *)); LOCALE void PrintProcParamArray(void *,char *); LOCALE void GrabProcWildargs(void *,DATA_OBJECT *,int); #endif clips-6.24/clipssrc/._argacces.h0000400000175000017500000000075410441602042014652 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco00llTTFL'FMPSRMWBBLclips-6.24/clipssrc/._classini.c0000400000175000017500000000075410441602062014704 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH MonacoiXZiXZ%x%xTTFL'FMPSRMWBBLclips-6.24/clipssrc/._modulcmp.h0000400000175000017500000000012207422634703014725 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._dffctcmp.c0000400000175000017500000000075410177533433014700 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z$;==TTFT#FMWBBMPSRclips-6.24/clipssrc/._classfun.h0000400000175000017500000000075410441130121014712 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0zTTFSFMWBBMPSRclips-6.24/clipssrc/._factmngr.h0000400000175000017500000000075410441143407014710 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoNN17,,TTFS FMWBBMPSRclips-6.24/clipssrc/._inspsr.h0000400000175000017500000000012207422634725014427 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._dfinsbin.h0000400000175000017500000000012207422634673014707 0ustar jfsjfsMac OS X  2 RTEXT???? clips-6.24/clipssrc/._genrcexe.h0000400000175000017500000000075410441602217014706 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z!"22TTFL+FMPSRMWBBLclips-6.24/clipssrc/._classpsr.h0000400000175000017500000000012207422634560014740 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._msgpass.h0000400000175000017500000000075410441602246014565 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z:TTFL,FMPSRMWBBLclips-6.24/clipssrc/dffnxfun.c0000755000175000017500000010560710441602131014515 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* DEFFUNCTION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "dffnxbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "dffnxcmp.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) #include "constrct.h" #include "cstrcpsr.h" #include "dffnxpsr.h" #include "modulpsr.h" #endif #include "envrnmnt.h" #if (! RUN_TIME) #include "extnfunc.h" #endif #include "dffnxexe.h" #if DEBUGGING_FUNCTIONS #include "watch.h" #endif #include "argacces.h" #include "memalloc.h" #include "cstrccom.h" #include "router.h" #define _DFFNXFUN_SOURCE_ #include "dffnxfun.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PrintDeffunctionCall(void *,char *,void *); static intBool EvaluateDeffunctionCall(void *,void *,DATA_OBJECT *); static void DecrementDeffunctionBusyCount(void *,void *); static void IncrementDeffunctionBusyCount(void *,void *); static void DeallocateDeffunctionData(void *); #if ! RUN_TIME static void DestroyDeffunctionAction(void *,struct constructHeader *,void *); static void *AllocateModule(void *); static void ReturnModule(void *,void *); static intBool ClearDeffunctionsReady(void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) static intBool RemoveAllDeffunctions(void *); static void DeffunctionDeleteError(void *,char *); static void SaveDeffunctionHeaders(void *,void *,char *); static void SaveDeffunctionHeader(void *,struct constructHeader *,void *); static void SaveDeffunctions(void *,void *,char *); #endif #if DEBUGGING_FUNCTIONS static unsigned DeffunctionWatchAccess(void *,int,unsigned,EXPRESSION *); static unsigned DeffunctionWatchPrint(void *,char *,int,EXPRESSION *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupDeffunctions DESCRIPTION : Initializes parsers and access functions for deffunctions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Deffunction environment initialized NOTES : None ***************************************************/ globle void SetupDeffunctions( void *theEnv) { ENTITY_RECORD deffunctionEntityRecord = { "PCALL", PCALL,0,0,1, PrintDeffunctionCall,PrintDeffunctionCall, NULL,EvaluateDeffunctionCall,NULL, DecrementDeffunctionBusyCount,IncrementDeffunctionBusyCount, NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFFUNCTION_DATA,sizeof(struct deffunctionData),DeallocateDeffunctionData); memcpy(&DeffunctionData(theEnv)->DeffunctionEntityRecord,&deffunctionEntityRecord,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&DeffunctionData(theEnv)->DeffunctionEntityRecord,PCALL); DeffunctionData(theEnv)->DeffunctionModuleIndex = RegisterModuleItem(theEnv,"deffunction", #if (! RUN_TIME) AllocateModule,ReturnModule, #else NULL,NULL, #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDeffunctionModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeffunctionCModuleReference, #else NULL, #endif EnvFindDeffunction); DeffunctionData(theEnv)->DeffunctionConstruct = AddConstruct(theEnv,"deffunction","deffunctions", #if (! BLOAD_ONLY) && (! RUN_TIME) ParseDeffunction, #else NULL, #endif EnvFindDeffunction, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDeffunction, SetNextConstruct,EnvIsDeffunctionDeletable, EnvUndeffunction, #if (! BLOAD_ONLY) && (! RUN_TIME) RemoveDeffunction #else NULL #endif ); #if ! RUN_TIME AddClearReadyFunction(theEnv,"deffunction",ClearDeffunctionsReady,0); #if ! BLOAD_ONLY #if DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"deffunction",SYMBOL); #endif AddSaveFunction(theEnv,"deffunction-headers",SaveDeffunctionHeaders,1000); AddSaveFunction(theEnv,"deffunctions",SaveDeffunctions,0); EnvDefineFunction2(theEnv,"undeffunction",'v',PTIEF UndeffunctionCommand,"UndeffunctionCommand","11w"); #endif #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-deffunctions",'v',PTIEF ListDeffunctionsCommand,"ListDeffunctionsCommand","01"); EnvDefineFunction2(theEnv,"ppdeffunction",'v',PTIEF PPDeffunctionCommand,"PPDeffunctionCommand","11w"); #endif EnvDefineFunction2(theEnv,"get-deffunction-list",'m',PTIEF GetDeffunctionListFunction, "GetDeffunctionListFunction","01"); EnvDefineFunction2(theEnv,"deffunction-module",'w',PTIEF GetDeffunctionModuleCommand, "GetDeffunctionModuleCommand","11w"); #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY SetupDeffunctionsBload(theEnv); #endif #if CONSTRUCT_COMPILER SetupDeffunctionCompiler(theEnv); #endif #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"deffunctions",0,&DeffunctionData(theEnv)->WatchDeffunctions,32, DeffunctionWatchAccess,DeffunctionWatchPrint); #endif } /******************************************************/ /* DeallocateDeffunctionData: Deallocates environment */ /* data for the deffunction construct. */ /******************************************************/ static void DeallocateDeffunctionData( void *theEnv) { #if ! RUN_TIME struct deffunctionModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDeffunctionAction,DeffunctionData(theEnv)->DeffunctionModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct deffunctionModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DeffunctionData(theEnv)->DeffunctionModuleIndex); rtn_struct(theEnv,deffunctionModule,theModuleItem); } #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /*****************************************************/ /* DestroyDeffunctionAction: Action used to remove */ /* deffunctions as a result of DestroyEnvironment. */ /*****************************************************/ #if IBM_TBC #pragma argsused #endif static void DestroyDeffunctionAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct deffunctionStruct *theDeffunction = (struct deffunctionStruct *) theConstruct; if (theDeffunction == NULL) return; ReturnPackedExpression(theEnv,theDeffunction->code); DestroyConstructHeader(theEnv,&theDeffunction->header); rtn_struct(theEnv,deffunctionStruct,theDeffunction); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theConstruct,theEnv) #endif #endif } #endif /*************************************************** NAME : EnvFindDeffunction DESCRIPTION : Searches for a deffunction INPUTS : The name of the deffunction (possibly including a module name) RETURNS : Pointer to the deffunction if found, otherwise NULL SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDeffunction( void *theEnv, char *dfnxModuleAndName) { return(FindNamedConstruct(theEnv,dfnxModuleAndName,DeffunctionData(theEnv)->DeffunctionConstruct)); } /*************************************************** NAME : LookupDeffunctionByMdlOrScope DESCRIPTION : Finds a deffunction anywhere (if module is specified) or in current or imported modules INPUTS : The deffunction name RETURNS : The deffunction (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : None ***************************************************/ globle DEFFUNCTION *LookupDeffunctionByMdlOrScope( void *theEnv, char *deffunctionName) { return((DEFFUNCTION *) LookupConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,deffunctionName,TRUE)); } /*************************************************** NAME : LookupDeffunctionInScope DESCRIPTION : Finds a deffunction in current or imported modules (module specifier is not allowed) INPUTS : The deffunction name RETURNS : The deffunction (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : None ***************************************************/ globle DEFFUNCTION *LookupDeffunctionInScope( void *theEnv, char *deffunctionName) { return((DEFFUNCTION *) LookupConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,deffunctionName,FALSE)); } /*************************************************** NAME : EnvUndeffunction DESCRIPTION : External interface routine for removing a deffunction INPUTS : Deffunction pointer RETURNS : FALSE if unsuccessful, TRUE otherwise SIDE EFFECTS : Deffunction deleted, if possible NOTES : None ***************************************************/ globle intBool EnvUndeffunction( void *theEnv, void *vptr) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vptr) #endif #if BLOAD_ONLY || RUN_TIME return(FALSE); #else #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif if (vptr == NULL) return(RemoveAllDeffunctions(theEnv)); if (EnvIsDeffunctionDeletable(theEnv,vptr) == FALSE) return(FALSE); RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr); RemoveDeffunction(theEnv,vptr); return(TRUE); #endif } /**************************************************** NAME : EnvGetNextDeffunction DESCRIPTION : Accesses list of deffunctions INPUTS : Deffunction pointer RETURNS : The next deffunction, or the first deffunction (if input is NULL) SIDE EFFECTS : None NOTES : None ****************************************************/ globle void *EnvGetNextDeffunction( void *theEnv, void *ptr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DeffunctionData(theEnv)->DeffunctionModuleIndex)); } /*************************************************** NAME : EnvIsDeffunctionDeletable DESCRIPTION : Determines if a deffunction is executing or referenced by another expression INPUTS : Deffunction pointer RETURNS : TRUE if the deffunction can be deleted, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDeffunctionDeletable( void *theEnv, void *ptr) { DEFFUNCTION *dptr; if (! ConstructsDeletable(theEnv)) { return FALSE; } dptr = (DEFFUNCTION *) ptr; return(((dptr->busy == 0) && (dptr->executing == 0)) ? TRUE : FALSE); } #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : RemoveDeffunction DESCRIPTION : Removes a deffunction INPUTS : Deffunction pointer RETURNS : Nothing useful SIDE EFFECTS : Deffunction deallocated NOTES : Assumes deffunction is not in use!! ***************************************************/ globle void RemoveDeffunction( void *theEnv, void *vdptr) { DEFFUNCTION *dptr = (DEFFUNCTION *) vdptr; if (dptr == NULL) return; DecrementSymbolCount(theEnv,GetDeffunctionNamePointer((void *) dptr)); ExpressionDeinstall(theEnv,dptr->code); ReturnPackedExpression(theEnv,dptr->code); SetDeffunctionPPForm((void *) dptr,NULL); ClearUserDataList(theEnv,dptr->header.usrData); rtn_struct(theEnv,deffunctionStruct,dptr); } #endif /******************************************************** NAME : UndeffunctionCommand DESCRIPTION : Deletes the named deffunction(s) INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Deffunction(s) removed NOTES : H/L Syntax: (undeffunction | *) ********************************************************/ globle void UndeffunctionCommand( void *theEnv) { UndefconstructCommand(theEnv,"undeffunction",DeffunctionData(theEnv)->DeffunctionConstruct); } /**************************************************************** NAME : GetDeffunctionModuleCommand DESCRIPTION : Determines to which module a deffunction belongs INPUTS : None RETURNS : The symbolic name of the module SIDE EFFECTS : None NOTES : H/L Syntax: (deffunction-module ) ****************************************************************/ globle void *GetDeffunctionModuleCommand( void *theEnv) { return(GetConstructModuleCommand(theEnv,"deffunction-module",DeffunctionData(theEnv)->DeffunctionConstruct)); } #if DEBUGGING_FUNCTIONS /**************************************************** NAME : PPDeffunctionCommand DESCRIPTION : Displays the pretty-print form of a deffunction INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pretty-print form displayed to WDISPLAY logical name NOTES : H/L Syntax: (ppdeffunction ) ****************************************************/ globle void PPDeffunctionCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdeffunction",DeffunctionData(theEnv)->DeffunctionConstruct); } /*************************************************** NAME : ListDeffunctionsCommand DESCRIPTION : Displays all deffunction names INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Deffunction name sprinted NOTES : H/L Interface ***************************************************/ globle void ListDeffunctionsCommand( void *theEnv) { ListConstructCommand(theEnv,"list-deffunctions",DeffunctionData(theEnv)->DeffunctionConstruct); } /*************************************************** NAME : EnvListDeffunctions DESCRIPTION : Displays all deffunction names INPUTS : 1) The logical name of the output 2) The module RETURNS : Nothing useful SIDE EFFECTS : Deffunction name sprinted NOTES : C Interface ***************************************************/ globle void EnvListDeffunctions( void *theEnv, char *logicalName, struct defmodule *theModule) { ListConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,logicalName,theModule); } #endif /*************************************************************** NAME : GetDeffunctionListFunction DESCRIPTION : Groups all deffunction names into a multifield list INPUTS : A data object buffer to hold the multifield result RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : H/L Syntax: (get-deffunction-list []) ***************************************************************/ globle void GetDeffunctionListFunction( void *theEnv, DATA_OBJECT *returnValue) { GetConstructListFunction(theEnv,"get-deffunction-list",returnValue,DeffunctionData(theEnv)->DeffunctionConstruct); } /*************************************************************** NAME : EnvGetDeffunctionList DESCRIPTION : Groups all deffunction names into a multifield list INPUTS : 1) A data object buffer to hold the multifield result 2) The module from which to obtain deffunctions RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : External C access ***************************************************************/ globle void EnvGetDeffunctionList( void *theEnv, DATA_OBJECT *returnValue, struct defmodule *theModule) { GetConstructList(theEnv,returnValue,DeffunctionData(theEnv)->DeffunctionConstruct,theModule); } /******************************************************* NAME : CheckDeffunctionCall DESCRIPTION : Checks the number of arguments passed to a deffunction INPUTS : 1) Deffunction pointer 2) The number of arguments RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Message printed on errors NOTES : None *******************************************************/ globle int CheckDeffunctionCall( void *theEnv, void *vdptr, int args) { DEFFUNCTION *dptr; if (vdptr == NULL) return(FALSE); dptr = (DEFFUNCTION *) vdptr; if (args < dptr->minNumberOfParameters) { if (dptr->maxNumberOfParameters == -1) ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), AT_LEAST,dptr->minNumberOfParameters); else ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), EXACTLY,dptr->minNumberOfParameters); return(FALSE); } else if ((args > dptr->minNumberOfParameters) && (dptr->maxNumberOfParameters != -1)) { ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr), EXACTLY,dptr->minNumberOfParameters); return(FALSE); } return(TRUE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : PrintDeffunctionCall DESCRIPTION : PrintExpression() support function for deffunction calls INPUTS : 1) The output logical name 2) The deffunction RETURNS : Nothing useful SIDE EFFECTS : Call expression printed NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void PrintDeffunctionCall( void *theEnv, char *logName, void *value) { #if DEVELOPER EnvPrintRouter(theEnv,logName,"("); EnvPrintRouter(theEnv,logName,EnvGetDeffunctionName(theEnv,value)); if (GetFirstArgument() != NULL) { EnvPrintRouter(theEnv,logName," "); PrintExpression(theEnv,logName,GetFirstArgument()); } EnvPrintRouter(theEnv,logName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logName) #pragma unused(value) #endif #endif } /******************************************************* NAME : EvaluateDeffunctionCall DESCRIPTION : Primitive support function for calling a deffunction INPUTS : 1) The deffunction 2) A data object buffer to hold the evaluation result RETURNS : FALSE if the deffunction returns the symbol FALSE, TRUE otherwise SIDE EFFECTS : Data obejct buffer set and any side-effects of calling the deffunction NOTES : None *******************************************************/ static intBool EvaluateDeffunctionCall( void *theEnv, void *value, DATA_OBJECT *result) { CallDeffunction(theEnv,(DEFFUNCTION *) value,GetFirstArgument(),result); if ((GetpType(result) == SYMBOL) && (GetpValue(result) == EnvFalseSymbol(theEnv))) return(FALSE); return(TRUE); } /*************************************************** NAME : DecrementDeffunctionBusyCount DESCRIPTION : Lowers the busy count of a deffunction construct INPUTS : The deffunction RETURNS : Nothing useful SIDE EFFECTS : Busy count decremented if a clear is not in progress (see comment) NOTES : None ***************************************************/ static void DecrementDeffunctionBusyCount( void *theEnv, void *value) { /* ============================================== The deffunctions to which expressions in other constructs may refer may already have been deleted - thus, it is important not to modify the busy flag during a clear. ============================================== */ if (! ConstructData(theEnv)->ClearInProgress) ((DEFFUNCTION *) value)->busy--; } /*************************************************** NAME : IncrementDeffunctionBusyCount DESCRIPTION : Raises the busy count of a deffunction construct INPUTS : The deffunction RETURNS : Nothing useful SIDE EFFECTS : Busy count incremented NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void IncrementDeffunctionBusyCount( void *theEnv, void *value) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((DEFFUNCTION *) value)->busy++; } #if ! RUN_TIME /***************************************************** 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)); } /*************************************************** NAME : ReturnModule DESCRIPTION : Removes a deffunction module and all associated deffunctions INPUTS : The deffunction module RETURNS : Nothing useful SIDE EFFECTS : Module and deffunctions deleted NOTES : None ***************************************************/ static void ReturnModule( void *theEnv, void *theItem) { #if (! BLOAD_ONLY) FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DeffunctionData(theEnv)->DeffunctionConstruct); #endif rtn_struct(theEnv,deffunctionModule,theItem); } /*************************************************** NAME : ClearDeffunctionsReady DESCRIPTION : Determines if it is safe to remove all deffunctions Assumes *all* constructs will be deleted - only checks to see if any deffunctions are currently executing INPUTS : None RETURNS : TRUE if no deffunctions are executing, FALSE otherwise SIDE EFFECTS : None NOTES : Used by (clear) and (bload) ***************************************************/ static intBool ClearDeffunctionsReady( void *theEnv) { return((DeffunctionData(theEnv)->ExecutingDeffunction != NULL) ? FALSE : TRUE); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : RemoveAllDeffunctions DESCRIPTION : Removes all deffunctions INPUTS : None RETURNS : TRUE if all deffunctions removed, FALSE otherwise SIDE EFFECTS : Deffunctions removed NOTES : None ***************************************************/ static intBool RemoveAllDeffunctions( void *theEnv) { DEFFUNCTION *dptr,*dtmp; unsigned oldbusy; intBool success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv) == TRUE) return(FALSE); #endif dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); while (dptr != NULL) { if (dptr->executing > 0) { DeffunctionDeleteError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr)); success = FALSE; } else { oldbusy = dptr->busy; ExpressionDeinstall(theEnv,dptr->code); dptr->busy = oldbusy; ReturnPackedExpression(theEnv,dptr->code); dptr->code = NULL; } dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,(void *) dptr); } dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); while (dptr != NULL) { dtmp = dptr; dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,(void *) dptr); if (dtmp->executing == 0) { if (dtmp->busy > 0) { PrintWarningID(theEnv,"DFFNXFUN",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Deffunction "); EnvPrintRouter(theEnv,WWARNING,EnvGetDeffunctionName(theEnv,(void *) dtmp)); EnvPrintRouter(theEnv,WWARNING," only partially deleted due to usage by other constructs.\n"); SetDeffunctionPPForm((void *) dtmp,NULL); success = FALSE; } else { RemoveConstructFromModule(theEnv,(struct constructHeader *) dtmp); RemoveDeffunction(theEnv,dtmp); } } } return(success); } /**************************************************** NAME : DeffunctionDeleteError DESCRIPTION : Prints out an error message when a deffunction deletion attempt fails INPUTS : The deffunction name RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ****************************************************/ static void DeffunctionDeleteError( void *theEnv, char *dfnxName) { CantDeleteItemErrorMessage(theEnv,"deffunction",dfnxName); } /*************************************************** NAME : SaveDeffunctionHeaders DESCRIPTION : Writes out deffunction forward declarations for (save) command INPUTS : The logical output name RETURNS : Nothing useful SIDE EFFECTS : Writes out deffunctions with no body of actions NOTES : Used for deffunctions which are mutually recursive with other constructs ***************************************************/ static void SaveDeffunctionHeaders( void *theEnv, void *theModule, char *logicalName) { DoForAllConstructsInModule(theEnv,theModule,SaveDeffunctionHeader, DeffunctionData(theEnv)->DeffunctionModuleIndex, FALSE,(void *) logicalName); } /*************************************************** NAME : SaveDeffunctionHeader DESCRIPTION : Writes a deffunction forward declaration to the save file INPUTS : 1) The deffunction 2) The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : Defffunction header written NOTES : None ***************************************************/ static void SaveDeffunctionHeader( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { DEFFUNCTION *dfnxPtr = (DEFFUNCTION *) theDeffunction; char *logicalName = (char *) userBuffer; register int i; if (EnvGetDeffunctionPPForm(theEnv,(void *) dfnxPtr) != NULL) { EnvPrintRouter(theEnv,logicalName,"(deffunction "); EnvPrintRouter(theEnv,logicalName,EnvDeffunctionModule(theEnv,(void *) dfnxPtr)); EnvPrintRouter(theEnv,logicalName,"::"); EnvPrintRouter(theEnv,logicalName,EnvGetDeffunctionName(theEnv,(void *) dfnxPtr)); EnvPrintRouter(theEnv,logicalName," ("); for (i = 0 ; i < dfnxPtr->minNumberOfParameters ; i++) { EnvPrintRouter(theEnv,logicalName,"?p"); PrintLongInteger(theEnv,logicalName,(long) i); if (i != dfnxPtr->minNumberOfParameters-1) EnvPrintRouter(theEnv,logicalName," "); } if (dfnxPtr->maxNumberOfParameters == -1) { if (dfnxPtr->minNumberOfParameters != 0) EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,"$?wildargs))\n\n"); } else EnvPrintRouter(theEnv,logicalName,"))\n\n"); } } /*************************************************** NAME : SaveDeffunctions DESCRIPTION : Writes out deffunctions for (save) command INPUTS : The logical output name RETURNS : Nothing useful SIDE EFFECTS : Writes out deffunctions NOTES : None ***************************************************/ static void SaveDeffunctions( void *theEnv, void *theModule, char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DeffunctionData(theEnv)->DeffunctionConstruct); } #endif #if DEBUGGING_FUNCTIONS /****************************************************************** NAME : DeffunctionWatchAccess DESCRIPTION : Parses a list of deffunction names passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set Ignored 2) The value to which to set the trace flags 3) A list of expressions containing the names of the deffunctions for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified deffunctions NOTES : Accessory function for AddWatchItem() ******************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DeffunctionWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(ConstructSetWatchAccess(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,newState,argExprs, EnvGetDeffunctionWatch,EnvSetDeffunctionWatch)); } /*********************************************************************** NAME : DeffunctionWatchPrint DESCRIPTION : Parses a list of deffunction names passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined Ignored 3) A list of expressions containing the names of the deffunctions for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified deffunctions NOTES : Accessory function for AddWatchItem() ***********************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DeffunctionWatchPrint( void *theEnv, char *logName, int code, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(ConstructPrintWatchAccess(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,logName,argExprs, EnvGetDeffunctionWatch,EnvSetDeffunctionWatch)); } /********************************************************* NAME : EnvSetDeffunctionWatch DESCRIPTION : Sets the trace to ON/OFF for the deffunction INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the deffunction RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the deffunction set NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDeffunctionWatch( void *theEnv, unsigned newState, void *dptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((DEFFUNCTION *) dptr)->trace = (unsigned short) newState; } /********************************************************* NAME : EnvGetDeffunctionWatch DESCRIPTION : Determines if trace messages are gnerated when executing deffunction INPUTS : A pointer to the deffunction RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDeffunctionWatch( void *theEnv, void *dptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((DEFFUNCTION *) dptr)->trace); } #endif #endif clips-6.24/clipssrc/._factfun.h0000400000175000017500000000075410443575363014551 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco..e#ooTTFHVFMWBBMPSRclips-6.24/clipssrc/._dffctbin.h0000400000175000017500000000012207422634657014674 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._globldef.h0000400000175000017500000000075410441143651014666 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z1TTFS FMWBBMPSRclips-6.24/clipssrc/._utility.c0000400000175000017500000000075410443377364014622 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacol l <TTFLnFMPSRMWBBLclips-6.24/clipssrc/symbol.c0000755000175000017500000014665210441164077014225 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* SYMBOL MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Manages the atomic data value hash tables for */ /* storing symbols, integers, floats, and bit maps. */ /* Contains routines for adding entries, examining the */ /* hash tables, and performing garbage collection to */ /* remove entries no longer in use. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: CLIPS crashing on AMD64 processor in the */ /* function used to generate a hash value for */ /* integers. DR0871 */ /* */ /* Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* Corrected code generating compilation */ /* warnings. */ /* */ /*************************************************************/ #define _SYMBOL_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "utility.h" #include "argacces.h" #include "symbol.h" /***************/ /* DEFINITIONS */ /***************/ #define FALSE_STRING "FALSE" #define TRUE_STRING "TRUE" #define POSITIVE_INFINITY_STRING "+oo" #define NEGATIVE_INFINITY_STRING "-oo" #define AVERAGE_STRING_SIZE 10 #define AVERAGE_BITMAP_SIZE sizeof(long) #define NUMBER_OF_LONGS_FOR_HASH 25 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void RemoveHashNode(void *,GENERIC_HN *,GENERIC_HN **,int,int); static void AddEphemeralHashNode(void *,GENERIC_HN *,struct ephemeron **, int,int); static void RemoveEphemeralHashNodes(void *,struct ephemeron **, GENERIC_HN **, int,int,int); static char *StringWithinString(char *,char *); static unsigned CommonPrefixLength(char *,char *); static void DeallocateSymbolData(void *); /*******************************************************/ /* InitializeAtomTables: Initializes the SymbolTable, */ /* IntegerTable, and FloatTable. It also initializes */ /* the TrueSymbol and FalseSymbol. */ /*******************************************************/ #if IBM_TBC && (! RUN_TIME) #pragma argsused #endif globle void InitializeAtomTables( void *theEnv, struct symbolHashNode **symbolTable, struct floatHashNode **floatTable, struct integerHashNode **integerTable, struct bitMapHashNode **bitmapTable) { #if ! RUN_TIME #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(symbolTable) #pragma unused(floatTable) #pragma unused(integerTable) #pragma unused(bitmapTable) #endif unsigned long i; #endif AllocateEnvironmentData(theEnv,SYMBOL_DATA,sizeof(struct symbolData),DeallocateSymbolData); #if ! RUN_TIME /*=========================*/ /* Create the hash tables. */ /*=========================*/ SymbolData(theEnv)->SymbolTable = (SYMBOL_HN **) gm3(theEnv,sizeof (SYMBOL_HN *) * SYMBOL_HASH_SIZE); SymbolData(theEnv)->FloatTable = (FLOAT_HN **) gm2(theEnv,(int) sizeof (FLOAT_HN *) * FLOAT_HASH_SIZE); SymbolData(theEnv)->IntegerTable = (INTEGER_HN **) gm2(theEnv,(int) sizeof (INTEGER_HN *) * INTEGER_HASH_SIZE); SymbolData(theEnv)->BitMapTable = (BITMAP_HN **) gm2(theEnv,(int) sizeof (BITMAP_HN *) * BITMAP_HASH_SIZE); /*===================================================*/ /* Initialize all of the hash table entries to NULL. */ /*===================================================*/ for (i = 0; i < SYMBOL_HASH_SIZE; i++) SymbolData(theEnv)->SymbolTable[i] = NULL; for (i = 0; i < FLOAT_HASH_SIZE; i++) SymbolData(theEnv)->FloatTable[i] = NULL; for (i = 0; i < INTEGER_HASH_SIZE; i++) SymbolData(theEnv)->IntegerTable[i] = NULL; for (i = 0; i < BITMAP_HASH_SIZE; i++) SymbolData(theEnv)->BitMapTable[i] = NULL; /*========================*/ /* Predefine some values. */ /*========================*/ SymbolData(theEnv)->TrueSymbolHN = EnvAddSymbol(theEnv,TRUE_STRING); IncrementSymbolCount(SymbolData(theEnv)->TrueSymbolHN); SymbolData(theEnv)->FalseSymbolHN = EnvAddSymbol(theEnv,FALSE_STRING); IncrementSymbolCount(SymbolData(theEnv)->FalseSymbolHN); SymbolData(theEnv)->PositiveInfinity = EnvAddSymbol(theEnv,POSITIVE_INFINITY_STRING); IncrementSymbolCount(SymbolData(theEnv)->PositiveInfinity); SymbolData(theEnv)->NegativeInfinity = EnvAddSymbol(theEnv,NEGATIVE_INFINITY_STRING); IncrementSymbolCount(SymbolData(theEnv)->NegativeInfinity); SymbolData(theEnv)->Zero = EnvAddLong(theEnv,0L); IncrementIntegerCount(SymbolData(theEnv)->Zero); #else SetSymbolTable(theEnv,symbolTable); SetFloatTable(theEnv,floatTable); SetIntegerTable(theEnv,integerTable); SetBitMapTable(theEnv,bitmapTable); #endif } /*************************************************/ /* DeallocateSymbolData: Deallocates environment */ /* data for symbols. */ /*************************************************/ static void DeallocateSymbolData( void *theEnv) { int i; SYMBOL_HN *shPtr, *nextSHPtr; INTEGER_HN *ihPtr, *nextIHPtr; FLOAT_HN *fhPtr, *nextFHPtr; BITMAP_HN *bmhPtr, *nextBMHPtr; struct ephemeron *edPtr, *nextEDPtr; if ((SymbolData(theEnv)->SymbolTable == NULL) || (SymbolData(theEnv)->FloatTable == NULL) || (SymbolData(theEnv)->IntegerTable == NULL) || (SymbolData(theEnv)->BitMapTable == NULL)) { return; } for (i = 0; i < SYMBOL_HASH_SIZE; i++) { shPtr = SymbolData(theEnv)->SymbolTable[i]; while (shPtr != NULL) { nextSHPtr = shPtr->next; if (! shPtr->permanent) { rm(theEnv,shPtr->contents,strlen(shPtr->contents)+1); rtn_struct(theEnv,symbolHashNode,shPtr); } shPtr = nextSHPtr; } } for (i = 0; i < FLOAT_HASH_SIZE; i++) { fhPtr = SymbolData(theEnv)->FloatTable[i]; while (fhPtr != NULL) { nextFHPtr = fhPtr->next; if (! fhPtr->permanent) { rtn_struct(theEnv,floatHashNode,fhPtr); } fhPtr = nextFHPtr; } } for (i = 0; i < INTEGER_HASH_SIZE; i++) { ihPtr = SymbolData(theEnv)->IntegerTable[i]; while (ihPtr != NULL) { nextIHPtr = ihPtr->next; if (! ihPtr->permanent) { rtn_struct(theEnv,integerHashNode,ihPtr); } ihPtr = nextIHPtr; } } for (i = 0; i < BITMAP_HASH_SIZE; i++) { bmhPtr = SymbolData(theEnv)->BitMapTable[i]; while (bmhPtr != NULL) { nextBMHPtr = bmhPtr->next; if (! bmhPtr->permanent) { rm(theEnv,bmhPtr->contents,bmhPtr->size); rtn_struct(theEnv,bitMapHashNode,bmhPtr); } bmhPtr = nextBMHPtr; } } /*=========================================*/ /* Remove the ephemeral symbol structures. */ /*=========================================*/ edPtr = SymbolData(theEnv)->EphemeralSymbolList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } edPtr = SymbolData(theEnv)->EphemeralFloatList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } edPtr = SymbolData(theEnv)->EphemeralIntegerList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } edPtr = SymbolData(theEnv)->EphemeralBitMapList; while (edPtr != NULL) { nextEDPtr = edPtr->next; rtn_struct(theEnv,ephemeron,edPtr); edPtr = nextEDPtr; } /*================================*/ /* Remove the symbol hash tables. */ /*================================*/ #if ! RUN_TIME rm3(theEnv,SymbolData(theEnv)->SymbolTable,sizeof (SYMBOL_HN *) * SYMBOL_HASH_SIZE); genfree(theEnv,SymbolData(theEnv)->FloatTable,(int) sizeof (FLOAT_HN *) * FLOAT_HASH_SIZE); genfree(theEnv,SymbolData(theEnv)->IntegerTable,(int) sizeof (INTEGER_HN *) * INTEGER_HASH_SIZE); genfree(theEnv,SymbolData(theEnv)->BitMapTable,(int) sizeof (BITMAP_HN *) * BITMAP_HASH_SIZE); #endif /*==============================*/ /* Remove binary symbol tables. */ /*==============================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE || BLOAD_INSTANCES || BSAVE_INSTANCES if (SymbolData(theEnv)->SymbolArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->SymbolArray,(long) sizeof(SYMBOL_HN *) * SymbolData(theEnv)->NumberOfSymbols); if (SymbolData(theEnv)->FloatArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->FloatArray,(long) sizeof(FLOAT_HN *) * SymbolData(theEnv)->NumberOfFloats); if (SymbolData(theEnv)->IntegerArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->IntegerArray,(long) sizeof(INTEGER_HN *) * SymbolData(theEnv)->NumberOfIntegers); if (SymbolData(theEnv)->BitMapArray != NULL) rm3(theEnv,(void *) SymbolData(theEnv)->BitMapArray,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps); #endif } /*********************************************************************/ /* EnvAddSymbol: Searches for the string in the symbol table. If the */ /* string is already in the symbol table, then the address of the */ /* string's location in the symbol table is returned. Otherwise, */ /* the string is added to the symbol table and then the address */ /* of the string's location in the symbol table is returned. */ /*********************************************************************/ globle void *EnvAddSymbol( void *theEnv, char *str) { unsigned long tally; size_t length; SYMBOL_HN *past = NULL, *peek; /*====================================*/ /* Get the hash value for the string. */ /*====================================*/ if (str == NULL) { SystemError(theEnv,"SYMBOL",1); EnvExitRouter(theEnv,EXIT_FAILURE); } tally = HashSymbol(str,SYMBOL_HASH_SIZE); peek = SymbolData(theEnv)->SymbolTable[tally]; /*==================================================*/ /* Search for the string in the list of entries for */ /* this symbol table location. If the string is */ /* found, then return the address of the string. */ /*==================================================*/ while (peek != NULL) { if (strcmp(str,peek->contents) == 0) { return((void *) peek); } past = peek; peek = peek->next; } /*==================================================*/ /* Add the string at the end of the list of entries */ /* for this symbol table location. */ /*==================================================*/ peek = get_struct(theEnv,symbolHashNode); if (past == NULL) SymbolData(theEnv)->SymbolTable[tally] = peek; else past->next = peek; length = strlen(str) + 1; peek->contents = (char *) gm2(theEnv,length); peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; strcpy(peek->contents,str); /*================================================*/ /* Add the string to the list of ephemeral items. */ /*================================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&SymbolData(theEnv)->EphemeralSymbolList, sizeof(SYMBOL_HN),AVERAGE_STRING_SIZE); peek->depth = EvaluationData(theEnv)->CurrentEvaluationDepth; /*===================================*/ /* Return the address of the symbol. */ /*===================================*/ return((void *) peek); } /*****************************************************************/ /* FindSymbolHN: Searches for the string in the symbol table and */ /* returns a pointer to it if found, otherwise returns NULL. */ /*****************************************************************/ globle SYMBOL_HN *FindSymbolHN( void *theEnv, char *str) { unsigned long tally; SYMBOL_HN *peek; tally = HashSymbol(str,SYMBOL_HASH_SIZE); for (peek = SymbolData(theEnv)->SymbolTable[tally]; peek != NULL; peek = peek->next) { if (strcmp(str,peek->contents) == 0) { return(peek); } } return(NULL); } /*******************************************************************/ /* EnvAddDouble: Searches for the double in the hash table. If the */ /* double is already in the hash table, then the address of the */ /* double is returned. Otherwise, the double is hashed into the */ /* table and the address of the double is also returned. */ /*******************************************************************/ globle void *EnvAddDouble( void *theEnv, double number) { unsigned tally; FLOAT_HN *past = NULL, *peek; /*====================================*/ /* Get the hash value for the double. */ /*====================================*/ tally = HashFloat(number,FLOAT_HASH_SIZE); peek = SymbolData(theEnv)->FloatTable[tally]; /*==================================================*/ /* Search for the double in the list of entries for */ /* this hash location. If the double is found, */ /* then return the address of the double. */ /*==================================================*/ while (peek != NULL) { if (number == peek->contents) { return((void *) peek); } past = peek; peek = peek->next; } /*=================================================*/ /* Add the float at the end of the list of entries */ /* for this hash location. */ /*=================================================*/ peek = get_struct(theEnv,floatHashNode); if (past == NULL) SymbolData(theEnv)->FloatTable[tally] = peek; else past->next = peek; peek->contents = number; peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; /*===============================================*/ /* Add the float to the list of ephemeral items. */ /*===============================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&SymbolData(theEnv)->EphemeralFloatList, sizeof(FLOAT_HN),0); peek->depth = EvaluationData(theEnv)->CurrentEvaluationDepth; /*==================================*/ /* Return the address of the float. */ /*==================================*/ return((void *) peek); } /****************************************************************/ /* EnvAddLong: Searches for the long in the hash table. If the */ /* long is already in the hash table, then the address of the */ /* long is returned. Otherwise, the long is hashed into the */ /* table and the address of the long is also returned. */ /****************************************************************/ globle void *EnvAddLong( void *theEnv, long int number) { unsigned tally; INTEGER_HN *past = NULL, *peek; /*==================================*/ /* Get the hash value for the long. */ /*==================================*/ tally = HashInteger(number,INTEGER_HASH_SIZE); peek = SymbolData(theEnv)->IntegerTable[tally]; /*================================================*/ /* Search for the long in the list of entries for */ /* this hash location. If the long is found, then */ /* return the address of the long. */ /*================================================*/ while (peek != NULL) { if (number == peek->contents) { return((void *) peek); } past = peek; peek = peek->next; } /*================================================*/ /* Add the long at the end of the list of entries */ /* for this hash location. */ /*================================================*/ peek = get_struct(theEnv,integerHashNode); if (past == NULL) SymbolData(theEnv)->IntegerTable[tally] = peek; else past->next = peek; peek->contents = number; peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; /*=================================================*/ /* Add the integer to the list of ephemeral items. */ /*=================================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&SymbolData(theEnv)->EphemeralIntegerList, sizeof(INTEGER_HN),0); peek->depth = EvaluationData(theEnv)->CurrentEvaluationDepth; /*====================================*/ /* Return the address of the integer. */ /*====================================*/ return((void *) peek); } /*****************************************************************/ /* FindLongHN: Searches for the integer in the integer table and */ /* returns a pointer to it if found, otherwise returns NULL. */ /*****************************************************************/ globle INTEGER_HN *FindLongHN( void *theEnv, long int theLong) { unsigned tally; INTEGER_HN *peek; tally = HashInteger(theLong,INTEGER_HASH_SIZE); for (peek = SymbolData(theEnv)->IntegerTable[tally]; peek != NULL; peek = peek->next) { if (peek->contents == theLong) return(peek); } return(NULL); } /******************************************************************/ /* AddBitMap: Searches for the bitmap in the hash table. If the */ /* bitmap is already in the hash table, then the address of the */ /* bitmap is returned. Otherwise, the bitmap is hashed into the */ /* table and the address of the bitmap is also returned. */ /******************************************************************/ globle void *AddBitMap( void *theEnv, void *vTheBitMap, unsigned size) { char *theBitMap = (char *) vTheBitMap; unsigned tally; unsigned i; BITMAP_HN *past = NULL, *peek; /*====================================*/ /* Get the hash value for the bitmap. */ /*====================================*/ if (theBitMap == NULL) { SystemError(theEnv,"SYMBOL",2); EnvExitRouter(theEnv,EXIT_FAILURE); } tally = HashBitMap(theBitMap,BITMAP_HASH_SIZE,size); peek = SymbolData(theEnv)->BitMapTable[tally]; /*==================================================*/ /* Search for the bitmap in the list of entries for */ /* this hash table location. If the bitmap is */ /* found, then return the address of the bitmap. */ /*==================================================*/ while (peek != NULL) { if (peek->size == size) { for (i = 0; i < size ; i++) { if (peek->contents[i] != theBitMap[i]) break; } if (i == size) return((void *) peek); } past = peek; peek = peek->next; } /*==================================================*/ /* Add the bitmap at the end of the list of entries */ /* for this hash table location. Return the */ /*==================================================*/ peek = get_struct(theEnv,bitMapHashNode); if (past == NULL) SymbolData(theEnv)->BitMapTable[tally] = peek; else past->next = peek; peek->contents = (char *) gm2(theEnv,size); peek->next = NULL; peek->bucket = tally; peek->count = 0; peek->permanent = FALSE; peek->size = (unsigned short) size; for (i = 0; i < size ; i++) peek->contents[i] = theBitMap[i]; /*================================================*/ /* Add the bitmap to the list of ephemeral items. */ /*================================================*/ AddEphemeralHashNode(theEnv,(GENERIC_HN *) peek,&SymbolData(theEnv)->EphemeralBitMapList, sizeof(BITMAP_HN),sizeof(long)); peek->depth = EvaluationData(theEnv)->CurrentEvaluationDepth; /*===================================*/ /* Return the address of the bitmap. */ /*===================================*/ return((void *) peek); } /***************************************************/ /* HashSymbol: Computes a hash value for a symbol. */ /***************************************************/ globle unsigned long HashSymbol( char *word, unsigned long range) { register int i; unsigned long tally = 0; for (i = 0; word[i]; i++) { tally = tally * 127 + word[i]; } return(tally % range); } /*************************************************/ /* HashFloat: Computes a hash value for a float. */ /*************************************************/ globle unsigned HashFloat( double number, unsigned range) { unsigned long tally = 0; char *word; unsigned i; word = (char *) &number; for (i = 0; i < sizeof(double); i++) { tally = tally * 127 + word[i]; } return(tally % range); } /******************************************************/ /* HashInteger: Computes a hash value for an integer. */ /******************************************************/ globle unsigned HashInteger( long int number, unsigned range) { unsigned tally; tally = (labs(number) % range); return(tally); } /***************************************************/ /* HashBitMap: Computes a hash value for a bitmap. */ /***************************************************/ globle unsigned HashBitMap( char *word, unsigned range, unsigned length) { register unsigned k,j,i; unsigned tally; unsigned longLength; unsigned long count = 0L,tmpLong; char *tmpPtr; tmpPtr = (char *) &tmpLong; /*================================================================ */ /* Add up the first part of the word as unsigned long int values. */ /*================================================================ */ longLength = length / sizeof(unsigned long); for (i = 0 , j = 0 ; i < longLength; i++) { for (k = 0 ; k < sizeof(unsigned long) ; k++ , j++) tmpPtr[k] = word[j]; count += tmpLong; } /*============================================*/ /* Add the remaining characters to the count. */ /*============================================*/ for (; j < length; j++) count += (unsigned long) word[j]; /*========================*/ /* Return the hash value. */ /*========================*/ tally = (count % range); return(tally); } /*****************************************************/ /* DecrementSymbolCount: Decrements the count value */ /* for a SymbolTable entry. Adds the symbol to the */ /* EphemeralSymbolList if the count becomes zero. */ /*****************************************************/ globle void DecrementSymbolCount( void *theEnv, SYMBOL_HN *theValue) { if (theValue->count < 0) { SystemError(theEnv,"SYMBOL",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (theValue->count == 0) { SystemError(theEnv,"SYMBOL",4); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&SymbolData(theEnv)->EphemeralSymbolList, sizeof(SYMBOL_HN),AVERAGE_STRING_SIZE); } return; } /***************************************************/ /* DecrementFloatCount: Decrements the count value */ /* for a FloatTable entry. Adds the float to the */ /* EphemeralFloatList if the count becomes zero. */ /***************************************************/ globle void DecrementFloatCount( void *theEnv, FLOAT_HN *theValue) { if (theValue->count <= 0) { SystemError(theEnv,"SYMBOL",5); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&SymbolData(theEnv)->EphemeralFloatList, sizeof(FLOAT_HN),0); } return; } /*********************************************************/ /* DecrementIntegerCount: Decrements the count value for */ /* an IntegerTable entry. Adds the integer to the */ /* EphemeralIntegerList if the count becomes zero. */ /*********************************************************/ globle void DecrementIntegerCount( void *theEnv, INTEGER_HN *theValue) { if (theValue->count <= 0) { SystemError(theEnv,"SYMBOL",6); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&SymbolData(theEnv)->EphemeralIntegerList, sizeof(INTEGER_HN),0); } return; } /*****************************************************/ /* DecrementBitMapCount: Decrements the count value */ /* for a BitmapTable entry. Adds the bitmap to the */ /* EphemeralBitMapList if the count becomes zero. */ /*****************************************************/ globle void DecrementBitMapCount( void *theEnv, BITMAP_HN *theValue) { if (theValue->count < 0) { SystemError(theEnv,"SYMBOL",7); EnvExitRouter(theEnv,EXIT_FAILURE); } if (theValue->count == 0) { SystemError(theEnv,"SYMBOL",8); EnvExitRouter(theEnv,EXIT_FAILURE); } theValue->count--; if (theValue->count != 0) return; if (theValue->markedEphemeral == FALSE) { AddEphemeralHashNode(theEnv,(GENERIC_HN *) theValue,&SymbolData(theEnv)->EphemeralBitMapList, sizeof(BITMAP_HN),sizeof(long)); } return; } /*************************************************************/ /* RemoveHashNode: Removes a hash node from the SymbolTable, */ /* FloatTable, IntegerTable, or BitMapTable. */ /*************************************************************/ static void RemoveHashNode( void *theEnv, GENERIC_HN *theValue, GENERIC_HN **theTable, int size, int type) { GENERIC_HN *previousNode, *currentNode; /*=============================================*/ /* Find the entry in the specified hash table. */ /*=============================================*/ previousNode = NULL; currentNode = theTable[theValue->bucket]; while (currentNode != theValue) { previousNode = currentNode; currentNode = currentNode->next; if (currentNode == NULL) { SystemError(theEnv,"SYMBOL",9); EnvExitRouter(theEnv,EXIT_FAILURE); } } /*===========================================*/ /* Remove the entry from the list of entries */ /* stored in the hash table bucket. */ /*===========================================*/ if (previousNode == NULL) { theTable[theValue->bucket] = theValue->next; } else { previousNode->next = currentNode->next; } /*=================================================*/ /* Symbol and bit map nodes have additional memory */ /* use to store the character or bitmap string. */ /*=================================================*/ if (type == SYMBOL) { rm(theEnv,((SYMBOL_HN *) theValue)->contents, strlen(((SYMBOL_HN *) theValue)->contents) + 1); } else if (type == BITMAPARRAY) { rm(theEnv,((BITMAP_HN *) theValue)->contents, ((BITMAP_HN *) theValue)->size); } /*===========================*/ /* Return the table entry to */ /* the pool of free memory. */ /*===========================*/ rtn_sized_struct(theEnv,size,theValue); } /***********************************************************/ /* AddEphemeralHashNode: Adds a symbol, integer, float, or */ /* bit map table entry to the list of ephemeral atomic */ /* values. These entries have a zero count indicating */ /* that no structure is using the data value. */ /***********************************************************/ static void AddEphemeralHashNode( void *theEnv, GENERIC_HN *theHashNode, struct ephemeron **theEphemeralList, int hashNodeSize, int averageContentsSize) { struct ephemeron *temp; /*===========================================*/ /* If the count isn't zero then this routine */ /* should never have been called. */ /*===========================================*/ if (theHashNode->count != 0) { SystemError(theEnv,"SYMBOL",10); EnvExitRouter(theEnv,EXIT_FAILURE); } /*=====================================*/ /* Mark the atomic value as ephemeral. */ /*=====================================*/ theHashNode->markedEphemeral = TRUE; /*=============================*/ /* Add the atomic value to the */ /* list of ephemeral values. */ /*=============================*/ temp = get_struct(theEnv,ephemeron); temp->associatedValue = theHashNode; temp->next = *theEphemeralList; *theEphemeralList = temp; /*=========================================================*/ /* Increment the ephemeral count and size variables. These */ /* variables are used by the garbage collection routines */ /* to determine when garbage collection should occur. */ /*=========================================================*/ UtilityData(theEnv)->EphemeralItemCount++; UtilityData(theEnv)->EphemeralItemSize += sizeof(struct ephemeron) + hashNodeSize + averageContentsSize; } /***************************************************/ /* RemoveEphemeralAtoms: Causes the removal of all */ /* ephemeral symbols, integers, floats, and bit */ /* maps that still have a count value of zero, */ /* from their respective storage tables. */ /***************************************************/ globle void RemoveEphemeralAtoms( void *theEnv) { RemoveEphemeralHashNodes(theEnv,&SymbolData(theEnv)->EphemeralSymbolList,(GENERIC_HN **) SymbolData(theEnv)->SymbolTable, sizeof(SYMBOL_HN),SYMBOL,AVERAGE_STRING_SIZE); RemoveEphemeralHashNodes(theEnv,&SymbolData(theEnv)->EphemeralFloatList,(GENERIC_HN **) SymbolData(theEnv)->FloatTable, sizeof(FLOAT_HN),FLOAT,0); RemoveEphemeralHashNodes(theEnv,&SymbolData(theEnv)->EphemeralIntegerList,(GENERIC_HN **) SymbolData(theEnv)->IntegerTable, sizeof(INTEGER_HN),INTEGER,0); RemoveEphemeralHashNodes(theEnv,&SymbolData(theEnv)->EphemeralBitMapList,(GENERIC_HN **) SymbolData(theEnv)->BitMapTable, sizeof(BITMAP_HN),BITMAPARRAY,AVERAGE_BITMAP_SIZE); } /****************************************************************/ /* RemoveEphemeralHashNodes: Removes symbols from the ephemeral */ /* symbol list that have a count of zero and were placed on */ /* the list at a higher level than the current evaluation */ /* depth. Since symbols are ordered in the list in descending */ /* order, the removal process can end when a depth is reached */ /* less than the current evaluation depth. Because ephemeral */ /* symbols can be "pulled" up through an evaluation depth, */ /* this routine needs to check through both the previous and */ /* current evaluation depth. */ /****************************************************************/ static void RemoveEphemeralHashNodes( void *theEnv, struct ephemeron **theEphemeralList, GENERIC_HN **theTable, int hashNodeSize, int hashNodeType, int averageContentsSize) { struct ephemeron *edPtr, *lastPtr = NULL, *nextPtr; edPtr = *theEphemeralList; while (edPtr != NULL) { /*======================================================*/ /* Check through previous and current evaluation depth */ /* because these symbols can be interspersed, otherwise */ /* symbols are stored in descending evaluation depth. */ /*======================================================*/ nextPtr = edPtr->next; /*==================================================*/ /* Remove any symbols that have a count of zero and */ /* were added to the ephemeral list at a higher */ /* evaluation depth. */ /*==================================================*/ if ((edPtr->associatedValue->count == 0) && (edPtr->associatedValue->depth > EvaluationData(theEnv)->CurrentEvaluationDepth)) { RemoveHashNode(theEnv,edPtr->associatedValue,theTable,hashNodeSize,hashNodeType); rtn_struct(theEnv,ephemeron,edPtr); if (lastPtr == NULL) *theEphemeralList = nextPtr; else lastPtr->next = nextPtr; UtilityData(theEnv)->EphemeralItemCount--; UtilityData(theEnv)->EphemeralItemSize -= sizeof(struct ephemeron) + hashNodeSize + averageContentsSize; } /*=======================================*/ /* Remove ephemeral status of any symbol */ /* with a count greater than zero. */ /*=======================================*/ else if (edPtr->associatedValue->count > 0) { edPtr->associatedValue->markedEphemeral = FALSE; rtn_struct(theEnv,ephemeron,edPtr); if (lastPtr == NULL) *theEphemeralList = nextPtr; else lastPtr->next = nextPtr; UtilityData(theEnv)->EphemeralItemCount--; UtilityData(theEnv)->EphemeralItemSize -= sizeof(struct ephemeron) + hashNodeSize + averageContentsSize; } /*==================================================*/ /* Otherwise keep the symbol in the ephemeral list. */ /*==================================================*/ else { lastPtr = edPtr; } edPtr = nextPtr; } } /*********************************************************/ /* GetSymbolTable: Returns a pointer to the SymbolTable. */ /*********************************************************/ globle SYMBOL_HN **GetSymbolTable( void *theEnv) { return(SymbolData(theEnv)->SymbolTable); } /******************************************************/ /* SetSymbolTable: Sets the value of the SymbolTable. */ /******************************************************/ globle void SetSymbolTable( void *theEnv, SYMBOL_HN **value) { SymbolData(theEnv)->SymbolTable = value; } /*******************************************************/ /* GetFloatTable: Returns a pointer to the FloatTable. */ /*******************************************************/ globle FLOAT_HN **GetFloatTable( void *theEnv) { return(SymbolData(theEnv)->FloatTable); } /****************************************************/ /* SetFloatTable: Sets the value of the FloatTable. */ /****************************************************/ globle void SetFloatTable( void *theEnv, FLOAT_HN **value) { SymbolData(theEnv)->FloatTable = value; } /***********************************************************/ /* GetIntegerTable: Returns a pointer to the IntegerTable. */ /***********************************************************/ globle INTEGER_HN **GetIntegerTable( void *theEnv) { return(SymbolData(theEnv)->IntegerTable); } /********************************************************/ /* SetIntegerTable: Sets the value of the IntegerTable. */ /********************************************************/ globle void SetIntegerTable( void *theEnv, INTEGER_HN **value) { SymbolData(theEnv)->IntegerTable = value; } /*********************************************************/ /* GetBitMapTable: Returns a pointer to the BitMapTable. */ /*********************************************************/ globle BITMAP_HN **GetBitMapTable( void *theEnv) { return(SymbolData(theEnv)->BitMapTable); } /******************************************************/ /* SetBitMapTable: Sets the value of the BitMapTable. */ /******************************************************/ globle void SetBitMapTable( void *theEnv, BITMAP_HN **value) { SymbolData(theEnv)->BitMapTable = value; } /******************************************************/ /* RefreshSpecialSymbols: Resets the values of the */ /* TrueSymbol, FalseSymbol, Zero, PositiveInfinity, */ /* and NegativeInfinity symbols. */ /******************************************************/ globle void RefreshSpecialSymbols( void *theEnv) { SymbolData(theEnv)->TrueSymbolHN = (void *) FindSymbolHN(theEnv,TRUE_STRING); SymbolData(theEnv)->FalseSymbolHN = (void *) FindSymbolHN(theEnv,FALSE_STRING); SymbolData(theEnv)->PositiveInfinity = (void *) FindSymbolHN(theEnv,POSITIVE_INFINITY_STRING); SymbolData(theEnv)->NegativeInfinity = (void *) FindSymbolHN(theEnv,NEGATIVE_INFINITY_STRING); SymbolData(theEnv)->Zero = (void *) FindLongHN(theEnv,0L); } /***********************************************************/ /* FindSymbolMatches: Finds all symbols in the SymbolTable */ /* which begin with a specified symbol. This function is */ /* used to implement the command completion feature */ /* found in some of the machine specific interfaces. */ /***********************************************************/ globle struct symbolMatch *FindSymbolMatches( void *theEnv, char *searchString, unsigned *numberOfMatches, unsigned *commonPrefixLength) { struct symbolMatch *reply = NULL, *temp; struct symbolHashNode *hashPtr = NULL; unsigned searchLength; searchLength = strlen(searchString); *numberOfMatches = 0; while ((hashPtr = GetNextSymbolMatch(theEnv,searchString,searchLength,hashPtr, FALSE,commonPrefixLength)) != NULL) { *numberOfMatches = *numberOfMatches + 1; temp = get_struct(theEnv,symbolMatch); temp->match = hashPtr; temp->next = reply; reply = temp; } return(reply); } /*********************************************************/ /* ReturnSymbolMatches: Returns a set of symbol matches. */ /*********************************************************/ globle void ReturnSymbolMatches( void *theEnv, struct symbolMatch *listOfMatches) { struct symbolMatch *temp; while (listOfMatches != NULL) { temp = listOfMatches->next; rtn_struct(theEnv,symbolMatch,listOfMatches); listOfMatches = temp; } } /***************************************************************/ /* ClearBitString: Initializes the values of a bitmap to zero. */ /***************************************************************/ globle void ClearBitString( void *vTheBitMap, unsigned length) { char *theBitMap = (char *) vTheBitMap; unsigned i; for (i = 0; i < length; i++) theBitMap[i] = '\0'; } /*****************************************************************/ /* GetNextSymbolMatch: Finds the next symbol in the SymbolTable */ /* which begins with a specified symbol. This function is used */ /* to implement the command completion feature found in some */ /* of the machine specific interfaces. */ /*****************************************************************/ globle SYMBOL_HN *GetNextSymbolMatch( void *theEnv, char *searchString, unsigned searchLength, SYMBOL_HN *prevSymbol, int anywhere, unsigned *commonPrefixLength) { register unsigned long i; SYMBOL_HN *hashPtr; int flag = TRUE; unsigned prefixLength; /*==========================================*/ /* If we're looking anywhere in the string, */ /* then there's no common prefix length. */ /*==========================================*/ if (anywhere && (commonPrefixLength != NULL)) *commonPrefixLength = 0; /*========================================================*/ /* If we're starting the search from the beginning of the */ /* symbol table, the previous symbol argument is NULL. */ /*========================================================*/ if (prevSymbol == NULL) { i = 0; hashPtr = SymbolData(theEnv)->SymbolTable[0]; } /*==========================================*/ /* Otherwise start the search at the symbol */ /* after the last symbol found. */ /*==========================================*/ else { i = prevSymbol->bucket; hashPtr = prevSymbol->next; } /*==============================================*/ /* Search through all the symbol table buckets. */ /*==============================================*/ while (flag) { /*===================================*/ /* Search through all of the entries */ /* in the bucket being examined. */ /*===================================*/ for (; hashPtr != NULL; hashPtr = hashPtr->next) { /*================================================*/ /* Skip symbols that being with ( since these are */ /* typically symbols for internal use. Also skip */ /* any symbols that are marked ephemeral since */ /* these aren't in use. */ /*================================================*/ if ((hashPtr->contents[0] == '(') || (hashPtr->markedEphemeral)) { continue; } /*==================================================*/ /* Two types of matching can be performed: the type */ /* comparing just to the beginning of the string */ /* and the type which looks for the substring */ /* anywhere within the string being examined. */ /*==================================================*/ if (! anywhere) { /*=============================================*/ /* Determine the common prefix length between */ /* the previously found match (if available or */ /* the search string if not) and the symbol */ /* table entry. */ /*=============================================*/ if (prevSymbol != NULL) prefixLength = CommonPrefixLength(prevSymbol->contents,hashPtr->contents); else prefixLength = CommonPrefixLength(searchString,hashPtr->contents); /*===================================================*/ /* If the prefix length is greater than or equal to */ /* the length of the search string, then we've found */ /* a match. If this is the first match, the common */ /* prefix length is set to the length of the first */ /* match, otherwise the common prefix length is the */ /* smallest prefix length found among all matches. */ /*===================================================*/ if (prefixLength >= searchLength) { if (commonPrefixLength != NULL) { if (prevSymbol == NULL) *commonPrefixLength = strlen(hashPtr->contents); else if (prefixLength < *commonPrefixLength) *commonPrefixLength = prefixLength; } return(hashPtr); } } else { if (StringWithinString(hashPtr->contents,searchString) != NULL) { return(hashPtr); } } } /*=================================================*/ /* Move on to the next bucket in the symbol table. */ /*=================================================*/ if (++i >= SYMBOL_HASH_SIZE) flag = FALSE; else hashPtr = SymbolData(theEnv)->SymbolTable[i]; } /*=====================================*/ /* There are no more matching symbols. */ /*=====================================*/ return(NULL); } /**********************************************/ /* StringWithinString: Determines if a string */ /* is contained within another string. */ /**********************************************/ static char *StringWithinString( char *cs, char *ct) { register unsigned i,j,k; for (i = 0 ; cs[i] != '\0' ; i++) { for (j = i , k = 0 ; ct[k] != '\0' && cs[j] == ct[k] ; j++, k++) ; if ((ct[k] == '\0') && (k != 0)) return(cs + i); } return(NULL); } /************************************************/ /* CommonPrefixLength: Determines the length of */ /* the maximumcommon prefix of two strings */ /************************************************/ static unsigned CommonPrefixLength( char *cs, char *ct) { register unsigned i; for (i = 0 ; (cs[i] != '\0') && (ct[i] != '\0') ; i++) if (cs[i] != ct[i]) break; return(i); } #if BLOAD_AND_BSAVE || CONSTRUCT_COMPILER || BSAVE_INSTANCES /****************************************************************/ /* SetAtomicValueIndices: Sets the bucket values for hash table */ /* entries with an index value that indicates the position of */ /* the hash table in a hash table traversal (e.g. this is the */ /* fifth entry in the hash table. */ /****************************************************************/ globle void SetAtomicValueIndices( void *theEnv, int setAll) { unsigned long count; unsigned long i; SYMBOL_HN *symbolPtr, **symbolArray; FLOAT_HN *floatPtr, **floatArray; INTEGER_HN *integerPtr, **integerArray; BITMAP_HN *bitMapPtr, **bitMapArray; /*===================================*/ /* Set indices for the symbol table. */ /*===================================*/ count = 0; symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { if ((symbolPtr->neededSymbol == TRUE) || setAll) { symbolPtr->bucket = count++; if (symbolPtr->bucket != (count - 1)) { SystemError(theEnv,"SYMBOL",667); } } } } /*==================================*/ /* Set indices for the float table. */ /*==================================*/ count = 0; floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { if ((floatPtr->neededFloat == TRUE) || setAll) { floatPtr->bucket = count++; if (floatPtr->bucket != (count - 1)) { SystemError(theEnv,"SYMBOL",668); } } } } /*====================================*/ /* Set indices for the integer table. */ /*====================================*/ count = 0; integerArray = GetIntegerTable(theEnv); for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { if ((integerPtr->neededInteger == TRUE) || setAll) { integerPtr->bucket = count++; if (integerPtr->bucket != (count - 1)) { SystemError(theEnv,"SYMBOL",669); } } } } /*===================================*/ /* Set indices for the bitmap table. */ /*===================================*/ count = 0; bitMapArray = GetBitMapTable(theEnv); for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { if ((bitMapPtr->neededBitMap == TRUE) || setAll) { bitMapPtr->bucket = count++; if (bitMapPtr->bucket != (count - 1)) { SystemError(theEnv,"SYMBOL",670); } } } } } /***********************************************************************/ /* RestoreAtomicValueBuckets: Restores the bucket values of hash table */ /* entries to the appropriate values. Normally called to undo the */ /* effects of a call to the SetAtomicValueIndices function. */ /***********************************************************************/ globle void RestoreAtomicValueBuckets( void *theEnv) { unsigned long i; SYMBOL_HN *symbolPtr, **symbolArray; FLOAT_HN *floatPtr, **floatArray; INTEGER_HN *integerPtr, **integerArray; BITMAP_HN *bitMapPtr, **bitMapArray; /*================================================*/ /* Restore the bucket values in the symbol table. */ /*================================================*/ symbolArray = GetSymbolTable(theEnv); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next) { symbolPtr->bucket = i; } } /*===============================================*/ /* Restore the bucket values in the float table. */ /*===============================================*/ floatArray = GetFloatTable(theEnv); for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next) { floatPtr->bucket = i; } } /*=================================================*/ /* Restore the bucket values in the integer table. */ /*=================================================*/ integerArray = GetIntegerTable(theEnv); for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next) { integerPtr->bucket = i; } } /*================================================*/ /* Restore the bucket values in the bitmap table. */ /*================================================*/ bitMapArray = GetBitMapTable(theEnv); for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next) { bitMapPtr->bucket = i; } } } #endif /* BLOAD_AND_BSAVE || CONSTRUCT_COMPILER || BSAVE_INSTANCES */ clips-6.24/clipssrc/cstrnpsr.h0000755000175000017500000000626310441131522014561 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for parsing constraint */ /* declarations. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_cstrnpsr #define _H_cstrnpsr #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct constraintParseRecord { unsigned int type : 1; unsigned int range : 1; unsigned int allowedSymbols : 1; unsigned int allowedStrings : 1; unsigned int allowedLexemes : 1; unsigned int allowedFloats : 1; unsigned int allowedIntegers : 1; unsigned int allowedNumbers : 1; unsigned int allowedValues : 1; unsigned int allowedClasses : 1; unsigned int allowedInstanceNames : 1; unsigned int cardinality : 1; }; typedef struct constraintParseRecord CONSTRAINT_PARSE_RECORD; LOCALE intBool CheckConstraintParseConflicts(void *,CONSTRAINT_RECORD *); LOCALE void AttributeConflictErrorMessage(void *,char *,char *); #if (! RUN_TIME) && (! BLOAD_ONLY) LOCALE void InitializeConstraintParseRecord(CONSTRAINT_PARSE_RECORD *); LOCALE intBool StandardConstraint(char *); LOCALE intBool ParseStandardConstraint(void *,char *,char *, CONSTRAINT_RECORD *, CONSTRAINT_PARSE_RECORD *, int); LOCALE void OverlayConstraint(void *,CONSTRAINT_PARSE_RECORD *, CONSTRAINT_RECORD *,CONSTRAINT_RECORD *); LOCALE void OverlayConstraintParseRecord(CONSTRAINT_PARSE_RECORD *, CONSTRAINT_PARSE_RECORD *); #endif #endif clips-6.24/clipssrc/globlbin.h0000755000175000017500000000431007422634736014506 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFGLOBAL BINARY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_globlbin #define _H_globlbin #include "modulbin.h" #include "cstrcbin.h" #include "globldef.h" struct bsaveDefglobal { struct bsaveConstructHeader header; long initial; }; struct bsaveDefglobalModule { struct bsaveDefmoduleItemHeader header; }; #define GLOBLBIN_DATA 60 struct defglobalBinaryData { struct defglobal *DefglobalArray; long NumberOfDefglobals; struct defglobalModule *ModuleArray; long NumberOfDefglobalModules; }; #define DefglobalBinaryData(theEnv) ((struct defglobalBinaryData *) GetEnvironmentData(theEnv,GLOBLBIN_DATA)) #define DefglobalPointer(i) ((struct defglobal *) (&DefglobalBinaryData(theEnv)->DefglobalArray[i])) #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefglobalBinarySetup(void *); LOCALE void *BloadDefglobalModuleReference(void *,int); #ifndef _GLOBLBIN_SOURCE_ extern struct defglobal *DefglobalArray; #endif #endif clips-6.24/clipssrc/._default.h0000400000175000017500000000075410441166600014533 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoFfiFfi߿\\TTF/B#FMPSRMWBBLclips-6.24/clipssrc/symbol.h0000755000175000017500000002534110441161336014214 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* SYMBOL HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Manages the atomic data value hash tables for */ /* storing symbols, integers, floats, and bit maps. */ /* Contains routines for adding entries, examining the */ /* hash tables, and performing garbage collection to */ /* remove entries no longer in use. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /*************************************************************/ #ifndef _H_symbol #define _H_symbol #ifdef LOCALE #undef LOCALE #endif #ifdef _SYMBOL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef SYMBOL_HASH_SIZE #define SYMBOL_HASH_SIZE 63559L #endif #ifndef FLOAT_HASH_SIZE #define FLOAT_HASH_SIZE 8191 #endif #ifndef INTEGER_HASH_SIZE #define INTEGER_HASH_SIZE 8191 #endif #ifndef BITMAP_HASH_SIZE #define BITMAP_HASH_SIZE 8191 #endif /************************************************************/ /* symbolHashNode STRUCTURE: */ /************************************************************/ struct symbolHashNode { struct symbolHashNode *next; long count; int depth; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededSymbol : 1; unsigned int bucket : 29; char *contents; }; /************************************************************/ /* floatHashNode STRUCTURE: */ /************************************************************/ struct floatHashNode { struct floatHashNode *next; long count; int depth; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededFloat : 1; unsigned int bucket : 29; double contents; }; /************************************************************/ /* integerHashNode STRUCTURE: */ /************************************************************/ struct integerHashNode { struct integerHashNode *next; long count; int depth; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededInteger : 1; unsigned int bucket : 29; long int contents; }; /************************************************************/ /* bitMapHashNode STRUCTURE: */ /************************************************************/ struct bitMapHashNode { struct bitMapHashNode *next; long count; int depth; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int neededBitMap : 1; unsigned int bucket : 29; char *contents; unsigned short size; }; /************************************************************/ /* genericHashNode STRUCTURE: */ /************************************************************/ struct genericHashNode { struct genericHashNode *next; long count; int depth; unsigned int permanent : 1; unsigned int markedEphemeral : 1; unsigned int needed : 1; unsigned int bucket : 29; }; typedef struct symbolHashNode SYMBOL_HN; typedef struct floatHashNode FLOAT_HN; typedef struct integerHashNode INTEGER_HN; typedef struct bitMapHashNode BITMAP_HN; typedef struct genericHashNode GENERIC_HN; /**********************************************************/ /* EPHEMERON STRUCTURE: Data structure used to keep track */ /* of ephemeral symbols, floats, and integers. */ /* */ /* associatedValue: Contains a pointer to the storage */ /* structure for the symbol, float, or integer which is */ /* ephemeral. */ /* */ /* next: Contains a pointer to the next ephemeral item */ /* in a list of ephemeral items. */ /**********************************************************/ struct ephemeron { GENERIC_HN *associatedValue; struct ephemeron *next; }; /************************************************************/ /* symbolMatch STRUCTURE: */ /************************************************************/ struct symbolMatch { struct symbolHashNode *match; struct symbolMatch *next; }; #define ValueToString(target) (((struct symbolHashNode *) (target))->contents) #define ValueToDouble(target) (((struct floatHashNode *) (target))->contents) #define ValueToLong(target) (((struct integerHashNode *) (target))->contents) #define ValueToInteger(target) ((int) (((struct integerHashNode *) (target))->contents)) #define ValueToBitMap(target) ((void *) ((struct bitMapHashNode *) (target))->contents) #define EnvValueToString(theEnv,target) (((struct symbolHashNode *) (target))->contents) #define EnvValueToDouble(theEnv,target) (((struct floatHashNode *) (target))->contents) #define EnvValueToLong(theEnv,target) (((struct integerHashNode *) (target))->contents) #define EnvValueToInteger(theEnv,target) ((int) (((struct integerHashNode *) (target))->contents)) #define EnvValueToBitMap(theEnv,target) ((void *) ((struct bitMapHashNode *) (target))->contents) #define IncrementSymbolCount(theValue) (((SYMBOL_HN *) theValue)->count++) #define IncrementFloatCount(theValue) (((FLOAT_HN *) theValue)->count++) #define IncrementIntegerCount(theValue) (((INTEGER_HN *) theValue)->count++) #define IncrementBitMapCount(theValue) (((BITMAP_HN *) theValue)->count++) /*==================*/ /* ENVIRONMENT DATA */ /*==================*/ #define SYMBOL_DATA 49 struct symbolData { void *TrueSymbolHN; void *FalseSymbolHN; void *PositiveInfinity; void *NegativeInfinity; void *Zero; SYMBOL_HN **SymbolTable; FLOAT_HN **FloatTable; INTEGER_HN **IntegerTable; BITMAP_HN **BitMapTable; struct ephemeron *EphemeralSymbolList; struct ephemeron *EphemeralFloatList; struct ephemeron *EphemeralIntegerList; struct ephemeron *EphemeralBitMapList; #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE || BLOAD_INSTANCES || BSAVE_INSTANCES long NumberOfSymbols; long NumberOfFloats; long NumberOfIntegers; long NumberOfBitMaps; SYMBOL_HN **SymbolArray; struct floatHashNode **FloatArray; INTEGER_HN **IntegerArray; BITMAP_HN **BitMapArray; #endif }; #define SymbolData(theEnv) ((struct symbolData *) GetEnvironmentData(theEnv,SYMBOL_DATA)) #define EnvFalseSymbol(theEnv) SymbolData(theEnv)->FalseSymbolHN #define EnvTrueSymbol(theEnv) SymbolData(theEnv)->TrueSymbolHN #if ENVIRONMENT_API_ONLY #define FalseSymbol(theEnv) SymbolData(theEnv)->FalseSymbolHN #define TrueSymbol(theEnv) SymbolData(theEnv)->TrueSymbolHN #define AddSymbol(theEnv,a) EnvAddSymbol(theEnv,a) #define AddLong(theEnv,a) EnvAddLong(theEnv,a) #define AddDouble(theEnv,a) EnvAddDouble(theEnv,a) #else #define FalseSymbol() SymbolData(GetCurrentEnvironment())->FalseSymbolHN #define TrueSymbol() SymbolData(GetCurrentEnvironment())->TrueSymbolHN #define AddSymbol(a) EnvAddSymbol(GetCurrentEnvironment(),a) #define AddLong(a) EnvAddLong(GetCurrentEnvironment(),a) #define AddDouble(a) EnvAddDouble(GetCurrentEnvironment(),a) #endif LOCALE void InitializeAtomTables(void *,struct symbolHashNode **,struct floatHashNode **, struct integerHashNode **,struct bitMapHashNode **); LOCALE void *EnvAddSymbol(void *,char *); LOCALE SYMBOL_HN *FindSymbolHN(void *,char *); LOCALE void *EnvAddDouble(void *,double); LOCALE void *EnvAddLong(void *,long int); LOCALE void *AddBitMap(void *,void *,unsigned); LOCALE INTEGER_HN *FindLongHN(void *,long int); LOCALE unsigned long HashSymbol(char *,unsigned long); LOCALE unsigned HashFloat(double,unsigned); LOCALE unsigned HashInteger(long int,unsigned); LOCALE unsigned HashBitMap(char *,unsigned,unsigned); LOCALE void DecrementSymbolCount(void *,struct symbolHashNode *); LOCALE void DecrementFloatCount(void *,struct floatHashNode *); LOCALE void DecrementIntegerCount(void *,struct integerHashNode *); LOCALE void DecrementBitMapCount(void *,struct bitMapHashNode *); LOCALE void RemoveEphemeralAtoms(void *); LOCALE struct symbolHashNode **GetSymbolTable(void *); LOCALE void SetSymbolTable(void *,struct symbolHashNode **); LOCALE struct floatHashNode **GetFloatTable(void *); LOCALE void SetFloatTable(void *,struct floatHashNode **); LOCALE struct integerHashNode **GetIntegerTable(void *); LOCALE void SetIntegerTable(void *,struct integerHashNode **); LOCALE struct bitMapHashNode **GetBitMapTable(void *); LOCALE void SetBitMapTable(void *,struct bitMapHashNode **); LOCALE void RefreshSpecialSymbols(void *); LOCALE struct symbolMatch *FindSymbolMatches(void *,char *,unsigned *,unsigned *); LOCALE void ReturnSymbolMatches(void *,struct symbolMatch *); LOCALE SYMBOL_HN *GetNextSymbolMatch(void *,char *,unsigned,SYMBOL_HN *,int,unsigned *); LOCALE void ClearBitString(void *,unsigned); LOCALE void SetAtomicValueIndices(void *,int); LOCALE void RestoreAtomicValueBuckets(void *); #endif clips-6.24/clipssrc/._rulelhs.c0000400000175000017500000000075410056713263014565 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0z0zTTF9FMWBBMPSRclips-6.24/clipssrc/prcdrpsr.c0000755000175000017500000010063510441150551014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* PROCEDURAL FUNCTIONS PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _PRCDRPSR_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "argacces.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnops.h" #include "cstrnutl.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "modulutl.h" #include "multifld.h" #include "router.h" #include "scanner.h" #include "utility.h" #include "prcdrpsr.h" #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #include "globlpsr.h" #endif #if ! RUN_TIME #define PRCDRPSR_DATA 12 struct procedureParserData { struct BindInfo *ListOfParsedBindNames; }; #define ProcedureParserData(theEnv) ((struct procedureParserData *) GetEnvironmentData(theEnv,PRCDRPSR_DATA)) #endif /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct expr *WhileParse(void *,struct expr *,char *); static struct expr *LoopForCountParse(void *,struct expr *,char *); static void ReplaceLoopCountVars(void *,SYMBOL_HN *,EXPRESSION *,int); static struct expr *IfParse(void *,struct expr *,char *); static struct expr *PrognParse(void *,struct expr *,char *); static struct expr *BindParse(void *,struct expr *,char *); static int AddBindName(void *,struct symbolHashNode *,CONSTRAINT_RECORD *); static struct expr *ReturnParse(void *,struct expr *,char *); static struct expr *BreakParse(void *,struct expr *,char *); static struct expr *SwitchParse(void *,struct expr *,char *); #endif #if ! RUN_TIME /*******************************************/ /* ProceduralFunctionParsers */ /*******************************************/ globle void ProceduralFunctionParsers( void *theEnv) { AllocateEnvironmentData(theEnv,PRCDRPSR_DATA,sizeof(struct procedureParserData),NULL); #if (! BLOAD_ONLY) AddFunctionParser(theEnv,"bind",BindParse); AddFunctionParser(theEnv,"progn",PrognParse); AddFunctionParser(theEnv,"if",IfParse); AddFunctionParser(theEnv,"while",WhileParse); AddFunctionParser(theEnv,"loop-for-count",LoopForCountParse); AddFunctionParser(theEnv,"return",ReturnParse); AddFunctionParser(theEnv,"break",BreakParse); AddFunctionParser(theEnv,"switch",SwitchParse); #endif } /********************************************************/ /* GetParsedBindNames: */ /********************************************************/ globle struct BindInfo *GetParsedBindNames( void *theEnv) { return(ProcedureParserData(theEnv)->ListOfParsedBindNames); } /********************************************************/ /* SetParsedBindNames: */ /********************************************************/ globle void SetParsedBindNames( void *theEnv, struct BindInfo *newValue) { ProcedureParserData(theEnv)->ListOfParsedBindNames = newValue; } /********************************************************/ /* ClearParsedBindNames: */ /********************************************************/ globle void ClearParsedBindNames( void *theEnv) { struct BindInfo *temp_bind; while (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL) { temp_bind = ProcedureParserData(theEnv)->ListOfParsedBindNames->next; RemoveConstraint(theEnv,ProcedureParserData(theEnv)->ListOfParsedBindNames->constraints); rtn_struct(theEnv,BindInfo,ProcedureParserData(theEnv)->ListOfParsedBindNames); ProcedureParserData(theEnv)->ListOfParsedBindNames = temp_bind; } } /********************************************************/ /* ParsedBindNamesEmpty: */ /********************************************************/ globle intBool ParsedBindNamesEmpty( void *theEnv) { if (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL) return(FALSE); return(TRUE); } #if (! BLOAD_ONLY) /*********************************************************/ /* WhileParse: purpose is to parse the while statement. */ /* The parse of the statement is the return value. */ /* Syntax: (while do +) */ /*********************************************************/ static struct expr *WhileParse( void *theEnv, struct expr *parse, char *infile) { struct token theToken; int read_first_paren; /*===============================*/ /* Process the while expression. */ /*===============================*/ SavePPBuffer(theEnv," "); parse->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (parse->argList == NULL) { ReturnExpression(theEnv,parse); return(NULL); } /*====================================*/ /* Process the do keyword if present. */ /*====================================*/ GetToken(theEnv,infile,&theToken); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0)) { read_first_paren = TRUE; PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); } else if (theToken.type == LPAREN) { read_first_paren = FALSE; PPBackup(theEnv); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); } else { SyntaxErrorMessage(theEnv,"while function"); ReturnExpression(theEnv,parse); return(NULL); } /*============================*/ /* Process the while actions. */ /*============================*/ if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; ExpressionData(theEnv)->BreakContext = TRUE; parse->argList->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); /*=======================================================*/ /* Check for the closing right parenthesis of the while. */ /*=======================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"while function"); ReturnExpression(theEnv,parse); return(NULL); } DecrementIndentDepth(theEnv,3); return(parse); } /******************************************************************************************/ /* LoopForCountParse: purpose is to parse the loop-for-count statement. */ /* The parse of the statement is the return value. */ /* Syntax: (loop-for-count [do] +) */ /* ::= ( [] ) */ /******************************************************************************************/ static struct expr *LoopForCountParse( void *theEnv, struct expr *parse, char *infile) { struct token theToken; SYMBOL_HN *loopVar = NULL; EXPRESSION *tmpexp; int read_first_paren; struct BindInfo *oldBindList,*newBindList,*prev; /*======================================*/ /* Process the loop counter expression. */ /*======================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); /* ========================================== Simple form: loop-for-count [do] ... ========================================== */ if (theToken.type != LPAREN) { parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L)); parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } } else { GetToken(theEnv,infile,&theToken); if (theToken.type != SF_VARIABLE) { if (theToken.type != SYMBOL) goto LoopForCountParseError; parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L)); parse->argList->nextArg = Function2Parse(theEnv,infile,ValueToString(theToken.value)); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } } /* ============================================================= Complex form: loop-for-count ( [] ) [do] ... ============================================================= */ else { loopVar = (SYMBOL_HN *) theToken.value; SavePPBuffer(theEnv," "); parse->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (parse->argList == NULL) { ReturnExpression(theEnv,parse); return(NULL); } if (CheckArgumentAgainstRestriction(theEnv,parse->argList,(int) 'i')) goto LoopForCountParseError; SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); if (theToken.type == RPAREN) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); tmpexp = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L)); tmpexp->nextArg = parse->argList; parse->argList = tmpexp; } else { parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } GetToken(theEnv,infile,&theToken); if (theToken.type != RPAREN) goto LoopForCountParseError; } SavePPBuffer(theEnv," "); } } if (CheckArgumentAgainstRestriction(theEnv,parse->argList->nextArg,(int) 'i')) goto LoopForCountParseError; /*====================================*/ /* Process the do keyword if present. */ /*====================================*/ GetToken(theEnv,infile,&theToken); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0)) { read_first_paren = TRUE; PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); } else if (theToken.type == LPAREN) { read_first_paren = FALSE; PPBackup(theEnv); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); } else goto LoopForCountParseError; /*=====================================*/ /* Process the loop-for-count actions. */ /*=====================================*/ if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; ExpressionData(theEnv)->BreakContext = TRUE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); parse->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE); if (parse->argList->nextArg->nextArg == NULL) { SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,parse); return(NULL); } newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { if ((loopVar == NULL) ? FALSE : (strcmp(ValueToString(newBindList->name),ValueToString(loopVar)) == 0)) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"PRCDRPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind loop variable in function loop-for-count.\n"); ReturnExpression(theEnv,parse); return(NULL); } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) SetParsedBindNames(theEnv,oldBindList); else prev->next = oldBindList; if (loopVar != NULL) ReplaceLoopCountVars(theEnv,loopVar,parse->argList->nextArg->nextArg,0); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); /*================================================================*/ /* Check for the closing right parenthesis of the loop-for-count. */ /*================================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"loop-for-count function"); ReturnExpression(theEnv,parse); return(NULL); } DecrementIndentDepth(theEnv,3); return(parse); LoopForCountParseError: SyntaxErrorMessage(theEnv,"loop-for-count function"); ReturnExpression(theEnv,parse); return(NULL); } /***************************************************/ /* ReplaceLoopCountVars */ /***************************************************/ static void ReplaceLoopCountVars( void *theEnv, SYMBOL_HN *loopVar, EXPRESSION *theExp, int depth) { while (theExp != NULL) { if ((theExp->type != SF_VARIABLE) ? FALSE : (strcmp(ValueToString(theExp->value),ValueToString(loopVar)) == 0)) { theExp->type = FCALL; theExp->value = (void *) FindFunction(theEnv,"(get-loop-count)"); theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) depth)); } else if (theExp->argList != NULL) { if ((theExp->type != FCALL) ? FALSE : (theExp->value == (void *) FindFunction(theEnv,"loop-for-count"))) ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth+1); else ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth); } theExp = theExp->nextArg; } } /*********************************************************/ /* IfParse: purpose is to parse the if statement. The */ /* parse of the statement is the return value. */ /* Syntax: (if then + */ /* [ else + ] ) */ /*********************************************************/ static struct expr *IfParse( void *theEnv, struct expr *top, char *infile) { struct token theToken; /*============================*/ /* Process the if expression. */ /*============================*/ SavePPBuffer(theEnv," "); top->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } /*========================================*/ /* Keyword 'then' must follow expression. */ /*========================================*/ IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); GetToken(theEnv,infile,&theToken); if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"then") != 0)) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*==============================*/ /* Process the if then actions. */ /*==============================*/ PPCRAndIndent(theEnv); if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; if (ExpressionData(theEnv)->svContexts->brk == TRUE) ExpressionData(theEnv)->BreakContext = TRUE; top->argList->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,"else",FALSE); if (top->argList->nextArg == NULL) { ReturnExpression(theEnv,top); return(NULL); } top->argList->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg); /*===========================================*/ /* A ')' signals an if then without an else. */ /*===========================================*/ if (theToken.type == RPAREN) { DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); return(top); } /*=============================================*/ /* Keyword 'else' must follow if then actions. */ /*=============================================*/ if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"else") != 0)) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*==============================*/ /* Process the if else actions. */ /*==============================*/ PPCRAndIndent(theEnv); top->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE); if (top->argList->nextArg->nextArg == NULL) { ReturnExpression(theEnv,top); return(NULL); } top->argList->nextArg->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg->nextArg); /*======================================================*/ /* Check for the closing right parenthesis of the if. */ /*======================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*===========================================*/ /* A ')' signals an if then without an else. */ /*===========================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); DecrementIndentDepth(theEnv,3); return(top); } /********************************************************/ /* PrognParse: purpose is to parse the progn statement. */ /* The parse of the statement is the return value. */ /* Syntax: (progn *) */ /********************************************************/ static struct expr *PrognParse( void *theEnv, struct expr *top, char *infile) { struct token tkn; struct expr *tmp; ReturnExpression(theEnv,top); ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); tmp = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tkn.printForm); return(tmp); } /***********************************************************/ /* BindParse: purpose is to parse the bind statement. The */ /* parse of the statement is the return value. */ /* Syntax: (bind ?var ) */ /***********************************************************/ 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); } /********************************************/ /* ReturnParse: Parses the return function. */ /********************************************/ static struct expr *ReturnParse( void *theEnv, struct expr *top, char *infile) { int error_flag = FALSE; struct token theToken; if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; if (ExpressionData(theEnv)->ReturnContext == FALSE) { PrintErrorID(theEnv,"PRCDRPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"The return function is not valid in this context.\n"); ReturnExpression(theEnv,top); return(NULL); } ExpressionData(theEnv)->ReturnContext = FALSE; SavePPBuffer(theEnv," "); top->argList = ArgumentParse(theEnv,infile,&error_flag); if (error_flag) { ReturnExpression(theEnv,top); return(NULL); } else if (top->argList == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } else { SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"return function"); ReturnExpression(theEnv,top); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } return(top); } /**********************************************/ /* BreakParse: */ /**********************************************/ static struct expr *BreakParse( void *theEnv, struct expr *top, char *infile) { struct token theToken; if (ExpressionData(theEnv)->svContexts->brk == FALSE) { PrintErrorID(theEnv,"PRCDRPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"The break function not valid in this context.\n"); ReturnExpression(theEnv,top); return(NULL); } SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"break function"); ReturnExpression(theEnv,top); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); return(top); } /**********************************************/ /* SwitchParse: */ /**********************************************/ static struct expr *SwitchParse( void *theEnv, struct expr *top, char *infile) { struct token theToken; EXPRESSION *theExp,*chk; int default_count = 0; /*============================*/ /* Process the switch value */ /*============================*/ IncrementIndentDepth(theEnv,3); SavePPBuffer(theEnv," "); top->argList = theExp = ParseAtomOrExpression(theEnv,infile,NULL); if (theExp == NULL) goto SwitchParseError; /*========================*/ /* Parse case statements. */ /*========================*/ GetToken(theEnv,infile,&theToken); while (theToken.type != RPAREN) { PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); if (theToken.type != LPAREN) goto SwitchParseErrorAndMessage; GetToken(theEnv,infile,&theToken); SavePPBuffer(theEnv," "); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"case") == 0)) { if (default_count != 0) goto SwitchParseErrorAndMessage; theExp->nextArg = ParseAtomOrExpression(theEnv,infile,NULL); SavePPBuffer(theEnv," "); if (theExp->nextArg == NULL) goto SwitchParseError; for (chk = top->argList->nextArg ; chk != theExp->nextArg ; chk = chk->nextArg) { if ((chk->type == theExp->nextArg->type) && (chk->value == theExp->nextArg->value) && IdenticalExpression(chk->argList,theExp->nextArg->argList)) { PrintErrorID(theEnv,"PRCDRPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Duplicate case found in switch function.\n"); goto SwitchParseError; } } GetToken(theEnv,infile,&theToken); if ((theToken.type != SYMBOL) ? TRUE : (strcmp(ValueToString(theToken.value),"then") != 0)) goto SwitchParseErrorAndMessage; } else if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"default") == 0)) { if (default_count) goto SwitchParseErrorAndMessage; theExp->nextArg = GenConstant(theEnv,RVOID,NULL); default_count = 1; } else goto SwitchParseErrorAndMessage; theExp = theExp->nextArg; if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; if (ExpressionData(theEnv)->svContexts->brk == TRUE) ExpressionData(theEnv)->BreakContext = TRUE; IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); theExp->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; if (theExp->nextArg == NULL) goto SwitchParseError; theExp = theExp->nextArg; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); GetToken(theEnv,infile,&theToken); } DecrementIndentDepth(theEnv,3); return(top); SwitchParseErrorAndMessage: SyntaxErrorMessage(theEnv,"switch function"); SwitchParseError: ReturnExpression(theEnv,top); DecrementIndentDepth(theEnv,3); return(NULL); } /********************************************************/ /* SearchParsedBindNames: */ /********************************************************/ globle int SearchParsedBindNames( void *theEnv, SYMBOL_HN *name_sought) { struct BindInfo *var_ptr; int theIndex = 1; var_ptr = ProcedureParserData(theEnv)->ListOfParsedBindNames; while (var_ptr != NULL) { if (var_ptr->name == name_sought) { return(theIndex); } var_ptr = var_ptr->next; theIndex++; } return(0); } /********************************************************/ /* FindBindConstraints: */ /********************************************************/ globle struct constraintRecord *FindBindConstraints( void *theEnv, SYMBOL_HN *nameSought) { struct BindInfo *theVariable; theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames; while (theVariable != NULL) { if (theVariable->name == nameSought) { return(theVariable->constraints); } theVariable = theVariable->next; } return(NULL); } /********************************************************/ /* CountParsedBindNames: Counts the number of variables */ /* names that have been bound using the bind function */ /* in the current context (e.g. the RHS of a rule). */ /********************************************************/ globle int CountParsedBindNames( void *theEnv) { struct BindInfo *theVariable; int theIndex = 0; theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames; while (theVariable != NULL) { theVariable = theVariable->next; theIndex++; } return(theIndex); } /****************************************************************/ /* AddBindName: Adds a variable name used as the first argument */ /* of the bind function to the list of variable names parsed */ /* within the current semantic context (e.g. RHS of a rule). */ /****************************************************************/ static int AddBindName( void *theEnv, SYMBOL_HN *variableName, CONSTRAINT_RECORD *theConstraint) { CONSTRAINT_RECORD *tmpConstraint; struct BindInfo *currentBind, *lastBind; int theIndex = 1; /*=========================================================*/ /* Look for the variable name in the list of bind variable */ /* names already parsed. If it is found, then return the */ /* index to the variable and union the new constraint */ /* information with the old constraint information. */ /*=========================================================*/ lastBind = NULL; currentBind = ProcedureParserData(theEnv)->ListOfParsedBindNames; while (currentBind != NULL) { if (currentBind->name == variableName) { if (theConstraint != NULL) { tmpConstraint = currentBind->constraints; currentBind->constraints = UnionConstraints(theEnv,theConstraint,currentBind->constraints); RemoveConstraint(theEnv,tmpConstraint); RemoveConstraint(theEnv,theConstraint); } return(theIndex); } lastBind = currentBind; currentBind = currentBind->next; theIndex++; } /*===============================================================*/ /* If the variable name wasn't found, then add it to the list of */ /* variable names and store the constraint information with it. */ /*===============================================================*/ currentBind = get_struct(theEnv,BindInfo); currentBind->name = variableName; currentBind->constraints = theConstraint; currentBind->next = NULL; if (lastBind == NULL) ProcedureParserData(theEnv)->ListOfParsedBindNames = currentBind; else lastBind->next = currentBind; return(theIndex); } /********************************************************/ /* RemoveParsedBindName: */ /********************************************************/ globle void RemoveParsedBindName( void *theEnv, struct symbolHashNode *bname) { struct BindInfo *prv,*tmp; prv = NULL; tmp = ProcedureParserData(theEnv)->ListOfParsedBindNames; while ((tmp != NULL) ? (tmp->name != bname) : FALSE) { prv = tmp; tmp = tmp->next; } if (tmp != NULL) { if (prv == NULL) ProcedureParserData(theEnv)->ListOfParsedBindNames = tmp->next; else prv->next = tmp->next; RemoveConstraint(theEnv,tmp->constraints); rtn_struct(theEnv,BindInfo,tmp); } } #endif #endif clips-6.24/clipssrc/dffnxexe.h0000755000175000017500000000277407422635002014524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_dffnxexe #define _H_dffnxexe #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXEXE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void CallDeffunction(void *,DEFFUNCTION *,EXPRESSION *,DATA_OBJECT *); #endif #endif clips-6.24/clipssrc/generate.h0000755000175000017500000000326707422635012014506 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* GENERATE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for converting field */ /* constraints to expressions which can be used */ /* in the pattern and join networks. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_generate #define _H_generate #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GENERATE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FieldConversion(void *,struct lhsParseNode *,struct lhsParseNode *); LOCALE struct expr *GetvarReplace(void *,struct lhsParseNode *); #endif clips-6.24/clipssrc/._prdctfun.h0000400000175000017500000000075410441150621014730 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0z;TTFS nFMWBBMPSRclips-6.24/clipssrc/tmpltrhs.h0000755000175000017500000000314107422634554014572 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFTEMPLATE RHS PARSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_tmpltrhs #define _H_tmpltrhs #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTRHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct expr *ParseAssertTemplate(void *,char *,struct token *,int *, int,int,struct deftemplate *); #endif clips-6.24/clipssrc/constrnt.c0000755000175000017500000005367410441131363014563 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for creating and removing */ /* constraint records, adding them to the contraint hash */ /* table, and enabling and disabling static and dynamic */ /* constraint checking. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _CONSTRNT_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "argacces.h" #include "constant.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "multifld.h" #include "router.h" #include "scanner.h" #include "constrnt.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static void InstallConstraintRecord(void *,CONSTRAINT_RECORD *); static int ConstraintCompare(struct constraintRecord *,struct constraintRecord *); #endif #if (! RUN_TIME) static void ReturnConstraintRecord(void *,CONSTRAINT_RECORD *); static void DeinstallConstraintRecord(void *,CONSTRAINT_RECORD *); #endif static void DeallocateConstraintData(void *); /*****************************************************/ /* InitializeConstraints: Initializes the constraint */ /* hash table to NULL and defines the static and */ /* dynamic constraint access functions. */ /*****************************************************/ globle void InitializeConstraints( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) int i; #endif AllocateEnvironmentData(theEnv,CONSTRAINT_DATA,sizeof(struct constraintData),DeallocateConstraintData); ConstraintData(theEnv)->StaticConstraintChecking = TRUE; #if (! RUN_TIME) && (! BLOAD_ONLY) ConstraintData(theEnv)->ConstraintHashtable = (struct constraintRecord **) gm2(theEnv,(int) sizeof (struct constraintRecord *) * SIZE_CONSTRAINT_HASH); if (ConstraintData(theEnv)->ConstraintHashtable == NULL) EnvExitRouter(theEnv,EXIT_FAILURE); for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) ConstraintData(theEnv)->ConstraintHashtable[i] = NULL; #endif #if (! RUN_TIME) EnvDefineFunction2(theEnv,"get-dynamic-constraint-checking",'b',GDCCommand,"GDCCommand", "00"); EnvDefineFunction2(theEnv,"set-dynamic-constraint-checking",'b',SDCCommand,"SDCCommand", "11"); EnvDefineFunction2(theEnv,"get-static-constraint-checking",'b',GSCCommand,"GSCCommand", "00"); EnvDefineFunction2(theEnv,"set-static-constraint-checking",'b',SSCCommand,"SSCCommand", "11"); #endif } /*****************************************************/ /* DeallocateConstraintData: Deallocates environment */ /* data for constraints. */ /*****************************************************/ static void DeallocateConstraintData( void *theEnv) { #if ! RUN_TIME struct constraintRecord *tmpPtr, *nextPtr; int i; for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) { tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; ReturnConstraintRecord(theEnv,tmpPtr); tmpPtr = nextPtr; } } rm(theEnv,ConstraintData(theEnv)->ConstraintHashtable, (int) sizeof (struct constraintRecord *) * SIZE_CONSTRAINT_HASH); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) if (ConstraintData(theEnv)->NumberOfConstraints != 0) { genlongfree(theEnv,(void *) ConstraintData(theEnv)->ConstraintArray, (unsigned long) (sizeof(CONSTRAINT_RECORD) * ConstraintData(theEnv)->NumberOfConstraints)); } #endif } #if (! RUN_TIME) /*************************************************************/ /* ReturnConstraintRecord: Frees the data structures used by */ /* a constraint record. If the returnOnlyFields argument */ /* is FALSE, then the constraint record is also freed. */ /*************************************************************/ static void ReturnConstraintRecord( void *theEnv, CONSTRAINT_RECORD *constraints) { if (constraints == NULL) return; if (constraints->bucket < 0) { ReturnExpression(theEnv,constraints->classList); ReturnExpression(theEnv,constraints->restrictionList); ReturnExpression(theEnv,constraints->maxValue); ReturnExpression(theEnv,constraints->minValue); ReturnExpression(theEnv,constraints->minFields); ReturnExpression(theEnv,constraints->maxFields); } ReturnConstraintRecord(theEnv,constraints->multifield); rtn_struct(theEnv,constraintRecord,constraints); } /***************************************************/ /* DeinstallConstraintRecord: Decrements the count */ /* values of all occurrences of primitive data */ /* types found in a constraint record. */ /***************************************************/ static void DeinstallConstraintRecord( void *theEnv, CONSTRAINT_RECORD *constraints) { if (constraints->bucket >= 0) { RemoveHashedExpression(theEnv,constraints->classList); RemoveHashedExpression(theEnv,constraints->restrictionList); RemoveHashedExpression(theEnv,constraints->maxValue); RemoveHashedExpression(theEnv,constraints->minValue); RemoveHashedExpression(theEnv,constraints->minFields); RemoveHashedExpression(theEnv,constraints->maxFields); } else { ExpressionDeinstall(theEnv,constraints->classList); ExpressionDeinstall(theEnv,constraints->restrictionList); ExpressionDeinstall(theEnv,constraints->maxValue); ExpressionDeinstall(theEnv,constraints->minValue); ExpressionDeinstall(theEnv,constraints->minFields); ExpressionDeinstall(theEnv,constraints->maxFields); } if (constraints->multifield != NULL) { DeinstallConstraintRecord(theEnv,constraints->multifield); } } /******************************************/ /* RemoveConstraint: Removes a constraint */ /* from the constraint hash table. */ /******************************************/ globle void RemoveConstraint( void *theEnv, struct constraintRecord *theConstraint) { struct constraintRecord *tmpPtr, *prevPtr = NULL; if (theConstraint == NULL) return; /*========================================*/ /* If the bucket value is less than zero, */ /* then the constraint wasn't stored in */ /* the hash table. */ /*========================================*/ if (theConstraint->bucket < 0) { ReturnConstraintRecord(theEnv,theConstraint); return; } /*================================*/ /* Find and remove the constraint */ /* from the contraint hash table. */ /*================================*/ tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[theConstraint->bucket]; while (tmpPtr != NULL) { if (tmpPtr == theConstraint) { theConstraint->count--; if (theConstraint->count == 0) { if (prevPtr == NULL) { ConstraintData(theEnv)->ConstraintHashtable[theConstraint->bucket] = theConstraint->next; } else { prevPtr->next = theConstraint->next; } DeinstallConstraintRecord(theEnv,theConstraint); ReturnConstraintRecord(theEnv,theConstraint); } return; } prevPtr = tmpPtr; tmpPtr = tmpPtr->next; } return; } #endif /* (! RUN_TIME) */ #if (! RUN_TIME) && (! BLOAD_ONLY) /***********************************/ /* HashConstraint: Returns a hash */ /* value for a given constraint. */ /***********************************/ globle int HashConstraint( struct constraintRecord *theConstraint) { int i = 0; unsigned int count = 0; int hashValue; struct expr *tmpPtr; count += (unsigned) (theConstraint->anyAllowed * 17) + (theConstraint->symbolsAllowed * 5) + (theConstraint->stringsAllowed * 23) + (theConstraint->floatsAllowed * 19) + (theConstraint->integersAllowed * 29) + (theConstraint->instanceNamesAllowed * 31) + (theConstraint->instanceAddressesAllowed * 17); count += (unsigned) (theConstraint->externalAddressesAllowed * 29) + (theConstraint->voidAllowed * 29) + (theConstraint->multifieldsAllowed * 29) + (theConstraint->factAddressesAllowed * 79) + (theConstraint->anyRestriction * 59) + (theConstraint->symbolRestriction * 61); count += (unsigned) (theConstraint->stringRestriction * 3) + (theConstraint->floatRestriction * 37) + (theConstraint->integerRestriction * 9) + (theConstraint->classRestriction * 11) + (theConstraint->instanceNameRestriction * 7); for (tmpPtr = theConstraint->classList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->restrictionList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->minValue; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->maxValue; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->minFields; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } for (tmpPtr = theConstraint->maxFields; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); } if (theConstraint->multifield != NULL) { count += (unsigned) HashConstraint(theConstraint->multifield); } hashValue = (int) (count % SIZE_CONSTRAINT_HASH); if (hashValue < 0) hashValue = - hashValue; return(hashValue); } /**********************************************/ /* ConstraintCompare: Compares two constraint */ /* records and returns TRUE if they are */ /* identical, otherwise FALSE. */ /**********************************************/ static int ConstraintCompare( struct constraintRecord *constraint1, struct constraintRecord *constraint2) { struct expr *tmpPtr1, *tmpPtr2; if ((constraint1->anyAllowed != constraint2->anyAllowed) || (constraint1->symbolsAllowed != constraint2->symbolsAllowed) || (constraint1->stringsAllowed != constraint2->stringsAllowed) || (constraint1->floatsAllowed != constraint2->floatsAllowed) || (constraint1->integersAllowed != constraint2->integersAllowed) || (constraint1->instanceNamesAllowed != constraint2->instanceNamesAllowed) || (constraint1->instanceAddressesAllowed != constraint2->instanceAddressesAllowed) || (constraint1->externalAddressesAllowed != constraint2->externalAddressesAllowed) || (constraint1->voidAllowed != constraint2->voidAllowed) || (constraint1->multifieldsAllowed != constraint2->multifieldsAllowed) || (constraint1->singlefieldsAllowed != constraint2->singlefieldsAllowed) || (constraint1->factAddressesAllowed != constraint2->factAddressesAllowed) || (constraint1->anyRestriction != constraint2->anyRestriction) || (constraint1->symbolRestriction != constraint2->symbolRestriction) || (constraint1->stringRestriction != constraint2->stringRestriction) || (constraint1->floatRestriction != constraint2->floatRestriction) || (constraint1->integerRestriction != constraint2->integerRestriction) || (constraint1->classRestriction != constraint2->classRestriction) || (constraint1->instanceNameRestriction != constraint2->instanceNameRestriction)) { return(FALSE); } for (tmpPtr1 = constraint1->classList, tmpPtr2 = constraint2->classList; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->restrictionList, tmpPtr2 = constraint2->restrictionList; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->minValue, tmpPtr2 = constraint2->minValue; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->maxValue, tmpPtr2 = constraint2->maxValue; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->minFields, tmpPtr2 = constraint2->minFields; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); for (tmpPtr1 = constraint1->maxFields, tmpPtr2 = constraint2->maxFields; (tmpPtr1 != NULL) && (tmpPtr2 != NULL); tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg) { if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value)) { return(FALSE); } } if (tmpPtr1 != tmpPtr2) return(FALSE); if (((constraint1->multifield == NULL) && (constraint2->multifield != NULL)) || ((constraint1->multifield != NULL) && (constraint2->multifield == NULL))) { return(FALSE); } else if (constraint1->multifield == constraint2->multifield) { return(TRUE); } return(ConstraintCompare(constraint1->multifield,constraint2->multifield)); } /************************************/ /* AddConstraint: Adds a constraint */ /* to the constraint hash table. */ /************************************/ globle struct constraintRecord *AddConstraint( void *theEnv, struct constraintRecord *theConstraint) { struct constraintRecord *tmpPtr; int hashValue; if (theConstraint == NULL) return(NULL); hashValue = HashConstraint(theConstraint); for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[hashValue]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { if (ConstraintCompare(theConstraint,tmpPtr)) { tmpPtr->count++; ReturnConstraintRecord(theEnv,theConstraint); return(tmpPtr); } } InstallConstraintRecord(theEnv,theConstraint); theConstraint->count = 1; theConstraint->bucket = hashValue; theConstraint->next = ConstraintData(theEnv)->ConstraintHashtable[hashValue]; ConstraintData(theEnv)->ConstraintHashtable[hashValue] = theConstraint; return(theConstraint); } /*************************************************/ /* InstallConstraintRecord: Increments the count */ /* values of all occurrences of primitive data */ /* types found in a constraint record. */ /*************************************************/ static void InstallConstraintRecord( void *theEnv, CONSTRAINT_RECORD *constraints) { struct expr *tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->classList); ReturnExpression(theEnv,constraints->classList); constraints->classList = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->restrictionList); ReturnExpression(theEnv,constraints->restrictionList); constraints->restrictionList = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->maxValue); ReturnExpression(theEnv,constraints->maxValue); constraints->maxValue = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->minValue); ReturnExpression(theEnv,constraints->minValue); constraints->minValue = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->minFields); ReturnExpression(theEnv,constraints->minFields); constraints->minFields = tempExpr; tempExpr = AddHashedExpression(theEnv,constraints->maxFields); ReturnExpression(theEnv,constraints->maxFields); constraints->maxFields = tempExpr; if (constraints->multifield != NULL) { InstallConstraintRecord(theEnv,constraints->multifield); } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ /**********************************************/ /* SDCCommand: H/L access routine for the */ /* set-dynamic-constraint-checking command. */ /**********************************************/ globle int SDCCommand( void *theEnv) { int oldValue; DATA_OBJECT arg_ptr; oldValue = EnvGetDynamicConstraintChecking(theEnv); if (EnvArgCountCheck(theEnv,"set-dynamic-constraint-checking",EXACTLY,1) == -1) { return(oldValue); } EnvRtnUnknown(theEnv,1,&arg_ptr); if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL)) { EnvSetDynamicConstraintChecking(theEnv,FALSE); } else { EnvSetDynamicConstraintChecking(theEnv,TRUE); } return(oldValue); } /**********************************************/ /* GDCCommand: H/L access routine for the */ /* get-dynamic-constraint-checking command. */ /**********************************************/ globle int GDCCommand( void *theEnv) { int oldValue; oldValue = EnvGetDynamicConstraintChecking(theEnv); if (EnvArgCountCheck(theEnv,"get-dynamic-constraint-checking",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } /*********************************************/ /* SSCCommand: H/L access routine for the */ /* set-static-constraint-checking command. */ /*********************************************/ globle int SSCCommand( void *theEnv) { int oldValue; DATA_OBJECT arg_ptr; oldValue = EnvGetStaticConstraintChecking(theEnv); if (EnvArgCountCheck(theEnv,"set-static-constraint-checking",EXACTLY,1) == -1) { return(oldValue); } EnvRtnUnknown(theEnv,1,&arg_ptr); if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL)) { EnvSetStaticConstraintChecking(theEnv,FALSE); } else { EnvSetStaticConstraintChecking(theEnv,TRUE); } return(oldValue); } /*********************************************/ /* GSCCommand: H/L access routine for the */ /* get-static-constraint-checking command. */ /*********************************************/ globle int GSCCommand( void *theEnv) { int oldValue; oldValue = EnvGetStaticConstraintChecking(theEnv); if (EnvArgCountCheck(theEnv,"get-static-constraint-checking",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } /******************************************************/ /* EnvSetDynamicConstraintChecking: C access routine */ /* for the set-dynamic-constraint-checking command. */ /******************************************************/ globle intBool EnvSetDynamicConstraintChecking( void *theEnv, int value) { int ov; ov = ConstraintData(theEnv)->DynamicConstraintChecking; ConstraintData(theEnv)->DynamicConstraintChecking = value; return(ov); } /******************************************************/ /* EnvGetDynamicConstraintChecking: C access routine */ /* for the get-dynamic-constraint-checking command. */ /******************************************************/ globle intBool EnvGetDynamicConstraintChecking( void *theEnv) { return(ConstraintData(theEnv)->DynamicConstraintChecking); } /*****************************************************/ /* EnvSetStaticConstraintChecking: C access routine */ /* for the set-static-constraint-checking command. */ /*****************************************************/ globle intBool EnvSetStaticConstraintChecking( void *theEnv, int value) { int ov; ov = ConstraintData(theEnv)->StaticConstraintChecking; ConstraintData(theEnv)->StaticConstraintChecking = value; return(ov); } /*****************************************************/ /* EnvGetStaticConstraintChecking: C access routine */ /* for the get-static-constraint-checking command. */ /*****************************************************/ globle intBool EnvGetStaticConstraintChecking( void *theEnv) { return(ConstraintData(theEnv)->StaticConstraintChecking); } clips-6.24/clipssrc/modulcmp.h0000755000175000017500000000317307422634703014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFMODULE CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defmodule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_modulcmp #define _H_modulcmp #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefmoduleCompilerSetup(void *); LOCALE void PrintDefmoduleReference(void *,FILE *,struct defmodule *); #endif clips-6.24/clipssrc/._object.h0000400000175000017500000000452207416733016014363 0ustar jfsjfsMac OS X  2 R TEXTR*ch nobject.hntrol PanelTCmr.txt.docTEXTR*ch@ p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco??a. n!7lnGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/dffctcmp.c0000755000175000017500000002273010177533433014476 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* DEFFACTS CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* deffacts construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _DFFCTCMP_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "dffctdef.h" #include "envrnmnt.h" #include "dffctcmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,char *,int,FILE *,int,int); static void DeffactsToCode(void *,FILE *,struct deffacts *, int,int,int); static void DeffactsModuleToCode(void *,FILE *,struct defmodule *,int,int,int); static void CloseDeffactsFiles(void *,FILE *,FILE *,int); static void BeforeDeffactsToCode(void *); /*************************************************************/ /* DeffactsCompilerSetup: Initializes the deffacts construct */ /* for use with the constructs-to-c command. */ /*************************************************************/ globle void DeffactsCompilerSetup( void *theEnv) { DeffactsData(theEnv)->DeffactsCodeItem = AddCodeGeneratorItem(theEnv,"deffacts",0,BeforeDeffactsToCode, NULL,ConstructToCode,2); } /*************************************************************/ /* BeforeDeffactsToCode: Assigns each deffacts a unique ID */ /* which will be used for pointer references when the data */ /* structures are written to a file as C code */ /*************************************************************/ static void BeforeDeffactsToCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DeffactsData(theEnv)->DeffactsModuleIndex); } /**********************************************************/ /* ConstructToCode: Produces deffacts code for a run-time */ /* module created using the constructs-to-c function. */ /**********************************************************/ static int ConstructToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct deffacts *theDeffacts; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int deffactsArrayCount = 0, deffactsArrayVersion = 1; FILE *moduleFile = NULL, *deffactsFile = NULL; /*===============================================*/ /* Include the appropriate deffacts header file. */ /*===============================================*/ fprintf(headerFP,"#include \"dffctdef.h\"\n"); /*=================================================================*/ /* Loop through all the modules and all the deffacts writing their */ /* C code representation to the file as they are traversed. */ /*=================================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "struct deffactsModule",ModulePrefix(DeffactsData(theEnv)->DeffactsCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDeffactsFiles(theEnv,moduleFile,deffactsFile,maxIndices); return(0); } DeffactsModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices,moduleCount); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); /*===================================================*/ /* Loop through each of the deffacts in this module. */ /*===================================================*/ for (theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL); theDeffacts != NULL; theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,theDeffacts)) { deffactsFile = OpenFileIfNeeded(theEnv,deffactsFile,fileName,fileID,imageID,&fileCount, deffactsArrayVersion,headerFP, "struct deffacts",ConstructPrefix(DeffactsData(theEnv)->DeffactsCodeItem), FALSE,NULL); if (deffactsFile == NULL) { CloseDeffactsFiles(theEnv,moduleFile,deffactsFile,maxIndices); return(0); } DeffactsToCode(theEnv,deffactsFile,theDeffacts,imageID,maxIndices,moduleCount); deffactsArrayCount++; deffactsFile = CloseFileIfNeeded(theEnv,deffactsFile,&deffactsArrayCount, &deffactsArrayVersion,maxIndices,NULL,NULL); } moduleCount++; moduleArrayCount++; } CloseDeffactsFiles(theEnv,moduleFile,deffactsFile,maxIndices); return(1); } /*********************************************************/ /* CloseDeffactsFiles: Closes all of the C files created */ /* for deffacts. Called when an error occurs or when */ /* the deffacts have all been written to the files. */ /*********************************************************/ static void CloseDeffactsFiles( void *theEnv, FILE *moduleFile, FILE *deffactsFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (deffactsFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,deffactsFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /**********************************************************/ /* DeffactsModuleToCode: Writes the C code representation */ /* of a single deffacts module to the specified file. */ /**********************************************************/ #if IBM_TBC #pragma argsused #endif static void DeffactsModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int moduleCount) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(moduleCount) #endif fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DeffactsData(theEnv)->DeffactsModuleIndex, ConstructPrefix(DeffactsData(theEnv)->DeffactsCodeItem)); fprintf(theFile,"}"); } /*********************************************************/ /* DeffactsToCode: Writes the C code representation of a */ /* single deffacts construct to the specified file. */ /*********************************************************/ static void DeffactsToCode( void *theEnv, FILE *theFile, struct deffacts *theDeffacts, int imageID, int maxIndices, int moduleCount) { /*=================*/ /* Deffacts Header */ /*=================*/ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDeffacts->header,imageID,maxIndices, moduleCount,ModulePrefix(DeffactsData(theEnv)->DeffactsCodeItem), ConstructPrefix(DeffactsData(theEnv)->DeffactsCodeItem)); fprintf(theFile,","); /*=============*/ /* Assert List */ /*=============*/ ExpressionToCode(theEnv,theFile,theDeffacts->assertList); fprintf(theFile,"}"); } /**************************************************************/ /* DeffactsCModuleReference: Writes the C code representation */ /* of a reference to a deffacts module data structure. */ /**************************************************************/ globle void DeffactsCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DeffactsData(theEnv)->DeffactsCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } #endif /* DEFFACTS_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */ clips-6.24/clipssrc/match.h0000755000175000017500000000723007422634530014006 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* MATCH HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_match #define _H_match struct genericMatch; struct patternMatch; struct partialMatch; struct alphaMatch; struct multifieldMarker; #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_network #include "network.h" #endif #ifndef _H_pattern #include "pattern.h" #endif /************************************************************/ /* PATTERNMATCH STRUCTURE: */ /************************************************************/ struct patternMatch { struct patternMatch *next; struct partialMatch *theMatch; struct patternNodeHeader *matchingPattern; }; /**************************/ /* genericMatch structure */ /**************************/ struct genericMatch { union { void *theValue; struct alphaMatch *theMatch; } gm; }; /************************************************************/ /* PARTIALMATCH STRUCTURE: */ /************************************************************/ struct partialMatch { unsigned int betaMemory : 1; unsigned int busy : 1; unsigned int activationf : 1; unsigned int dependentsf : 1; unsigned int notOriginf : 1; unsigned int counterf : 1; unsigned int bcount : 9; struct partialMatch *next; struct genericMatch binds[1]; }; /************************************************************/ /* ALPHAMATCH STRUCTURE: */ /************************************************************/ struct alphaMatch { struct patternEntity *matchingItem; struct multifieldMarker *markers; struct alphaMatch *next; }; /************************************************************/ /* MULTIFIELDMARKER STRUCTURE: Used in the pattern matching */ /* process to mark the range of fields that the $? and */ /* $?variables match because a single pattern restriction */ /* may span zero or more fields.. */ /************************************************************/ struct multifieldMarker { int whichField; union { void *whichSlot; short int whichSlotNumber; } where; long startPosition; long endPosition; struct multifieldMarker *next; }; #define get_nth_pm_value(thePM,thePos) (thePM->binds[thePos].gm.theValue) #define get_nth_pm_match(thePM,thePos) (thePM->binds[thePos].gm.theMatch) #define set_nth_pm_value(thePM,thePos,theVal) (thePM->binds[thePos].gm.theValue = (void *) theVal) #define set_nth_pm_match(thePM,thePos,theVal) (thePM->binds[thePos].gm.theMatch = theVal) #endif clips-6.24/clipssrc/insquery.h0000755000175000017500000000561310441147627014575 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_insquery #define _H_insquery #if INSTANCE_SET_QUERIES #ifndef _H_object #include "object.h" #endif typedef struct query_class { DEFCLASS *cls; struct defmodule *theModule; struct query_class *chain,*nxt; } QUERY_CLASS; typedef struct query_soln { INSTANCE_TYPE **soln; struct query_soln *nxt; } QUERY_SOLN; typedef struct query_core { INSTANCE_TYPE **solns; EXPRESSION *query,*action; QUERY_SOLN *soln_set,*soln_bottom; unsigned soln_size,soln_cnt; DATA_OBJECT *result; } QUERY_CORE; typedef struct query_stack { QUERY_CORE *core; struct query_stack *nxt; } QUERY_STACK; #define INSTANCE_QUERY_DATA 31 struct instanceQueryData { SYMBOL_HN *QUERY_DELIMETER_SYMBOL; QUERY_CORE *QueryCore; QUERY_STACK *QueryCoreStack; int AbortQuery; }; #define InstanceQueryData(theEnv) ((struct instanceQueryData *) GetEnvironmentData(theEnv,INSTANCE_QUERY_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _INSQUERY_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define QUERY_DELIMETER_STRING "(QDS)" LOCALE void SetupQuery(void *); LOCALE void *GetQueryInstance(void *); LOCALE void GetQueryInstanceSlot(void *,DATA_OBJECT *); LOCALE intBool AnyInstances(void *); LOCALE void QueryFindInstance(void *,DATA_OBJECT *); LOCALE void QueryFindAllInstances(void *,DATA_OBJECT *); LOCALE void QueryDoForInstance(void *,DATA_OBJECT *); LOCALE void QueryDoForAllInstances(void *,DATA_OBJECT *); LOCALE void DelayedQueryDoForAllInstances(void *,DATA_OBJECT *); #endif #endif clips-6.24/clipssrc/objrtbld.c0000755000175000017500000024554510441150267014517 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* OBJECT PATTERN MATCHER MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: RETE Network Parsing Interface for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #if (! BLOAD_ONLY) && (! RUN_TIME) #include #include #include "classcom.h" #include "classfun.h" #include "cstrnutl.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnops.h" #include "drive.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "inscom.h" #include "insfun.h" #include "insmngr.h" #include "memalloc.h" #include "network.h" #include "object.h" #include "pattern.h" #include "reteutil.h" #include "ruledef.h" #include "rulepsr.h" #include "scanner.h" #include "symbol.h" #include "utility.h" #endif #include "constrct.h" #include "objrtmch.h" #include "objrtgen.h" #include "objrtfnx.h" #include "reorder.h" #include "router.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "objrtcmp.h" #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY #include "objrtbin.h" #endif #define _OBJRTBLD_SOURCE_ #include "objrtbld.h" #if ! DEFINSTANCES_CONSTRUCT #include "extnfunc.h" #include "classfun.h" #include "classcom.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define OBJECT_PATTERN_INDICATOR "object" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool PatternParserFind(SYMBOL_HN *); static struct lhsParseNode *ObjectLHSParse(void *,char *,struct token *); static intBool ReorderAndAnalyzeObjectPattern(void *,struct lhsParseNode *); static struct patternNodeHeader *PlaceObjectPattern(void *,struct lhsParseNode *); static OBJECT_PATTERN_NODE *FindObjectPatternNode(OBJECT_PATTERN_NODE *,struct lhsParseNode *, OBJECT_PATTERN_NODE **,unsigned); static OBJECT_PATTERN_NODE *CreateNewObjectPatternNode(void *,struct lhsParseNode *,OBJECT_PATTERN_NODE *, OBJECT_PATTERN_NODE *,unsigned); static void DetachObjectPattern(void *,struct patternNodeHeader *); static void ClearObjectPatternMatches(void *,OBJECT_ALPHA_NODE *); static void RemoveObjectPartialMatches(void *,INSTANCE_TYPE *,struct patternNodeHeader *); static intBool CheckDuplicateSlots(void *,struct lhsParseNode *,SYMBOL_HN *); static struct lhsParseNode *ParseClassRestriction(void *,char *,struct token *); static struct lhsParseNode *ParseNameRestriction(void *,char *,struct token *); static struct lhsParseNode *ParseSlotRestriction(void *,char *,struct token *,CONSTRAINT_RECORD *,int); static CLASS_BITMAP *NewClassBitMap(void *,int,int); static void InitializeClassBitMap(void *,CLASS_BITMAP *,int); static void DeleteIntermediateClassBitMap(void *,CLASS_BITMAP *); static void *CopyClassBitMap(void *,void *); static void DeleteClassBitMap(void *,void *); static void MarkBitMapClassesBusy(void *,BITMAP_HN *,int); static intBool EmptyClassBitMap(CLASS_BITMAP *); static intBool IdenticalClassBitMap(CLASS_BITMAP *,CLASS_BITMAP *); static intBool ProcessClassRestriction(void *,CLASS_BITMAP *,struct lhsParseNode **,int); static CONSTRAINT_RECORD *ProcessSlotRestriction(void *,CLASS_BITMAP *,SYMBOL_HN *,int *); static void IntersectClassBitMaps(CLASS_BITMAP *,CLASS_BITMAP *); static void UnionClassBitMaps(CLASS_BITMAP *,CLASS_BITMAP *); static CLASS_BITMAP *PackClassBitMap(void *,CLASS_BITMAP *); static struct lhsParseNode *FilterObjectPattern(void *,struct patternParser *, struct lhsParseNode *,struct lhsParseNode **, struct lhsParseNode **,struct lhsParseNode **); static BITMAP_HN *FormSlotBitMap(void *,struct lhsParseNode *); static struct lhsParseNode *RemoveSlotExistenceTests(void *,struct lhsParseNode *,BITMAP_HN **); static struct lhsParseNode *CreateInitialObjectPattern(void *); static EXPRESSION *ObjectMatchDelayParse(void *,EXPRESSION *,char *); static void MarkObjectPtnIncrementalReset(void *,struct patternNodeHeader *,int); static void ObjectIncrementalReset(void *); #endif #if ! DEFINSTANCES_CONSTRUCT static void ResetInitialObject(void *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************** NAME : SetupObjectPatternStuff DESCRIPTION : Installs the parsers and other items necessary for recognizing and processing object patterns in defrules INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Rete network interfaces for objects initialized NOTES : None ********************************************************/ globle void SetupObjectPatternStuff( void *theEnv) { #if (! BLOAD_ONLY) && (! RUN_TIME) struct patternParser *newPtr; if (ReservedPatternSymbol(theEnv,"object",NULL) == TRUE) { SystemError(theEnv,"OBJRTBLD",1); EnvExitRouter(theEnv,EXIT_FAILURE); } AddReservedPatternSymbol(theEnv,"object",NULL); /* =========================================================================== The object pattern parser needs to have a higher priority than deftemplates or regular facts so that the "object" keyword is always recognized first =========================================================================== */ newPtr = get_struct(theEnv,patternParser); newPtr->name = "objects"; newPtr->priority = 20; newPtr->entityType = &InstanceData(theEnv)->InstanceInfo; newPtr->recognizeFunction = PatternParserFind; newPtr->parseFunction = ObjectLHSParse; newPtr->postAnalysisFunction = ReorderAndAnalyzeObjectPattern; newPtr->addPatternFunction = PlaceObjectPattern; newPtr->removePatternFunction = DetachObjectPattern; newPtr->genJNConstantFunction = NULL; newPtr->replaceGetJNValueFunction = ReplaceGetJNObjectValue; newPtr->genGetJNValueFunction = GenGetJNObjectValue; newPtr->genCompareJNValuesFunction = ObjectJNVariableComparison; newPtr->genPNConstantFunction = GenObjectPNConstantCompare; newPtr->replaceGetPNValueFunction = ReplaceGetPNObjectValue; newPtr->genGetPNValueFunction = GenGetPNObjectValue; newPtr->genComparePNValuesFunction = ObjectPNVariableComparison; newPtr->returnUserDataFunction = DeleteClassBitMap; newPtr->copyUserDataFunction = CopyClassBitMap; newPtr->markIRPatternFunction = MarkObjectPtnIncrementalReset; newPtr->incrementalResetFunction = ObjectIncrementalReset; newPtr->initialPatternFunction = CreateInitialObjectPattern; #if CONSTRUCT_COMPILER && (! RUN_TIME) newPtr->codeReferenceFunction = ObjectPatternNodeReference; #else newPtr->codeReferenceFunction = NULL; #endif AddPatternParser(theEnv,newPtr); EnvDefineFunction2(theEnv,"object-pattern-match-delay",'u', PTIEF ObjectMatchDelay,"ObjectMatchDelay",NULL); AddFunctionParser(theEnv,"object-pattern-match-delay",ObjectMatchDelayParse); FuncSeqOvlFlags(theEnv,"object-pattern-match-delay",FALSE,FALSE); #endif InstallObjectPrimitives(theEnv); #if CONSTRUCT_COMPILER && (! RUN_TIME) ObjectPatternsCompilerSetup(theEnv); #endif #if ! DEFINSTANCES_CONSTRUCT EnvAddResetFunction(theEnv,"reset-initial-object",ResetInitialObject,0); #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY SetupObjectPatternsBload(theEnv); #endif } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if ! DEFINSTANCES_CONSTRUCT static void ResetInitialObject( void *theEnv) { EXPRESSION *tmp; DATA_OBJECT rtn; tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance")); tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); tmp->argList->nextArg = GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME)); EvaluateExpression(theEnv,tmp,&rtn); ReturnExpression(theEnv,tmp); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /***************************************************** NAME : PatternParserFind DESCRIPTION : Determines if a pattern CE is an object pattern (i.e. the first field is the constant symbol "object") INPUTS : 1) The type of the first field 2) The value of the first field RETURNS : TRUE if it is an object pattern, FALSE otherwise SIDE EFFECTS : None NOTES : Used by AddPatternParser() *****************************************************/ static intBool PatternParserFind( SYMBOL_HN *value) { if (strcmp(ValueToString(value),OBJECT_PATTERN_INDICATOR) == 0) return(TRUE); return(FALSE); } /************************************************************************************ NAME : ObjectLHSParse DESCRIPTION : Scans and parses an object pattern for a rule INPUTS : 1) The logical name of the input source 2) A buffer holding the last token read RETURNS : The address of struct lhsParseNodes, NULL on errors SIDE EFFECTS : A series of struct lhsParseNodes are created to represent the intermediate parse of the pattern Pretty-print form for the pattern is saved NOTES : Object Pattern Syntax: (object [] [] *) ::= (is-a ) ::= (name ) ::= ( *) ************************************************************************************/ #if IBM_TBC #pragma argsused #endif static struct lhsParseNode *ObjectLHSParse( void *theEnv, char *readSource, struct token *lastToken) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(lastToken) #endif struct token theToken; struct lhsParseNode *firstNode = NULL,*lastNode = NULL,*tmpNode; CLASS_BITMAP *clsset,*tmpset; CONSTRAINT_RECORD *slotConstraints; int ppbackupReqd = FALSE,multip; /* ======================================================== Get a bitmap big enough to mark the ids of all currently existing classes - and set all bits, since the initial set of applicable classes is everything. ======================================================== */ clsset = NewClassBitMap(theEnv,((int) DefclassData(theEnv)->MaxClassID) - 1,1); if (EmptyClassBitMap(clsset)) { PrintErrorID(theEnv,"OBJRTBLD",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy pattern.\n"); DeleteIntermediateClassBitMap(theEnv,clsset); return(NULL); } tmpset = NewClassBitMap(theEnv,((int) DefclassData(theEnv)->MaxClassID) - 1,1); IncrementIndentDepth(theEnv,7); /* =========================================== Parse the class, name and slot restrictions =========================================== */ GetToken(theEnv,readSource,&theToken); while (theToken.type != RPAREN) { ppbackupReqd = TRUE; PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"object pattern"); goto ObjectLHSParseERROR; } GetToken(theEnv,readSource,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"object pattern"); goto ObjectLHSParseERROR; } if (CheckDuplicateSlots(theEnv,firstNode,(SYMBOL_HN *) theToken.value)) goto ObjectLHSParseERROR; if (theToken.value == (void *) DefclassData(theEnv)->ISA_SYMBOL) { tmpNode = ParseClassRestriction(theEnv,readSource,&theToken); if (tmpNode == NULL) goto ObjectLHSParseERROR; InitializeClassBitMap(theEnv,tmpset,0); if (ProcessClassRestriction(theEnv,tmpset,&tmpNode->bottom,TRUE) == FALSE) { ReturnLHSParseNodes(theEnv,tmpNode); goto ObjectLHSParseERROR; } IntersectClassBitMaps(clsset,tmpset); } else if (theToken.value == (void *) DefclassData(theEnv)->NAME_SYMBOL) { tmpNode = ParseNameRestriction(theEnv,readSource,&theToken); if (tmpNode == NULL) goto ObjectLHSParseERROR; InitializeClassBitMap(theEnv,tmpset,1); } else { slotConstraints = ProcessSlotRestriction(theEnv,clsset,(SYMBOL_HN *) theToken.value,&multip); if (slotConstraints != NULL) { InitializeClassBitMap(theEnv,tmpset,1); tmpNode = ParseSlotRestriction(theEnv,readSource,&theToken,slotConstraints,multip); if (tmpNode == NULL) goto ObjectLHSParseERROR; } else { InitializeClassBitMap(theEnv,tmpset,0); tmpNode = GetLHSParseNode(theEnv); tmpNode->slot = (SYMBOL_HN *) theToken.value; } } if (EmptyClassBitMap(tmpset)) { PrintErrorID(theEnv,"OBJRTBLD",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy "); EnvPrintRouter(theEnv,WERROR,ValueToString(tmpNode->slot)); EnvPrintRouter(theEnv,WERROR," restriction in object pattern.\n"); ReturnLHSParseNodes(theEnv,tmpNode); goto ObjectLHSParseERROR; } if (EmptyClassBitMap(clsset)) { PrintErrorID(theEnv,"OBJRTBLD",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy pattern.\n"); ReturnLHSParseNodes(theEnv,tmpNode); goto ObjectLHSParseERROR; } if (tmpNode != NULL) { if (firstNode == NULL) firstNode = tmpNode; else lastNode->right = tmpNode; lastNode = tmpNode; } PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&theToken); } if (firstNode == NULL) { if (EmptyClassBitMap(clsset)) { PrintErrorID(theEnv,"OBJRTBLD",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy pattern.\n"); goto ObjectLHSParseERROR; } firstNode = GetLHSParseNode(theEnv); firstNode->type = SF_WILDCARD; firstNode->slot = DefclassData(theEnv)->ISA_SYMBOL; firstNode->slotNumber = ISA_ID; firstNode->index = 1; } if (ppbackupReqd) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); } DeleteIntermediateClassBitMap(theEnv,tmpset); clsset = PackClassBitMap(theEnv,clsset); firstNode->userData = AddBitMap(theEnv,(void *) clsset,ClassBitMapSize(clsset)); IncrementBitMapCount(firstNode->userData); DeleteIntermediateClassBitMap(theEnv,clsset); DecrementIndentDepth(theEnv,7); return(firstNode); ObjectLHSParseERROR: DeleteIntermediateClassBitMap(theEnv,clsset); DeleteIntermediateClassBitMap(theEnv,tmpset); ReturnLHSParseNodes(theEnv,firstNode); DecrementIndentDepth(theEnv,7); return(NULL); } /************************************************************** NAME : ReorderAndAnalyzeObjectPattern DESCRIPTION : This function reexamines the object pattern after constraint and variable analysis info has been propagated from other patterns. Any slots which are no longer applicable to the pattern are eliminated from the class set. Also, the slot names are ordered according to lexical value to aid in deteterming sharing between object patterns. (The is-a and name restrictions are always placed first regardless of symbolic hash value.) INPUTS : The pattern CE lhsParseNode RETURNS : FALSE if all OK, otherwise TRUE (e.g. all classes are eliminated as potential matching candidates for the pattern) SIDE EFFECTS : Slot restrictions are reordered (if necessary) NOTES : Adds a default is-a slot if one does not already exist **************************************************************/ static intBool ReorderAndAnalyzeObjectPattern( void *theEnv, struct lhsParseNode *topNode) { CLASS_BITMAP *clsset,*tmpset; EXPRESSION *rexp,*tmpmin,*tmpmax; DEFCLASS *cls; struct lhsParseNode *tmpNode,*subNode,*bitmap_node,*isa_node,*name_node; register unsigned short i; SLOT_DESC *sd; CONSTRAINT_RECORD *crossConstraints, *theConstraint; int incompatibleConstraint,clssetChanged = FALSE; /* ========================================================== Make sure that the bitmap marking which classes of object can match the pattern is attached to the class restriction (which will always be present and the last restriction after the sort) ========================================================== */ topNode->right = FilterObjectPattern(theEnv,topNode->patternType,topNode->right, &bitmap_node,&isa_node,&name_node); if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(FALSE); /* ============================================ Allocate a temporary set for marking classes ============================================ */ clsset = (CLASS_BITMAP *) ValueToBitMap(bitmap_node->userData); tmpset = NewClassBitMap(theEnv,(int) clsset->maxid,0); /* ========================================================== Check the allowed-values for the constraint on the is-a slot. If there are any, make sure that only the classes with those values as names are marked in the bitmap. There will only be symbols in the list because the original constraint on the is-a slot allowed only symbols. ========================================================== */ if ((isa_node == NULL) ? FALSE : ((isa_node->constraints == NULL) ? FALSE : (isa_node->constraints->restrictionList != NULL))) { rexp = isa_node->constraints->restrictionList; while (rexp != NULL) { cls = LookupDefclassInScope(theEnv,ValueToString(rexp->value)); if (cls != NULL) { if ((cls->id <= clsset->maxid) ? TestBitMap(clsset->map,cls->id) : FALSE) SetBitMap(tmpset->map,cls->id); } rexp = rexp->nextArg; } clssetChanged = IdenticalClassBitMap(tmpset,clsset) ? FALSE : TRUE; } else GenCopyMemory(char,tmpset->maxid / BITS_PER_BYTE + 1,tmpset->map,clsset->map); /* ================================================================ For each of the slots (excluding name and is-a), check the total constraints for the slot against the individual constraints for each occurrence of the slot in the classes marked in the bitmap. For any slot which is not compatible with the overall constraint, clear its class's bit in the bitmap. ================================================================ */ tmpNode = topNode->right; while (tmpNode != bitmap_node) { if ((tmpNode == isa_node) || (tmpNode == name_node)) { tmpNode = tmpNode->right; continue; } for (i = 0 ; i <= tmpset->maxid ; i++) if (TestBitMap(tmpset->map,i)) { cls = DefclassData(theEnv)->ClassIDMap[i]; sd = cls->instanceTemplate[FindInstanceTemplateSlot(theEnv,cls,tmpNode->slot)]; /* ========================================= Check the top-level lhsParseNode for type and cardinality compatibility ========================================= */ crossConstraints = IntersectConstraints(theEnv,tmpNode->constraints,sd->constraint); incompatibleConstraint = UnmatchableConstraint(crossConstraints); RemoveConstraint(theEnv,crossConstraints); if (incompatibleConstraint) { ClearBitMap(tmpset->map,i); clssetChanged = TRUE; } else if (tmpNode->type == MF_WILDCARD) { /* ========================================== Check the sub-nodes for type compatibility ========================================== */ for (subNode = tmpNode->bottom ; subNode != NULL ; subNode = subNode->right) { /* ======================================================== Temporarily reset cardinality of variables to match slot so that no cardinality errors will be flagged ======================================================== */ if ((subNode->type == MF_WILDCARD) || (subNode->type == MF_VARIABLE)) { theConstraint = subNode->constraints->multifield; } else { theConstraint = subNode->constraints; } tmpmin = theConstraint->minFields; theConstraint->minFields = sd->constraint->minFields; tmpmax = theConstraint->maxFields; theConstraint->maxFields = sd->constraint->maxFields; crossConstraints = IntersectConstraints(theEnv,theConstraint,sd->constraint); theConstraint->minFields = tmpmin; theConstraint->maxFields = tmpmax; incompatibleConstraint = UnmatchableConstraint(crossConstraints); RemoveConstraint(theEnv,crossConstraints); if (incompatibleConstraint) { ClearBitMap(tmpset->map,i); clssetChanged = TRUE; break; } } } } tmpNode = tmpNode->right; } if (clssetChanged) { /* ======================================================= Make sure that there are still classes of objects which can satisfy this pattern. Otherwise, signal an error. ======================================================= */ if (EmptyClassBitMap(tmpset)) { PrintErrorID(theEnv,"OBJRTBLD",3,TRUE); DeleteIntermediateClassBitMap(theEnv,tmpset); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy pattern #"); PrintLongInteger(theEnv,WERROR,(long) topNode->pattern); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } clsset = PackClassBitMap(theEnv,tmpset); DeleteClassBitMap(theEnv,(void *) bitmap_node->userData); bitmap_node->userData = AddBitMap(theEnv,(void *) clsset,ClassBitMapSize(clsset)); IncrementBitMapCount(bitmap_node->userData); DeleteIntermediateClassBitMap(theEnv,clsset); } else DeleteIntermediateClassBitMap(theEnv,tmpset); return(FALSE); } /***************************************************** NAME : PlaceObjectPattern DESCRIPTION : Integrates an object pattern into the object pattern network INPUTS : The intermediate parse representation of the pattern RETURNS : The address of the new pattern SIDE EFFECTS : Object pattern network updated NOTES : None *****************************************************/ static struct patternNodeHeader *PlaceObjectPattern( void *theEnv, struct lhsParseNode *thePattern) { OBJECT_PATTERN_NODE *currentLevel,*lastLevel; struct lhsParseNode *tempPattern = NULL; OBJECT_PATTERN_NODE *nodeSlotGroup, *newNode; OBJECT_ALPHA_NODE *newAlphaNode; unsigned endSlot; BITMAP_HN *newClassBitMap,*newSlotBitMap; /* ===================================================== Get the top of the object pattern network and prepare for the traversal to look for shareable pattern nodes ===================================================== */ currentLevel = ObjectNetworkPointer(theEnv); lastLevel = NULL; /* ================================================== Remove slot existence tests from the pattern since these are accounted for by the class bitmap and find the class and slot bitmaps ================================================== */ newSlotBitMap = FormSlotBitMap(theEnv,thePattern->right); thePattern->right = RemoveSlotExistenceTests(theEnv,thePattern->right,&newClassBitMap); thePattern = thePattern->right; /* ========================================= Loop until all fields in the pattern have been added to the pattern network Process the bitmap node ONLY if it is the only node in the pattern ========================================= */ do { if (thePattern->multifieldSlot) { tempPattern = thePattern; thePattern = thePattern->bottom; } /* ========================================== Determine if the last pattern field within a multifield slot is being processed. ========================================== */ if (((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) && (thePattern->right == NULL) && (tempPattern != NULL)) endSlot = TRUE; else endSlot = FALSE; /* ====================================== Is there a node in the pattern network that can be reused (shared)? ====================================== */ newNode = FindObjectPatternNode(currentLevel,thePattern,&nodeSlotGroup,endSlot); /* ============================================== If the pattern node cannot be shared, then add a new pattern node to the pattern network ============================================== */ if (newNode == NULL) newNode = CreateNewObjectPatternNode(theEnv,thePattern,nodeSlotGroup,lastLevel,endSlot); /* ==================================================== Move on to the next field in the pattern to be added ==================================================== */ if ((thePattern->right == NULL) && (tempPattern != NULL)) { thePattern = tempPattern; tempPattern = NULL; } lastLevel = newNode; currentLevel = newNode->nextLevel; thePattern = thePattern->right; } while ((thePattern != NULL) ? (thePattern->userData == NULL) : FALSE); /* =============================================== Return the leaf node of the newly added pattern =============================================== */ newAlphaNode = lastLevel->alphaNode; while (newAlphaNode != NULL) { if ((newClassBitMap == newAlphaNode->classbmp) && (newSlotBitMap == newAlphaNode->slotbmp)) return((struct patternNodeHeader *) newAlphaNode); newAlphaNode = newAlphaNode->nxtInGroup; } newAlphaNode = get_struct(theEnv,objectAlphaNode); InitializePatternHeader(theEnv,&newAlphaNode->header); newAlphaNode->matchTimeTag = 0L; newAlphaNode->patternNode = lastLevel; newAlphaNode->classbmp = newClassBitMap; IncrementBitMapCount(newClassBitMap); MarkBitMapClassesBusy(theEnv,newClassBitMap,1); newAlphaNode->slotbmp = newSlotBitMap; if (newSlotBitMap != NULL) IncrementBitMapCount(newSlotBitMap); newAlphaNode->bsaveID = 0L; newAlphaNode->nxtInGroup = lastLevel->alphaNode; lastLevel->alphaNode = newAlphaNode; newAlphaNode->nxtTerminal = ObjectNetworkTerminalPointer(theEnv); SetObjectNetworkTerminalPointer(theEnv,newAlphaNode); return((struct patternNodeHeader *) newAlphaNode); } /************************************************************************ NAME : FindObjectPatternNode DESCRIPTION : Looks for a pattern node at a specified level in the pattern network that can be reused (shared) with a pattern field being added to the pattern network. INPUTS : 1) The current layer of nodes being examined in the object pattern network 2) The intermediate parse representation of the pattern being added 3) A buffer for holding the first node of a group of slots with the same name as the new node 4) An integer code indicating if this is the last fiedl in a slot pattern or not RETURNS : The old pattern network node matching the new node, or NULL if there is none (nodeSlotGroup will hold the place where to attach a new node) SIDE EFFECTS : nodeSlotGroup set NOTES : None ************************************************************************/ static OBJECT_PATTERN_NODE *FindObjectPatternNode( OBJECT_PATTERN_NODE *listOfNodes, struct lhsParseNode *thePattern, OBJECT_PATTERN_NODE **nodeSlotGroup, unsigned endSlot) { *nodeSlotGroup = NULL; /* ======================================================== Loop through the nodes at the given level in the pattern network looking for a node that can be reused (shared) ======================================================== */ while (listOfNodes != NULL) { /* ======================================================= A object pattern node can be shared if the slot name is the same, the test is on the same field in the pattern, and the network test expressions are the same ======================================================= */ if (((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) ? listOfNodes->multifieldNode : (listOfNodes->multifieldNode == 0)) { if ((thePattern->slotNumber == (int) listOfNodes->slotNameID) && (thePattern->index == (int) listOfNodes->whichField) && (thePattern->singleFieldsAfter == listOfNodes->leaveFields) && (endSlot == listOfNodes->endSlot) && IdenticalExpression(listOfNodes->networkTest,thePattern->networkTest)) return(listOfNodes); } /* ============================================ Find the beginning of a group of nodes with the same slot name testing on the same field ============================================ */ if ((*nodeSlotGroup == NULL) && (thePattern->index == (int) listOfNodes->whichField) && (thePattern->slotNumber == (int) listOfNodes->slotNameID)) *nodeSlotGroup = listOfNodes; listOfNodes = listOfNodes->rightNode; } /* ============================================ A shareable pattern node could not be found. ============================================ */ return(NULL); } /***************************************************************** NAME : CreateNewObjectPatternNode DESCRIPTION : Creates a new pattern node and initializes all of its values. INPUTS : 1) The intermediate parse representation of the new pattern node 2) A pointer to the network node after which to add the new node 3) A pointer to the parent node on the level above to link the new node 4) An integer code indicating if this is the last fiedl in a slot pattern or not RETURNS : A pointer to the new pattern node SIDE EFFECTS : Pattern node allocated, initialized and attached NOTES : None *****************************************************************/ static OBJECT_PATTERN_NODE *CreateNewObjectPatternNode( void *theEnv, struct lhsParseNode *thePattern, OBJECT_PATTERN_NODE *nodeSlotGroup, OBJECT_PATTERN_NODE *upperLevel, unsigned endSlot) { OBJECT_PATTERN_NODE *newNode,*prvNode,*curNode; newNode = get_struct(theEnv,objectPatternNode); newNode->blocked = FALSE; newNode->multifieldNode = FALSE; newNode->alphaNode = NULL; newNode->matchTimeTag = 0L; newNode->nextLevel = NULL; newNode->rightNode = NULL; newNode->leftNode = NULL; newNode->bsaveID = 0L; /* ======================================================== Install the expression associated with this pattern node ======================================================== */ newNode->networkTest = AddHashedExpression(theEnv,(EXPRESSION *) thePattern->networkTest); newNode->whichField = thePattern->index; newNode->leaveFields = thePattern->singleFieldsAfter; /* ====================================== Install the slot name for the new node ====================================== */ newNode->slotNameID = (unsigned) thePattern->slotNumber; if ((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) newNode->multifieldNode = TRUE; newNode->endSlot = endSlot; /* ============================================ Set the upper level pointer for the new node ============================================ */ newNode->lastLevel = upperLevel; /* ============================================ If there are no nodes with this slot name on this level, simply prepend it to the front ============================================ */ if (nodeSlotGroup == NULL) { if (upperLevel == NULL) { newNode->rightNode = ObjectNetworkPointer(theEnv); SetObjectNetworkPointer(theEnv,newNode); } else { newNode->rightNode = upperLevel->nextLevel; upperLevel->nextLevel = newNode; } if (newNode->rightNode != NULL) newNode->rightNode->leftNode = newNode; return(newNode); } /* =========================================================== Group this node with other nodes of the same name testing on the same field in the pattern on this level. This allows us to do some optimization with constant tests on a particular slots. If we put all constant tests for a particular slot/field group at the end of that group, then when one of those test succeeds during pattern-matching, we don't have to test any more of the nodes with that slot/field name to the right. =========================================================== */ prvNode = NULL; curNode = nodeSlotGroup; while ((curNode == NULL) ? FALSE : (curNode->slotNameID == nodeSlotGroup->slotNameID) && (curNode->whichField == nodeSlotGroup->whichField)) { if ((curNode->networkTest == NULL) ? FALSE : ((curNode->networkTest->type != OBJ_PN_CONSTANT) ? FALSE : ((struct ObjectCmpPNConstant *) ValueToBitMap(curNode->networkTest->value))->pass)) break; prvNode = curNode; curNode = curNode->rightNode; } if (curNode != NULL) { newNode->leftNode = curNode->leftNode; newNode->rightNode = curNode; if (curNode->leftNode != NULL) curNode->leftNode->rightNode = newNode; else if (curNode->lastLevel != NULL) curNode->lastLevel->nextLevel = newNode; else SetObjectNetworkPointer(theEnv,newNode); curNode->leftNode = newNode; } else { newNode->leftNode = prvNode; prvNode->rightNode = newNode; } return(newNode); } /******************************************************** NAME : DetachObjectPattern DESCRIPTION : Removes a pattern node and all of its parent nodes from the pattern network. Nodes are only removed if they are no longer shared (i.e. a pattern node that has more than one child node is shared). A pattern from a rule is typically removed by removing the bottom most pattern node used by the pattern and then removing any parent nodes which are not shared by other patterns. Example: Patterns (a b c d) and (a b e f) would be represented by the pattern net shown on the left. If (a b c d) was detached, the resultant pattern net would be the one shown on the right. The '=' represents an end-of-pattern node. a a | | b b | | c--e e | | | d f f | | | = = = INPUTS : The pattern to be removed RETURNS : Nothing useful SIDE EFFECTS : All non-shared nodes associated with the pattern are removed NOTES : None ********************************************************/ static void DetachObjectPattern( void *theEnv, struct patternNodeHeader *thePattern) { OBJECT_ALPHA_NODE *alphaPtr,*prv,*terminalPtr; OBJECT_PATTERN_NODE *patternPtr,*upperLevel; /* ================================================== Get rid of any matches stored in the alpha memory. ================================================== */ alphaPtr = (OBJECT_ALPHA_NODE *) thePattern; ClearObjectPatternMatches(theEnv,alphaPtr); /* ======================================= Unmark the classes to which the pattern is applicable and unmark the class and slot id maps so that they can become ephemeral ======================================= */ MarkBitMapClassesBusy(theEnv,alphaPtr->classbmp,-1); DeleteClassBitMap(theEnv,alphaPtr->classbmp); if (alphaPtr->slotbmp != NULL) DecrementBitMapCount(theEnv,alphaPtr->slotbmp); /* ====================================== Only continue deleting this pattern if this is the last alpha memory attached ====================================== */ prv = NULL; terminalPtr = ObjectNetworkTerminalPointer(theEnv); while (terminalPtr != alphaPtr) { prv = terminalPtr; terminalPtr = terminalPtr->nxtTerminal; } if (prv == NULL) SetObjectNetworkTerminalPointer(theEnv,terminalPtr->nxtTerminal); else prv->nxtTerminal = terminalPtr->nxtTerminal; prv = NULL; terminalPtr = alphaPtr->patternNode->alphaNode; while (terminalPtr != alphaPtr) { prv = terminalPtr; terminalPtr = terminalPtr->nxtInGroup; } if (prv == NULL) { if (alphaPtr->nxtInGroup != NULL) { alphaPtr->patternNode->alphaNode = alphaPtr->nxtInGroup; rtn_struct(theEnv,objectAlphaNode,alphaPtr); return; } } else { prv->nxtInGroup = alphaPtr->nxtInGroup; rtn_struct(theEnv,objectAlphaNode,alphaPtr); return; } alphaPtr->patternNode->alphaNode = NULL; rtn_struct(theEnv,objectAlphaNode,alphaPtr); upperLevel = alphaPtr->patternNode; if (upperLevel->nextLevel != NULL) return; /*==============================================================*/ /* Loop until all appropriate pattern nodes have been detached. */ /*==============================================================*/ while (upperLevel != NULL) { if ((upperLevel->leftNode == NULL) && (upperLevel->rightNode == NULL)) { /*===============================================*/ /* Pattern node is the only node on this level. */ /* Remove it and continue detaching other nodes */ /* above this one, because no other patterns are */ /* dependent upon this node. */ /*===============================================*/ patternPtr = upperLevel; upperLevel = patternPtr->lastLevel; if (upperLevel == NULL) SetObjectNetworkPointer(theEnv,NULL); else { upperLevel->nextLevel = NULL; if (upperLevel->alphaNode != NULL) upperLevel = NULL; } RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest); rtn_struct(theEnv,objectPatternNode,patternPtr); } else if (upperLevel->leftNode != NULL) { /*====================================================*/ /* Pattern node has another pattern node which must */ /* be checked preceding it. Remove the pattern node, */ /* but do not detach any nodes above this one. */ /*====================================================*/ patternPtr = upperLevel; upperLevel->leftNode->rightNode = upperLevel->rightNode; if (upperLevel->rightNode != NULL) { upperLevel->rightNode->leftNode = upperLevel->leftNode; } RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest); rtn_struct(theEnv,objectPatternNode,patternPtr); upperLevel = NULL; } else { /*====================================================*/ /* Pattern node has no pattern node preceding it, but */ /* does have one succeeding it. Remove the pattern */ /* node, but do not detach any nodes above this one. */ /*====================================================*/ patternPtr = upperLevel; upperLevel = upperLevel->lastLevel; if (upperLevel == NULL) { SetObjectNetworkPointer(theEnv,patternPtr->rightNode); } else { upperLevel->nextLevel = patternPtr->rightNode; } patternPtr->rightNode->leftNode = NULL; RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest); rtn_struct(theEnv,objectPatternNode,patternPtr); upperLevel = NULL; } } } /*************************************************** NAME : ClearObjectPatternMatches DESCRIPTION : Removes a pattern node alpha memory from the list of partial matches on all instances (active or garbage collected) INPUTS : The pattern node to remove RETURNS : Nothing useful SIDE EFFECTS : Pattern alpha memory removed from all object partial match lists NOTES : Used when a pattern is removed ***************************************************/ static void ClearObjectPatternMatches( void *theEnv, OBJECT_ALPHA_NODE *alphaPtr) { INSTANCE_TYPE *ins; IGARBAGE *igrb; /* ============================================= Loop through every active and queued instance ============================================= */ ins = InstanceData(theEnv)->InstanceList; while (ins != NULL) { RemoveObjectPartialMatches(theEnv,(INSTANCE_TYPE *) ins,(struct patternNodeHeader *) alphaPtr); ins = ins->nxtList; } /* ============================ Check for garbaged instances ============================ */ igrb = InstanceData(theEnv)->InstanceGarbageList; while (igrb != NULL) { RemoveObjectPartialMatches(theEnv,(INSTANCE_TYPE *) igrb->ins,(struct patternNodeHeader *) alphaPtr); igrb = igrb->nxt; } } /*************************************************** NAME : RemoveObjectPartialMatches DESCRIPTION : Removes a partial match from a list of partial matches for an instance INPUTS : 1) The instance 2) The pattern node header corresponding to the match RETURNS : Nothing useful SIDE EFFECTS : Match removed NOTES : None ***************************************************/ static void RemoveObjectPartialMatches( void *theEnv, INSTANCE_TYPE *ins, struct patternNodeHeader *phead) { struct patternMatch *match_before, *match_ptr; match_before = NULL; match_ptr = (struct patternMatch *) ins->partialMatchList; /* ======================================= Loop through every match for the object ======================================= */ while (match_ptr != NULL) { if (match_ptr->matchingPattern == phead) { ins->busy--; if (match_before == NULL) { ins->partialMatchList = (void *) match_ptr->next; rtn_struct(theEnv,patternMatch,match_ptr); match_ptr = (struct patternMatch *) ins->partialMatchList; } else { match_before->next = match_ptr->next; rtn_struct(theEnv,patternMatch,match_ptr); match_ptr = match_before->next; } } else { match_before = match_ptr; match_ptr = match_ptr->next; } } } /****************************************************** NAME : CheckDuplicateSlots DESCRIPTION : Determines if a restriction has already been defined in a pattern INPUTS : The list of already built restrictions RETURNS : TRUE if a definition already exists, FALSE otherwise SIDE EFFECTS : An error message is printed if a duplicate is found NOTES : None ******************************************************/ static intBool CheckDuplicateSlots( void *theEnv, struct lhsParseNode *nodeList, SYMBOL_HN *slotName) { while (nodeList != NULL) { if (nodeList->slot == slotName) { PrintErrorID(theEnv,"OBJRTBLD",4,TRUE); EnvPrintRouter(theEnv,WERROR,"Multiple restrictions on attribute "); EnvPrintRouter(theEnv,WERROR,ValueToString(slotName)); EnvPrintRouter(theEnv,WERROR," not allowed.\n"); return(TRUE); } nodeList = nodeList->right; } return(FALSE); } /********************************************************** NAME : ParseClassRestriction DESCRIPTION : Parses the single-field constraint on the class an object pattern INPUTS : 1) The logical input source 2) A buffer for tokens RETURNS : The intermediate pattern nodes representing the class constraint (NULL on errors) SIDE EFFECTS : Intermediate pattern nodes allocated NOTES : None **********************************************************/ static struct lhsParseNode *ParseClassRestriction( void *theEnv, char *readSource, struct token *theToken) { struct lhsParseNode *tmpNode; SYMBOL_HN *rln; CONSTRAINT_RECORD *rv; rv = GetConstraintRecord(theEnv); rv->anyAllowed = 0; rv->symbolsAllowed = 1; rln = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); tmpNode = RestrictionParse(theEnv,readSource,theToken,FALSE,rln,ISA_ID,rv,0); if (tmpNode == NULL) { RemoveConstraint(theEnv,rv); return(NULL); } if ((theToken->type != RPAREN) || (tmpNode->type == MF_WILDCARD) || (tmpNode->type == MF_VARIABLE)) { PPBackup(theEnv); if (theToken->type != RPAREN) { SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); } SyntaxErrorMessage(theEnv,"class restriction in object pattern"); ReturnLHSParseNodes(theEnv,tmpNode); RemoveConstraint(theEnv,rv); return(NULL); } tmpNode->derivedConstraints = 1; return(tmpNode); } /********************************************************** NAME : ParseNameRestriction DESCRIPTION : Parses the single-field constraint on the name of an object pattern INPUTS : 1) The logical input source 2) A buffer for tokens RETURNS : The intermediate pattern nodes representing the name constraint (NULL on errors) SIDE EFFECTS : Intermediate pattern nodes allocated NOTES : None **********************************************************/ static struct lhsParseNode *ParseNameRestriction( void *theEnv, char *readSource, struct token *theToken) { struct lhsParseNode *tmpNode; SYMBOL_HN *rln; CONSTRAINT_RECORD *rv; rv = GetConstraintRecord(theEnv); rv->anyAllowed = 0; rv->instanceNamesAllowed = 1; rln = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); tmpNode = RestrictionParse(theEnv,readSource,theToken,FALSE,rln,NAME_ID,rv,0); if (tmpNode == NULL) { RemoveConstraint(theEnv,rv); return(NULL); } if ((theToken->type != RPAREN) || (tmpNode->type == MF_WILDCARD) || (tmpNode->type == MF_VARIABLE)) { PPBackup(theEnv); if (theToken->type != RPAREN) { SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); } SyntaxErrorMessage(theEnv,"name restriction in object pattern"); ReturnLHSParseNodes(theEnv,tmpNode); RemoveConstraint(theEnv,rv); return(NULL); } tmpNode->derivedConstraints = 1; return(tmpNode); } /*************************************************** NAME : ParseSlotRestriction DESCRIPTION : Parses the field constraint(s) on a slot of an object pattern INPUTS : 1) The logical input source 2) A buffer for tokens 3) Constraint record holding the unioned constraints of all the slots which could match the slot pattern 4) A flag indicating if any multifield slots match the name RETURNS : The intermediate pattern nodes representing the slot constraint(s) (NULL on errors) SIDE EFFECTS : Intermediate pattern nodes allocated NOTES : None ***************************************************/ static struct lhsParseNode *ParseSlotRestriction( void *theEnv, char *readSource, struct token *theToken, CONSTRAINT_RECORD *slotConstraints, int multip) { struct lhsParseNode *tmpNode; SYMBOL_HN *slotName; slotName = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); tmpNode = RestrictionParse(theEnv,readSource,theToken,multip,slotName,FindSlotNameID(theEnv,slotName), slotConstraints,1); if (tmpNode == NULL) { RemoveConstraint(theEnv,slotConstraints); return(NULL); } if (theToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); SyntaxErrorMessage(theEnv,"object slot pattern"); ReturnLHSParseNodes(theEnv,tmpNode); RemoveConstraint(theEnv,slotConstraints); return(NULL); } if ((tmpNode->bottom == NULL) && (tmpNode->multifieldSlot)) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } tmpNode->derivedConstraints = 1; return(tmpNode); } /******************************************************** NAME : NewClassBitMap DESCRIPTION : Creates a new bitmap large enough to hold all ids of classes in the system and initializes all the bits to zero or one. INPUTS : 1) The maximum id that will be set in the bitmap 2) An integer code indicating if all the bits are to be set to zero or one RETURNS : The new bitmap SIDE EFFECTS : BitMap allocated and initialized NOTES : None ********************************************************/ static CLASS_BITMAP *NewClassBitMap( void *theEnv, int maxid, int set) { register CLASS_BITMAP *bmp; unsigned size; if (maxid == -1) maxid = 0; size = sizeof(CLASS_BITMAP) + (sizeof(char) * (maxid / BITS_PER_BYTE)); bmp = (CLASS_BITMAP *) gm2(theEnv,size); ClearBitString((void *) bmp,size); bmp->maxid = (unsigned short) maxid; InitializeClassBitMap(theEnv,bmp,set); return(bmp); } /*********************************************************** NAME : InitializeClassBitMap DESCRIPTION : Initializes a bitmap to all zeroes or ones. INPUTS : 1) The bitmap 2) An integer code indicating if all the bits are to be set to zero or one RETURNS : Nothing useful SIDE EFFECTS : The bitmap is initialized NOTES : None ***********************************************************/ static void InitializeClassBitMap( void *theEnv, CLASS_BITMAP *bmp, int set) { register int i,bytes; DEFCLASS *cls; struct defmodule *currentModule; bytes = bmp->maxid / BITS_PER_BYTE + 1; while (bytes > 0) { bmp->map[bytes - 1] = (char) 0; bytes--; } if (set) { currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); for (i = 0 ; i <= (int) bmp->maxid ; i++) { cls = DefclassData(theEnv)->ClassIDMap[i]; if ((cls != NULL) ? DefclassInScope(theEnv,cls,currentModule) : FALSE) { if (cls->reactive && (cls->abstract == 0)) SetBitMap(bmp->map,i); } } } } /******************************************** NAME : DeleteIntermediateClassBitMap DESCRIPTION : Deallocates a bitmap INPUTS : The class set RETURNS : Nothing useful SIDE EFFECTS : Class set deallocated NOTES : None ********************************************/ static void DeleteIntermediateClassBitMap( void *theEnv, CLASS_BITMAP *bmp) { rm(theEnv,(void *) bmp,ClassBitMapSize(bmp)); } /****************************************************** NAME : CopyClassBitMap DESCRIPTION : Increments the in use count of a bitmap and returns the same pointer INPUTS : The bitmap RETURNS : The bitmap SIDE EFFECTS : Increments the in use count NOTES : Class sets are shared by multiple copies of an object pattern within an OR CE. The use count prevents having to make duplicate copies of the bitmap ******************************************************/ #if IBM_TBC #pragma argsused #endif static void *CopyClassBitMap( void *theEnv, void *gset) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (gset != NULL) IncrementBitMapCount(gset); return(gset); } /********************************************************** NAME : DeleteClassBitMap DESCRIPTION : Deallocates a bitmap, and decrements the busy flags of the classes marked in the bitmap INPUTS : The bitmap RETURNS : Nothing useful SIDE EFFECTS : Class set deallocated and classes unmarked NOTES : None **********************************************************/ static void DeleteClassBitMap( void *theEnv, void *gset) { if (gset == NULL) return; DecrementBitMapCount(theEnv,(BITMAP_HN *) gset); } /*************************************************** NAME : MarkBitMapClassesBusy DESCRIPTION : Increments/Decrements busy counts of all classes marked in a bitmap INPUTS : 1) The bitmap hash node 2) 1 or -1 (to increment or decrement class busy counts) RETURNS : Nothing useful SIDE EFFECTS : Bitmap class busy counts updated NOTES : None ***************************************************/ static void MarkBitMapClassesBusy( void *theEnv, BITMAP_HN *bmphn, int offset) { register CLASS_BITMAP *bmp; register unsigned short i; register DEFCLASS *cls; /* ==================================== If a clear is in progress, we do not have to worry about busy counts ==================================== */ if (ConstructData(theEnv)->ClearInProgress) return; bmp = (CLASS_BITMAP *) ValueToBitMap(bmphn); for (i = 0 ; i <= bmp->maxid ; i++) if (TestBitMap(bmp->map,i)) { cls = DefclassData(theEnv)->ClassIDMap[i]; cls->busy += (unsigned int) offset; } } /**************************************************** NAME : EmptyClassBitMap DESCRIPTION : Determines if one or more bits are marked in a bitmap INPUTS : The bitmap RETURNS : TRUE if the set has no bits marked, FALSE otherwise SIDE EFFECTS : None NOTES : None ****************************************************/ static intBool EmptyClassBitMap( CLASS_BITMAP *bmp) { register unsigned short bytes; bytes = (unsigned short) (bmp->maxid / BITS_PER_BYTE + 1); while (bytes > 0) { if (bmp->map[bytes - 1] != (char) 0) return(FALSE); bytes--; } return(TRUE); } /*************************************************** NAME : IdenticalClassBitMap DESCRIPTION : Determines if two bitmaps are identical INPUTS : 1) First bitmap 2) Second bitmap RETURNS : TRUE if bitmaps are the same, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ static intBool IdenticalClassBitMap( CLASS_BITMAP *cs1, CLASS_BITMAP *cs2) { register int i; if (cs1->maxid != cs2->maxid) return(FALSE); for (i = 0 ; i < (int) (cs1->maxid / BITS_PER_BYTE + 1) ; i++) if (cs1->map[i] != cs2->map[i]) return(FALSE); return(TRUE); } /***************************************************************** NAME : ProcessClassRestriction DESCRIPTION : Examines a class restriction and forms a bitmap corresponding to the maximal set of classes which can satisfy a static analysis of the restriction INPUTS : 1) The bitmap to mark classes in 2) The lhsParseNodes of the restriction 3) A flag indicating if this is the first non-recursive call or not RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Class bitmap set and lhsParseNodes corressponding to constant restrictions are removed NOTES : None *****************************************************************/ static intBool ProcessClassRestriction( void *theEnv, CLASS_BITMAP *clsset, struct lhsParseNode **classRestrictions, int recursiveCall) { register struct lhsParseNode *chk,**oraddr; CLASS_BITMAP *tmpset1,*tmpset2; int constant_restriction = TRUE; if (*classRestrictions == NULL) { if (recursiveCall) InitializeClassBitMap(theEnv,clsset,1); return(TRUE); } /* =============================================== Determine the corresponding class set and union it with the current total class set. If an AND restriction is comprised entirely of symbols, it can be removed =============================================== */ tmpset1 = NewClassBitMap(theEnv,((int) DefclassData(theEnv)->MaxClassID) - 1,1); tmpset2 = NewClassBitMap(theEnv,((int) DefclassData(theEnv)->MaxClassID) - 1,0); for (chk = *classRestrictions ; chk != NULL ; chk = chk->right) { if (chk->type == SYMBOL) { chk->value = (void *) LookupDefclassInScope(theEnv,ValueToString(chk->value)); if (chk->value == NULL) { PrintErrorID(theEnv,"OBJRTBLD",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Undefined class in object pattern.\n"); DeleteIntermediateClassBitMap(theEnv,tmpset1); DeleteIntermediateClassBitMap(theEnv,tmpset2); return(FALSE); } if (chk->negated) { InitializeClassBitMap(theEnv,tmpset2,1); MarkBitMapSubclasses(tmpset2->map,(DEFCLASS *) chk->value,0); } else { InitializeClassBitMap(theEnv,tmpset2,0); MarkBitMapSubclasses(tmpset2->map,(DEFCLASS *) chk->value,1); } IntersectClassBitMaps(tmpset1,tmpset2); } else constant_restriction = FALSE; } if (EmptyClassBitMap(tmpset1)) { PrintErrorID(theEnv,"OBJRTBLD",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No objects of existing classes can satisfy "); EnvPrintRouter(theEnv,WERROR,"is-a restriction in object pattern.\n"); DeleteIntermediateClassBitMap(theEnv,tmpset1); DeleteIntermediateClassBitMap(theEnv,tmpset2); return(FALSE); } if (constant_restriction) { chk = *classRestrictions; *classRestrictions = chk->bottom; chk->bottom = NULL; ReturnLHSParseNodes(theEnv,chk); oraddr = classRestrictions; } else oraddr = &(*classRestrictions)->bottom; UnionClassBitMaps(clsset,tmpset1); DeleteIntermediateClassBitMap(theEnv,tmpset1); DeleteIntermediateClassBitMap(theEnv,tmpset2); /* ===================================== Process the next OR class restriction ===================================== */ return(ProcessClassRestriction(theEnv,clsset,oraddr,FALSE)); } /**************************************************************** NAME : ProcessSlotRestriction DESCRIPTION : Determines which slots could match the slot pattern and determines the union of all constraints for the pattern INPUTS : 1) The class set 2) The slot name 3) A buffer to hold a flag indicating if any multifield slots are found w/ this name RETURNS : A union of the constraints on all the slots which could match the slots (NULL if no slots found) SIDE EFFECTS : The class bitmap set is marked/cleared NOTES : None ****************************************************************/ static CONSTRAINT_RECORD *ProcessSlotRestriction( void *theEnv, CLASS_BITMAP *clsset, SYMBOL_HN *slotName, int *multip) { register DEFCLASS *cls; register int si; CONSTRAINT_RECORD *totalConstraints = NULL,*tmpConstraints; register unsigned i; *multip = FALSE; for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++) for (cls = DefclassData(theEnv)->ClassTable[i] ; cls != NULL ; cls = cls->nxtHash) { if (TestBitMap(clsset->map,cls->id)) { si = FindInstanceTemplateSlot(theEnv,cls,slotName); if ((si != -1) ? cls->instanceTemplate[si]->reactive : FALSE) { if (cls->instanceTemplate[si]->multiple) *multip = TRUE; tmpConstraints = UnionConstraints(theEnv,cls->instanceTemplate[si]->constraint,totalConstraints); RemoveConstraint(theEnv,totalConstraints); totalConstraints = tmpConstraints; } else ClearBitMap(clsset->map,cls->id); } } return(totalConstraints); } /**************************************************** NAME : IntersectClassBitMaps DESCRIPTION : Bitwise-ands two bitmaps and stores the result in the first INPUTS : The two bitmaps RETURNS : Nothing useful SIDE EFFECTS : ClassBitMaps anded NOTES : Assumes the first bitmap is at least as large as the second ****************************************************/ static void IntersectClassBitMaps( CLASS_BITMAP *cs1, CLASS_BITMAP *cs2) { register unsigned short bytes; bytes = (unsigned short) (cs2->maxid / BITS_PER_BYTE + 1); while (bytes > 0) { cs1->map[bytes - 1] &= cs2->map[bytes - 1]; bytes--; } } /**************************************************** NAME : UnionClassBitMaps DESCRIPTION : Bitwise-ors two bitmaps and stores the result in the first INPUTS : The two bitmaps RETURNS : Nothing useful SIDE EFFECTS : ClassBitMaps ored NOTES : Assumes the first bitmap is at least as large as the second ****************************************************/ static void UnionClassBitMaps( CLASS_BITMAP *cs1, CLASS_BITMAP *cs2) { register unsigned short bytes; bytes = (unsigned short) (cs2->maxid / BITS_PER_BYTE + 1); while (bytes > 0) { cs1->map[bytes - 1] |= cs2->map[bytes - 1]; bytes--; } } /***************************************************** NAME : PackClassBitMap DESCRIPTION : This routine packs a bitmap bitmap such that at least one of the bits in the rightmost byte is set (i.e. the bitmap takes up the smallest space possible). INPUTS : The bitmap RETURNS : The new (packed) bitmap SIDE EFFECTS : The oldset is deallocated NOTES : None *****************************************************/ static CLASS_BITMAP *PackClassBitMap( void *theEnv, CLASS_BITMAP *oldset) { register unsigned short newmaxid; CLASS_BITMAP *newset; for (newmaxid = oldset->maxid ; newmaxid > 0 ; newmaxid--) if (TestBitMap(oldset->map,newmaxid)) break; if (newmaxid != oldset->maxid) { newset = NewClassBitMap(theEnv,(int) newmaxid,0); GenCopyMemory(char,newmaxid / BITS_PER_BYTE + 1,newset->map,oldset->map); DeleteIntermediateClassBitMap(theEnv,oldset); } else newset = oldset; return(newset); } /***************************************************************** NAME : FilterObjectPattern DESCRIPTION : Appends an extra node to hold the bitmap, and finds is-a and name nodes INPUTS : 1) The object pattern parser address to give to a default is-a slot 2) The unfiltered slot list 3) A buffer to hold the address of the class bitmap restriction node 4) A buffer to hold the address of the is-a restriction node 4) A buffer to hold the address of the name restriction node RETURNS : The filtered slot list SIDE EFFECTS : clsset is attached to extra slot pattern Pointers to the is-a and name slots are also stored (if they exist) for easy reference NOTES : None *****************************************************************/ static struct lhsParseNode *FilterObjectPattern( void *theEnv, struct patternParser *selfPatternType, struct lhsParseNode *unfilteredSlots, struct lhsParseNode **bitmap_slot, struct lhsParseNode **isa_slot, struct lhsParseNode **name_slot) { struct lhsParseNode *prv,*cur; *isa_slot = NULL; *name_slot = NULL; /* ============================================ Create a dummy node to attach to the end of the pattern which holds the class bitmap. ============================================ */ *bitmap_slot = GetLHSParseNode(theEnv); (*bitmap_slot)->type = SF_WILDCARD; (*bitmap_slot)->slot = DefclassData(theEnv)->ISA_SYMBOL; (*bitmap_slot)->slotNumber = ISA_ID; (*bitmap_slot)->index = 1; (*bitmap_slot)->patternType = selfPatternType; (*bitmap_slot)->userData = unfilteredSlots->userData; unfilteredSlots->userData = NULL; /* ======================== Find is-a and name nodes ======================== */ prv = NULL; cur = unfilteredSlots; while (cur != NULL) { if (cur->slot == DefclassData(theEnv)->ISA_SYMBOL) *isa_slot = cur; else if (cur->slot == DefclassData(theEnv)->NAME_SYMBOL) *name_slot = cur; prv = cur; cur = cur->right; } /* ================================ Add the class bitmap conditional element to end of pattern ================================ */ if (prv == NULL) unfilteredSlots = *bitmap_slot; else prv->right = *bitmap_slot; return(unfilteredSlots); } /*************************************************** NAME : FormSlotBitMap DESCRIPTION : Examines an object pattern and forms a minimal bitmap marking the ids of the slots used in the pattern INPUTS : The intermediate parsed pattern RETURNS : The new slot bitmap (can be NULL) SIDE EFFECTS : Bitmap created and added to hash table - corresponding bits set for ids of slots used in pattern NOTES : None ***************************************************/ static BITMAP_HN *FormSlotBitMap( void *theEnv, struct lhsParseNode *thePattern) { struct lhsParseNode *node; int maxSlotID = -1; unsigned size; SLOT_BITMAP *bmp; BITMAP_HN *hshBmp; /* ======================================= Find the largest slot id in the pattern ======================================= */ for (node = thePattern ; node != NULL ; node = node->right) if (node->slotNumber > maxSlotID) maxSlotID = node->slotNumber; /* =================================================== If the pattern contains no slot tests or only tests on the class or name (which do not change) do not store a slot bitmap =================================================== */ if ((maxSlotID == ISA_ID) || (maxSlotID == NAME_ID)) return(NULL); /* =================================== Initialize the bitmap to all zeroes =================================== */ size = (sizeof(SLOT_BITMAP) + (sizeof(char) * (maxSlotID / BITS_PER_BYTE))); bmp = (SLOT_BITMAP *) gm2(theEnv,size); ClearBitString((void *) bmp,size); bmp->maxid = (unsigned short) maxSlotID; /* ============================================ Add (retrieve) a bitmap to (from) the bitmap hash table which has a corresponding bit set for the id of every slot used in the pattern ============================================ */ for (node = thePattern ; node != NULL ; node = node->right) SetBitMap(bmp->map,node->slotNumber); hshBmp = (BITMAP_HN *) AddBitMap(theEnv,(void *) bmp,SlotBitMapSize(bmp)); rm(theEnv,(void *) bmp,size); return(hshBmp); } /**************************************************** NAME : RemoveSlotExistenceTests DESCRIPTION : Removes slot existence test since these are accounted for by class bitmap or name slot. INPUTS : 1) The intermediate pattern nodes 2) A buffer to hold the class bitmap RETURNS : The filtered list SIDE EFFECTS : Slot existence tests removed NOTES : None ****************************************************/ static struct lhsParseNode *RemoveSlotExistenceTests( void *theEnv, struct lhsParseNode *thePattern, BITMAP_HN **bmp) { struct lhsParseNode *tempPattern = thePattern; struct lhsParseNode *lastPattern = NULL, *head = thePattern; while (tempPattern != NULL) { /* ========================================== Remember the class bitmap for this pattern ========================================== */ if (tempPattern->userData != NULL) { *bmp = (BITMAP_HN *) tempPattern->userData; lastPattern = tempPattern; tempPattern = tempPattern->right; } /* =========================================================== A single field slot that has no pattern network expression associated with it can be removed (i.e. any value contained in this slot will satisfy the pattern being matched). =========================================================== */ else if (((tempPattern->type == SF_WILDCARD) || (tempPattern->type == SF_VARIABLE)) && (tempPattern->networkTest == NULL)) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } /* ===================================================== A multifield variable or wildcard within a multifield slot can be removed if there are no other multifield variables or wildcards contained in the same slot (and the multifield has no expressions which must be evaluated in the fact pattern network). ===================================================== */ else if (((tempPattern->type == MF_WILDCARD) || (tempPattern->type == MF_VARIABLE)) && (tempPattern->multifieldSlot == FALSE) && (tempPattern->networkTest == NULL) && (tempPattern->multiFieldsBefore == 0) && (tempPattern->multiFieldsAfter == 0)) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } /* ================================================================ A multifield wildcard or variable contained in a multifield slot that contains no other multifield wildcards or variables, but does have an expression that must be evaluated, can be changed to a single field pattern node with the same expression. ================================================================ */ else if (((tempPattern->type == MF_WILDCARD) || (tempPattern->type == MF_VARIABLE)) && (tempPattern->multifieldSlot == FALSE) && (tempPattern->networkTest != NULL) && (tempPattern->multiFieldsBefore == 0) && (tempPattern->multiFieldsAfter == 0)) { tempPattern->type = SF_WILDCARD; lastPattern = tempPattern; tempPattern = tempPattern->right; } /* ======================================================= If we're dealing with a multifield slot with no slot restrictions, then treat the multfield slot as a single field slot, but attach a test which verifies that the slot contains a zero length multifield value. ======================================================= */ else if ((tempPattern->type == MF_WILDCARD) && (tempPattern->multifieldSlot == TRUE) && (tempPattern->bottom == NULL)) { tempPattern->type = SF_WILDCARD; GenObjectZeroLengthTest(theEnv,tempPattern); tempPattern->multifieldSlot = FALSE; lastPattern = tempPattern; tempPattern = tempPattern->right; } /* ====================================================== Recursively call RemoveSlotExistenceTests for the slot restrictions contained within a multifield slot. ====================================================== */ else if ((tempPattern->type == MF_WILDCARD) && (tempPattern->multifieldSlot == TRUE)) { /* ===================================================== Add an expression to the first pattern restriction in the multifield slot that determines whether or not the fact's slot value contains the minimum number of required fields to satisfy the pattern restrictions for this slot. The length check is place before any other tests, so that preceeding checks do not have to determine if there are enough fields in the slot to safely retrieve a value. ===================================================== */ GenObjectLengthTest(theEnv,tempPattern->bottom); /* ======================================================= Remove any unneeded pattern restrictions from the slot. ======================================================= */ tempPattern->bottom = RemoveSlotExistenceTests(theEnv,tempPattern->bottom,bmp); /* ========================================================= If the slot no longer contains any restrictions, then the multifield slot can be completely removed. In any case, move on to the next slot to be examined for removal. ========================================================= */ if (tempPattern->bottom == NULL) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } else { lastPattern = tempPattern; tempPattern = tempPattern->right; } } /* ===================================================== If none of the other tests for removing slots or slot restrictions apply, then move on to the next slot or slot restriction to be tested. ===================================================== */ else { lastPattern = tempPattern; tempPattern = tempPattern->right; } } /* ==================================== Return the pattern with unused slots and slot restrictions removed. ==================================== */ return(head); } /*************************************************** NAME : CreateInitialObjectPattern DESCRIPTION : Creates a default object pattern for use in defrules INPUTS : None RETURNS : The default initial pattern SIDE EFFECTS : Pattern created NOTES : The pattern created is: (object (is-a INITIAL-OBJECT) (name [initial-object])) ***************************************************/ static struct lhsParseNode *CreateInitialObjectPattern( void *theEnv) { struct lhsParseNode *topNode; CLASS_BITMAP *clsset; int initialObjectClassID; initialObjectClassID = LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME)->id; clsset = NewClassBitMap(theEnv,initialObjectClassID,0); SetBitMap(clsset->map,initialObjectClassID); clsset = PackClassBitMap(theEnv,clsset); topNode = GetLHSParseNode(theEnv); topNode->userData = AddBitMap(theEnv,(void *) clsset,ClassBitMapSize(clsset)); IncrementBitMapCount(topNode->userData); DeleteIntermediateClassBitMap(theEnv,clsset); topNode->type = SF_WILDCARD; topNode->index = 1; topNode->slot = DefclassData(theEnv)->NAME_SYMBOL; topNode->slotNumber = NAME_ID; topNode->bottom = GetLHSParseNode(theEnv); topNode->bottom->type = INSTANCE_NAME; topNode->bottom->value = (void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL; return(topNode); } /************************************************************** NAME : ObjectMatchDelayParse DESCRIPTION : Parses the object-pattern-match-delay function INPUTS : 1) The function call expression 2) The logical name of the input source RETURNS : The top expression with the other action expressions attached SIDE EFFECTS : Parses the function call and attaches the appropriate arguments to the top node NOTES : None **************************************************************/ static EXPRESSION *ObjectMatchDelayParse( void *theEnv, struct expr *top, char *infile) { struct token tkn; IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); top->argList = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tkn.printForm); DecrementIndentDepth(theEnv,3); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } return(top); } /*************************************************** NAME : MarkObjectPtnIncrementalReset DESCRIPTION : Marks/unmarks an object pattern for incremental reset INPUTS : 1) The object pattern alpha node 2) The value to which to set the incremental reset flag RETURNS : Nothing useful SIDE EFFECTS : The pattern node is set/unset NOTES : The pattern node can only be set if it is a new node and thus marked for initialization by PlaceObjectPattern ***************************************************/ #if IBM_TBC #pragma argsused #endif static void MarkObjectPtnIncrementalReset( void *theEnv, struct patternNodeHeader *thePattern, int value) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (thePattern->initialize == FALSE) return; thePattern->initialize = value; } /*********************************************************** NAME : ObjectIncrementalReset DESCRIPTION : Performs an assert for all instances in the system. All new patterns in the pattern network from the new rule have been marked as needing processing. Old patterns will be ignored. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : All objects driven through new patterns NOTES : None ***********************************************************/ static void ObjectIncrementalReset( void *theEnv) { INSTANCE_TYPE *ins; for (ins = InstanceData(theEnv)->InstanceList ; ins != NULL ; ins = ins->nxtList) ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) ins,-1); } #endif #endif clips-6.24/clipssrc/constrct.c0000755000175000017500000006612410441164404014544 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* CONSTRUCT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides basic functionality for creating new */ /* types of constructs, saving constructs to a file, and */ /* adding new functionality to the clear and reset */ /* commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _CONSTRCT_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "scanner.h" #include "watch.h" #include "prcdrfun.h" #include "prcdrpsr.h" #include "argacces.h" #include "exprnpsr.h" #include "multifld.h" #include "moduldef.h" #include "sysdep.h" #include "utility.h" #include "commline.h" #include "constrct.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DeallocateConstructData(void *); /**************************************************/ /* InitializeConstructData: Allocates environment */ /* data for constructs. */ /**************************************************/ globle void InitializeConstructData( void *theEnv) { AllocateEnvironmentData(theEnv,CONSTRUCT_DATA,sizeof(struct constructData),DeallocateConstructData); #if (! RUN_TIME) && (! BLOAD_ONLY) ConstructData(theEnv)->WatchCompilations = ON; #endif } /****************************************************/ /* DeallocateConstructData: Deallocates environment */ /* data for constructs. */ /****************************************************/ static void DeallocateConstructData( void *theEnv) { struct construct *tmpPtr, *nextPtr; #if (! RUN_TIME) && (! BLOAD_ONLY) DeallocateCallList(theEnv,ConstructData(theEnv)->ListOfSaveFunctions); #endif DeallocateCallList(theEnv,ConstructData(theEnv)->ListOfResetFunctions); DeallocateCallList(theEnv,ConstructData(theEnv)->ListOfClearFunctions); DeallocateCallList(theEnv,ConstructData(theEnv)->ListOfClearReadyFunctions); tmpPtr = ConstructData(theEnv)->ListOfConstructs; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,construct,tmpPtr); tmpPtr = nextPtr; } } #if (! RUN_TIME) && (! BLOAD_ONLY) /*************************************************/ /* FindConstruct: Determines whether a construct */ /* type is in the ListOfConstructs. */ /*************************************************/ globle struct construct *FindConstruct( void *theEnv, char *name) { struct construct *currentPtr; for (currentPtr = ConstructData(theEnv)->ListOfConstructs; currentPtr != NULL; currentPtr = currentPtr->next) { if (strcmp(name,currentPtr->constructName) == 0) { return(currentPtr); } } return(NULL); } /***********************************************************/ /* RemoveConstruct: Removes a construct and its associated */ /* parsing function from the ListOfConstructs. Returns */ /* TRUE if the construct type was removed, otherwise */ /* FALSE. */ /***********************************************************/ globle int RemoveConstruct( void *theEnv, char *name) { struct construct *currentPtr, *lastPtr = NULL; for (currentPtr = ConstructData(theEnv)->ListOfConstructs; currentPtr != NULL; currentPtr = currentPtr->next) { if (strcmp(name,currentPtr->constructName) == 0) { if (lastPtr == NULL) { ConstructData(theEnv)->ListOfConstructs = currentPtr->next; } else { lastPtr->next = currentPtr->next; } rtn_struct(theEnv,construct,currentPtr); return(TRUE); } lastPtr = currentPtr; } return(FALSE); } /************************************************/ /* Save: C access routine for the save command. */ /************************************************/ globle int EnvSave( void *theEnv, char *fileName) { struct callFunctionItem *saveFunction; FILE *filePtr; void *defmodulePtr; /*=====================*/ /* Open the save file. */ /*=====================*/ if ((filePtr = GenOpen(theEnv,fileName,"w")) == NULL) { return(FALSE); } /*===========================*/ /* Bypass the router system. */ /*===========================*/ SetFastSave(theEnv,filePtr); /*======================*/ /* Save the constructs. */ /*======================*/ for (defmodulePtr = EnvGetNextDefmodule(theEnv,NULL); defmodulePtr != NULL; defmodulePtr = EnvGetNextDefmodule(theEnv,defmodulePtr)) { for (saveFunction = ConstructData(theEnv)->ListOfSaveFunctions; saveFunction != NULL; saveFunction = saveFunction->next) { ((* (void (*)(void *,void *,char *)) saveFunction->func))(theEnv,defmodulePtr,(char *) filePtr); } } /*======================*/ /* Close the save file. */ /*======================*/ GenClose(theEnv,filePtr); /*===========================*/ /* Remove the router bypass. */ /*===========================*/ SetFastSave(theEnv,NULL); /*=========================*/ /* Return TRUE to indicate */ /* successful completion. */ /*=========================*/ return(TRUE); } /*******************************************************/ /* RemoveSaveFunction: Removes a function from the */ /* ListOfSaveFunctions. Returns TRUE if the function */ /* was successfully removed, otherwise FALSE. */ /*******************************************************/ globle intBool RemoveSaveFunction( void *theEnv, char *name) { int found; ConstructData(theEnv)->ListOfSaveFunctions = RemoveFunctionFromCallList(theEnv,name,ConstructData(theEnv)->ListOfSaveFunctions,&found); if (found) return(TRUE); return(FALSE); } /**********************************/ /* SetCompilationsWatch: Sets the */ /* value of WatchCompilations. */ /**********************************/ globle void SetCompilationsWatch( void *theEnv, unsigned value) { ConstructData(theEnv)->WatchCompilations = value; } /*************************************/ /* GetCompilationsWatch: Returns the */ /* value of WatchCompilations. */ /*************************************/ globle unsigned GetCompilationsWatch( void *theEnv) { return(ConstructData(theEnv)->WatchCompilations); } /**********************************/ /* SetPrintWhileLoading: Sets the */ /* value of PrintWhileLoading. */ /**********************************/ globle void SetPrintWhileLoading( void *theEnv, intBool value) { ConstructData(theEnv)->PrintWhileLoading = value; } /*************************************/ /* GetPrintWhileLoading: Returns the */ /* value of PrintWhileLoading. */ /*************************************/ globle intBool GetPrintWhileLoading( void *theEnv) { return(ConstructData(theEnv)->PrintWhileLoading); } #endif /*************************************/ /* InitializeConstructs: Initializes */ /* the Construct Manager. */ /*************************************/ globle void InitializeConstructs( void *theEnv) { #if (! RUN_TIME) EnvDefineFunction2(theEnv,"clear", 'v', PTIEF ClearCommand, "ClearCommand", "00"); EnvDefineFunction2(theEnv,"reset", 'v', PTIEF ResetCommand, "ResetCommand", "00"); #if DEBUGGING_FUNCTIONS && (! BLOAD_ONLY) AddWatchItem(theEnv,"compilations",0,&ConstructData(theEnv)->WatchCompilations,30,NULL,NULL); #endif #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /**************************************/ /* ClearCommand: H/L access routine */ /* for the clear command. */ /**************************************/ globle void ClearCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"clear",EXACTLY,0) == -1) return; EnvClear(theEnv); return; } /**************************************/ /* ResetCommand: H/L access routine */ /* for the reset command. */ /**************************************/ globle void ResetCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"reset",EXACTLY,0) == -1) return; EnvReset(theEnv); return; } /******************************/ /* EnvReset: C access routine */ /* for the reset command. */ /******************************/ globle void EnvReset( void *theEnv) { struct callFunctionItem *resetPtr; /*=====================================*/ /* The reset command can't be executed */ /* while a reset is in progress. */ /*=====================================*/ if (ConstructData(theEnv)->ResetInProgress) return; ConstructData(theEnv)->ResetInProgress = TRUE; ConstructData(theEnv)->ResetReadyInProgress = TRUE; /*================================================*/ /* If the reset is performed from the top level */ /* command prompt, reset the halt execution flag. */ /*================================================*/ if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE); /*=======================================================*/ /* Call the before reset function to determine if the */ /* reset should continue. [Used by the some of the */ /* windowed interfaces to query the user whether a */ /* reset should proceed with activations on the agenda.] */ /*=======================================================*/ if ((ConstructData(theEnv)->BeforeResetFunction != NULL) ? ((*ConstructData(theEnv)->BeforeResetFunction)(theEnv) == FALSE) : FALSE) { ConstructData(theEnv)->ResetReadyInProgress = FALSE; ConstructData(theEnv)->ResetInProgress = FALSE; return; } ConstructData(theEnv)->ResetReadyInProgress = FALSE; /*===========================*/ /* Call each reset function. */ /*===========================*/ for (resetPtr = ConstructData(theEnv)->ListOfResetFunctions; (resetPtr != NULL) && (GetHaltExecution(theEnv) == FALSE); resetPtr = resetPtr->next) { if (resetPtr->environmentAware) { (*resetPtr->func)(theEnv); } else { (* (void (*)(void)) resetPtr->func)(); } } /*============================================*/ /* Set the current module to the MAIN module. */ /*============================================*/ EnvSetCurrentModule(theEnv,(void *) EnvFindDefmodule(theEnv,"MAIN")); /*===========================================*/ /* Perform periodic cleanup if the reset was */ /* issued from an embedded controller. */ /*===========================================*/ if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } /*===================================*/ /* A reset is no longer in progress. */ /*===================================*/ ConstructData(theEnv)->ResetInProgress = FALSE; } /************************************/ /* SetBeforeResetFunction: Sets the */ /* value of BeforeResetFunction. */ /************************************/ globle int (*SetBeforeResetFunction(void *theEnv, int (*theFunction)(void *)))(void *) { int (*tempFunction)(void *); tempFunction = ConstructData(theEnv)->BeforeResetFunction; ConstructData(theEnv)->BeforeResetFunction = theFunction; return(tempFunction); } #if (! ENVIRONMENT_API_ONLY) && ALLOW_ENVIRONMENT_GLOBALS /*************************************/ /* AddResetFunction: Adds a function */ /* to ListOfResetFunctions. */ /*************************************/ globle intBool AddResetFunction( char *name, void (*functionPtr)(void), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); ConstructData(theEnv)->ListOfResetFunctions = AddFunctionToCallList(theEnv,name,priority,(void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfResetFunctions,FALSE); return(TRUE); } #endif /****************************************/ /* EnvAddResetFunction: Adds a function */ /* to ListOfResetFunctions. */ /****************************************/ globle intBool EnvAddResetFunction( void *theEnv, char *name, void (*functionPtr)(void *), int priority) { ConstructData(theEnv)->ListOfResetFunctions = AddFunctionToCallList(theEnv,name,priority, functionPtr, ConstructData(theEnv)->ListOfResetFunctions,TRUE); return(TRUE); } /**********************************************/ /* EnvRemoveResetFunction: Removes a function */ /* from the ListOfResetFunctions. */ /**********************************************/ globle intBool EnvRemoveResetFunction( void *theEnv, char *name) { int found; ConstructData(theEnv)->ListOfResetFunctions = RemoveFunctionFromCallList(theEnv,name,ConstructData(theEnv)->ListOfResetFunctions,&found); if (found) return(TRUE); return(FALSE); } /*****************************************************/ /* EnvClear: C access routine for the clear command. */ /*****************************************************/ globle void EnvClear( void *theEnv) { struct callFunctionItem *theFunction; /*==========================================*/ /* Activate the watch router which captures */ /* trace output so that it is not displayed */ /* during a clear. */ /*==========================================*/ #if DEBUGGING_FUNCTIONS EnvActivateRouter(theEnv,WTRACE); #endif /*===================================*/ /* Determine if a clear is possible. */ /*===================================*/ ConstructData(theEnv)->ClearReadyInProgress = TRUE; if (ClearReady(theEnv) == FALSE) { PrintErrorID(theEnv,"CONSTRCT",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Some constructs are still in use. Clear cannot continue.\n"); #if DEBUGGING_FUNCTIONS EnvDeactivateRouter(theEnv,WTRACE); #endif ConstructData(theEnv)->ClearReadyInProgress = FALSE; return; } ConstructData(theEnv)->ClearReadyInProgress = FALSE; /*===========================*/ /* Call all clear functions. */ /*===========================*/ ConstructData(theEnv)->ClearInProgress = TRUE; for (theFunction = ConstructData(theEnv)->ListOfClearFunctions; theFunction != NULL; theFunction = theFunction->next) { if (theFunction->environmentAware) { (*theFunction->func)(theEnv); } else { (* (void (*)(void)) theFunction->func)(); } } /*=============================*/ /* Deactivate the watch router */ /* for capturing output. */ /*=============================*/ #if DEBUGGING_FUNCTIONS EnvDeactivateRouter(theEnv,WTRACE); #endif /*===========================================*/ /* Perform periodic cleanup if the clear was */ /* issued from an embedded controller. */ /*===========================================*/ if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } /*===========================*/ /* Clear has been completed. */ /*===========================*/ ConstructData(theEnv)->ClearInProgress = FALSE; } /*********************************************************/ /* ClearReady: Returns TRUE if a clear can be performed, */ /* otherwise FALSE. Note that this is destructively */ /* determined (e.g. facts will be deleted as part of */ /* the determination). */ /*********************************************************/ globle intBool ClearReady( void *theEnv) { struct callFunctionItem *theFunction; int (*tempFunction)(void *); for (theFunction = ConstructData(theEnv)->ListOfClearReadyFunctions; theFunction != NULL; theFunction = theFunction->next) { tempFunction = (int (*)(void *)) theFunction->func; if ((*tempFunction)(theEnv) == FALSE) { return(FALSE); } } return(TRUE); } /******************************************/ /* AddClearReadyFunction: Adds a function */ /* to ListOfClearReadyFunctions. */ /******************************************/ globle intBool AddClearReadyFunction( void *theEnv, char *name, int (*functionPtr)(void *), int priority) { ConstructData(theEnv)->ListOfClearReadyFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfClearReadyFunctions,TRUE); return(1); } /************************************************/ /* RemoveClearReadyFunction: Removes a function */ /* from the ListOfClearReadyFunctions. */ /************************************************/ globle intBool RemoveClearReadyFunction( void *theEnv, char *name) { int found; ConstructData(theEnv)->ListOfClearReadyFunctions = RemoveFunctionFromCallList(theEnv,name,ConstructData(theEnv)->ListOfClearReadyFunctions,&found); if (found) return(TRUE); return(FALSE); } #if (! ENVIRONMENT_API_ONLY) && ALLOW_ENVIRONMENT_GLOBALS /*************************************/ /* AddClearFunction: Adds a function */ /* to ListOfClearFunctions. */ /*************************************/ globle intBool AddClearFunction( char *name, void (*functionPtr)(void), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); ConstructData(theEnv)->ListOfClearFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfClearFunctions,FALSE); return(1); } #endif /****************************************/ /* EnvAddClearFunction: Adds a function */ /* to ListOfClearFunctions. */ /****************************************/ globle intBool EnvAddClearFunction( void *theEnv, char *name, void (*functionPtr)(void *), int priority) { ConstructData(theEnv)->ListOfClearFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfClearFunctions,TRUE); return(1); } /**********************************************/ /* EnvRemoveClearFunction: Removes a function */ /* from the ListOfClearFunctions. */ /**********************************************/ globle intBool EnvRemoveClearFunction( void *theEnv, char *name) { int found; ConstructData(theEnv)->ListOfClearFunctions = RemoveFunctionFromCallList(theEnv,name,ConstructData(theEnv)->ListOfClearFunctions,&found); if (found) return(TRUE); return(FALSE); } /***********************************************/ /* ExecutingConstruct: Returns TRUE if a */ /* construct is currently being executed, */ /* otherwise FALSE. */ /***********************************************/ globle int ExecutingConstruct( void *theEnv) { return(ConstructData(theEnv)->Executing); } /********************************************/ /* SetExecutingConstruct: Sets the value of */ /* the executing variable indicating that */ /* actions such as reset, clear, etc */ /* should not be performed. */ /********************************************/ globle void SetExecutingConstruct( void *theEnv, int value) { ConstructData(theEnv)->Executing = value; } /************************************************************/ /* OldGetConstructList: Returns a list of all the construct */ /* names in a multifield value. It doesn't check the */ /* number of arguments. It assumes that the restriction */ /* string in DefineFunction2 call was "00". */ /************************************************************/ globle void OldGetConstructList( void *theEnv, DATA_OBJECT_PTR returnValue, void *(*nextFunction)(void *,void *), char *(*nameFunction)(void *,void *)) { void *theConstruct; unsigned long count = 0; struct multifield *theList; /*====================================*/ /* Determine the number of constructs */ /* of the specified type. */ /*====================================*/ for (theConstruct = (*nextFunction)(theEnv,NULL); theConstruct != NULL; theConstruct = (*nextFunction)(theEnv,theConstruct)) { count++; } /*===========================*/ /* Create a multifield large */ /* enough to store the list. */ /*===========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*====================================*/ /* Store the names in the multifield. */ /*====================================*/ for (theConstruct = (*nextFunction)(theEnv,NULL), count = 1; theConstruct != NULL; theConstruct = (*nextFunction)(theEnv,theConstruct), count++) { if (EvaluationData(theEnv)->HaltExecution == TRUE) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,EnvAddSymbol(theEnv,(*nameFunction)(theEnv,theConstruct))); } } /*******************************************************/ /* DeinstallConstructHeader: Decrements the busy count */ /* of a construct name and frees its pretty print */ /* representation string (both of which are stored */ /* in the generic construct header). */ /*******************************************************/ globle void DeinstallConstructHeader( void *theEnv, struct constructHeader *theHeader) { DecrementSymbolCount(theEnv,theHeader->name); if (theHeader->ppForm != NULL) { rm(theEnv,theHeader->ppForm, sizeof(char) * (strlen(theHeader->ppForm) + 1)); theHeader->ppForm = NULL; } if (theHeader->usrData != NULL) { ClearUserDataList(theEnv,theHeader->usrData); theHeader->usrData = NULL; } } /**************************************************/ /* DestroyConstructHeader: Frees the pretty print */ /* representation string and user data (both of */ /* which are stored in the generic construct */ /* header). */ /**************************************************/ globle void DestroyConstructHeader( void *theEnv, struct constructHeader *theHeader) { if (theHeader->ppForm != NULL) { rm(theEnv,theHeader->ppForm, sizeof(char) * (strlen(theHeader->ppForm) + 1)); theHeader->ppForm = NULL; } if (theHeader->usrData != NULL) { ClearUserDataList(theEnv,theHeader->usrData); theHeader->usrData = NULL; } } /*****************************************************/ /* AddConstruct: Adds a construct and its associated */ /* parsing function to the ListOfConstructs. */ /*****************************************************/ globle struct construct *AddConstruct( void *theEnv, char *name, char *pluralName, int (*parseFunction)(void *,char *), void *(*findFunction)(void *,char *), SYMBOL_HN *(*getConstructNameFunction)(struct constructHeader *), char *(*getPPFormFunction)(void *,struct constructHeader *), struct defmoduleItemHeader *(*getModuleItemFunction)(struct constructHeader *), void *(*getNextItemFunction)(void *,void *), void (*setNextItemFunction)(struct constructHeader *,struct constructHeader *), intBool (*isConstructDeletableFunction)(void *,void *), int (*deleteFunction)(void *,void *), void (*freeFunction)(void *,void *)) { struct construct *newPtr; /*=============================*/ /* Allocate and initialize the */ /* construct data structure. */ /*=============================*/ newPtr = get_struct(theEnv,construct); newPtr->constructName = name; newPtr->pluralName = pluralName; newPtr->parseFunction = parseFunction; newPtr->findFunction = findFunction; newPtr->getConstructNameFunction = getConstructNameFunction; newPtr->getPPFormFunction = getPPFormFunction; newPtr->getModuleItemFunction = getModuleItemFunction; newPtr->getNextItemFunction = getNextItemFunction; newPtr->setNextItemFunction = setNextItemFunction; newPtr->isConstructDeletableFunction = isConstructDeletableFunction; newPtr->deleteFunction = deleteFunction; newPtr->freeFunction = freeFunction; /*===============================*/ /* Add the construct to the list */ /* of constructs and return it. */ /*===============================*/ newPtr->next = ConstructData(theEnv)->ListOfConstructs; ConstructData(theEnv)->ListOfConstructs = newPtr; return(newPtr); } /************************************/ /* AddSaveFunction: Adds a function */ /* to the ListOfSaveFunctions. */ /************************************/ globle intBool AddSaveFunction( void *theEnv, char *name, void (*functionPtr)(void *,void *,char *), int priority) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(name) #pragma unused(functionPtr) #pragma unused(priority) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) ConstructData(theEnv)->ListOfSaveFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) functionPtr, ConstructData(theEnv)->ListOfSaveFunctions,TRUE); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif return(1); } clips-6.24/clipssrc/._insmoddp.h0000400000175000017500000000061410441072624014721 0ustar jfsjfsMac OS X  2 R:TEXT????`22S2MWBB clips-6.24/clipssrc/._filecom.c0000400000175000017500000000075410441164433014522 0ustar jfsjfsMac OS X  2 RTEXT???? aTTFH MonacoESESSKTTF/BFMWBBMPSRclips-6.24/clipssrc/._tmpltbsc.c0000400000175000017500000000075410441602337014734 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacoj/Ej/E<,,TTFL0PFMPSRMWBBLclips-6.24/clipssrc/utility.c0000755000175000017500000006357510443377364014434 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of utility functions useful to */ /* other modules. Primarily these are the functions for */ /* handling periodic garbage collection and appending */ /* string data. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _UTILITY_SOURCE_ #include "setup.h" #include #include #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "evaluatn.h" #include "facthsh.h" #include "memalloc.h" #include "multifld.h" #include "prntutil.h" #include "utility.h" #define MAX_EPHEMERAL_COUNT 1000L #define MAX_EPHEMERAL_SIZE 10240L #define COUNT_INCREMENT 1000L #define SIZE_INCREMENT 10240L /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool AddCPFunction(void *,char *,void (*)(void *), int,struct cleanupFunction **,intBool); static intBool RemoveCPFunction(void *,char *,struct cleanupFunction **); static void DeallocateUtilityData(void *); /************************************************/ /* InitializeUtilityData: Allocates environment */ /* data for utility routines. */ /************************************************/ globle void InitializeUtilityData( void *theEnv) { AllocateEnvironmentData(theEnv,UTILITY_DATA,sizeof(struct utilityData),DeallocateUtilityData); UtilityData(theEnv)->GarbageCollectionLocks = 0; UtilityData(theEnv)->GarbageCollectionHeuristicsEnabled = TRUE; UtilityData(theEnv)->PeriodicFunctionsEnabled = TRUE; UtilityData(theEnv)->YieldFunctionEnabled = TRUE; UtilityData(theEnv)->CurrentEphemeralCountMax = MAX_EPHEMERAL_COUNT; UtilityData(theEnv)->CurrentEphemeralSizeMax = MAX_EPHEMERAL_SIZE; UtilityData(theEnv)->LastEvaluationDepth = -1; } /**************************************************/ /* DeallocateUtilityData: Deallocates environment */ /* data for utility routines. */ /**************************************************/ static void DeallocateUtilityData( void *theEnv) { struct cleanupFunction *tmpPtr, *nextPtr; tmpPtr = UtilityData(theEnv)->ListOfPeriodicFunctions; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,cleanupFunction,tmpPtr); tmpPtr = nextPtr; } tmpPtr = UtilityData(theEnv)->ListOfCleanupFunctions; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,cleanupFunction,tmpPtr); tmpPtr = nextPtr; } } /*************************************************************/ /* PeriodicCleanup: Returns garbage created during execution */ /* that has not been returned to the memory pool yet. The */ /* cleanup is normally deferred so that an executing rule */ /* can still access these data structures. Always calls a */ /* series of functions that should be called periodically. */ /* Usually used by interfaces to update displays. */ /*************************************************************/ globle void PeriodicCleanup( void *theEnv, intBool cleanupAllDepths, intBool useHeuristics) { int oldDepth = -1; struct cleanupFunction *cleanupPtr,*periodPtr; /*===================================*/ /* Don't use heuristics if disabled. */ /*===================================*/ if (! UtilityData(theEnv)->GarbageCollectionHeuristicsEnabled) { useHeuristics = FALSE; } /*=============================================*/ /* Call functions for handling periodic tasks. */ /*=============================================*/ if (UtilityData(theEnv)->PeriodicFunctionsEnabled) { for (periodPtr = UtilityData(theEnv)->ListOfPeriodicFunctions; periodPtr != NULL; periodPtr = periodPtr->next) { if (periodPtr->environmentAware) { (*periodPtr->ip)(theEnv); } else { (* (void (*)(void)) periodPtr->ip)(); } } } /*===================================================*/ /* If the last level we performed cleanup was deeper */ /* than the current level, reset the values used by */ /* the heuristics to determine if garbage collection */ /* should be performed. If the heuristic values had */ /* to be incremented because there was no garbage */ /* that could be cleaned up, we don't want to keep */ /* those same high values permanently so we reset */ /* them when we go back to a lower evaluation depth. */ /*===================================================*/ if (UtilityData(theEnv)->LastEvaluationDepth > EvaluationData(theEnv)->CurrentEvaluationDepth) { UtilityData(theEnv)->LastEvaluationDepth = EvaluationData(theEnv)->CurrentEvaluationDepth; UtilityData(theEnv)->CurrentEphemeralCountMax = MAX_EPHEMERAL_COUNT; UtilityData(theEnv)->CurrentEphemeralSizeMax = MAX_EPHEMERAL_SIZE; } /*======================================================*/ /* If we're using heuristics to determine if garbage */ /* collection to occur, then check to see if enough */ /* garbage has been created to make cleanup worthwhile. */ /*======================================================*/ if (UtilityData(theEnv)->GarbageCollectionLocks > 0) return; if (useHeuristics && (UtilityData(theEnv)->EphemeralItemCount < UtilityData(theEnv)->CurrentEphemeralCountMax) && (UtilityData(theEnv)->EphemeralItemSize < UtilityData(theEnv)->CurrentEphemeralSizeMax)) { return; } /*==========================================================*/ /* If cleanup is being performed at all depths, rather than */ /* just the current evaluation depth, then temporarily set */ /* the evaluation depth to a level that will force cleanup */ /* at all depths. */ /*==========================================================*/ if (cleanupAllDepths) { oldDepth = EvaluationData(theEnv)->CurrentEvaluationDepth; EvaluationData(theEnv)->CurrentEvaluationDepth = -1; } /*=============================================*/ /* Free up multifield values no longer in use. */ /*=============================================*/ FlushMultifields(theEnv); /*=====================================*/ /* Call the list of cleanup functions. */ /*=====================================*/ for (cleanupPtr = UtilityData(theEnv)->ListOfCleanupFunctions; cleanupPtr != NULL; cleanupPtr = cleanupPtr->next) { if (cleanupPtr->environmentAware) { (*cleanupPtr->ip)(theEnv); } else { (* (void (*)(void)) cleanupPtr->ip)(); } } /*================================================*/ /* Free up atomic values that are no longer used. */ /*================================================*/ RemoveEphemeralAtoms(theEnv); /*=========================================*/ /* Restore the evaluation depth if cleanup */ /* was performed on all depths. */ /*=========================================*/ if (cleanupAllDepths) EvaluationData(theEnv)->CurrentEvaluationDepth = oldDepth; /*============================================================*/ /* If very little memory was freed up, then increment the */ /* values used by the heuristics so that we don't continually */ /* try to free up memory that isn't being released. */ /*============================================================*/ if ((UtilityData(theEnv)->EphemeralItemCount + COUNT_INCREMENT) > UtilityData(theEnv)->CurrentEphemeralCountMax) { UtilityData(theEnv)->CurrentEphemeralCountMax = UtilityData(theEnv)->EphemeralItemCount + COUNT_INCREMENT; } if ((UtilityData(theEnv)->EphemeralItemSize + SIZE_INCREMENT) > UtilityData(theEnv)->CurrentEphemeralSizeMax) { UtilityData(theEnv)->CurrentEphemeralSizeMax = UtilityData(theEnv)->EphemeralItemSize + SIZE_INCREMENT; } /*===============================================================*/ /* Remember the evaluation depth at which garbage collection was */ /* last performed. This information is used for resetting the */ /* ephemeral count and size numbers used by the heuristics. */ /*===============================================================*/ UtilityData(theEnv)->LastEvaluationDepth = EvaluationData(theEnv)->CurrentEvaluationDepth; } /***************************************************/ /* AddCleanupFunction: Adds a function to the list */ /* of functions called to perform cleanup such */ /* as returning free memory to the memory pool. */ /***************************************************/ globle intBool AddCleanupFunction( void *theEnv, char *name, void (*theFunction)(void *), int priority) { return(AddCPFunction(theEnv,name,theFunction,priority,&UtilityData(theEnv)->ListOfCleanupFunctions,TRUE)); } #if (! ENVIRONMENT_API_ONLY) && ALLOW_ENVIRONMENT_GLOBALS /****************************************************/ /* AddPeriodicFunction: Adds a function to the list */ /* of functions called to handle periodic tasks. */ /****************************************************/ globle intBool AddPeriodicFunction( char *name, void (*theFunction)(void), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); return(AddCPFunction(theEnv,name,(void (*)(void *)) theFunction,priority, &UtilityData(theEnv)->ListOfPeriodicFunctions,FALSE)); } #endif /*******************************************************/ /* EnvAddPeriodicFunction: Adds a function to the list */ /* of functions called to handle periodic tasks. */ /*******************************************************/ globle intBool EnvAddPeriodicFunction( void *theEnv, char *name, void (*theFunction)(void *), int priority) { return(AddCPFunction(theEnv,name,theFunction,priority,&UtilityData(theEnv)->ListOfPeriodicFunctions,TRUE)); } /**********************************/ /* AddCPFunction: Adds a function */ /* to a list of functions. */ /**********************************/ static intBool AddCPFunction( void *theEnv, char *name, void (*theFunction)(void *), int priority, struct cleanupFunction **head, intBool environmentAware) { struct cleanupFunction *newPtr, *currentPtr, *lastPtr = NULL; newPtr = get_struct(theEnv,cleanupFunction); newPtr->name = name; newPtr->ip = theFunction; newPtr->priority = priority; newPtr->environmentAware = (short) environmentAware; if (*head == NULL) { newPtr->next = NULL; *head = newPtr; return(1); } currentPtr = *head; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = *head; *head = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(1); } /*******************************************************/ /* RemoveCleanupFunction: Removes a function from the */ /* list of functions called to perform cleanup such */ /* as returning free memory to the memory pool. */ /*******************************************************/ globle intBool RemoveCleanupFunction( void *theEnv, char *name) { return(RemoveCPFunction(theEnv,name,&UtilityData(theEnv)->ListOfCleanupFunctions)); } /**********************************************************/ /* EnvRemovePeriodicFunction: Removes a function from the */ /* list of functions called to handle periodic tasks. */ /**********************************************************/ globle intBool EnvRemovePeriodicFunction( void *theEnv, char *name) { return(RemoveCPFunction(theEnv,name,&UtilityData(theEnv)->ListOfPeriodicFunctions)); } /****************************************/ /* RemoveCPFunction: Removes a function */ /* from a list of functions. */ /****************************************/ static intBool RemoveCPFunction( void *theEnv, char *name, struct cleanupFunction **head) { struct cleanupFunction *currentPtr, *lastPtr; lastPtr = NULL; currentPtr = *head; while (currentPtr != NULL) { if (strcmp(name,currentPtr->name) == 0) { if (lastPtr == NULL) { *head = currentPtr->next; } else { lastPtr->next = currentPtr->next; } rtn_struct(theEnv,cleanupFunction,currentPtr); return(TRUE); } lastPtr = currentPtr; currentPtr = currentPtr->next; } return(FALSE); } /*****************************************************/ /* StringPrintForm: Generates printed representation */ /* of a string. Replaces / with // and " with /". */ /*****************************************************/ globle char *StringPrintForm( void *theEnv, char *str) { int i = 0, pos = 0; unsigned max = 0; char *theString = NULL; void *thePtr; theString = ExpandStringWithChar(theEnv,'"',theString,&pos,&max,max+80); while (str[i] != EOS) { if ((str[i] == '"') || (str[i] == '\\')) { theString = ExpandStringWithChar(theEnv,'\\',theString,&pos,&max,max+80); theString = ExpandStringWithChar(theEnv,str[i],theString,&pos,&max,max+80); } else { theString = ExpandStringWithChar(theEnv,str[i],theString,&pos,&max,max+80); } i++; } theString = ExpandStringWithChar(theEnv,'"',theString,&pos,&max,max+80); thePtr = EnvAddSymbol(theEnv,theString); rm(theEnv,theString,max); return(ValueToString(thePtr)); } /***********************************************************/ /* AppendStrings: Appends two strings together. The string */ /* created is added to the SymbolTable, so it is not */ /* necessary to deallocate the string returned. */ /***********************************************************/ globle char *AppendStrings( void *theEnv, char *str1, char *str2) { int pos = 0; unsigned max = 0; char *theString = NULL; void *thePtr; theString = AppendToString(theEnv,str1,theString,&pos,&max); theString = AppendToString(theEnv,str2,theString,&pos,&max); thePtr = EnvAddSymbol(theEnv,theString); rm(theEnv,theString,max); return(ValueToString(thePtr)); } /******************************************************/ /* AppendToString: Appends a string to another string */ /* (expanding the other string if necessary). */ /******************************************************/ globle char *AppendToString( void *theEnv, char *appendStr, char *oldStr, int *oldPos, unsigned *oldMax) { size_t length; /*=========================================*/ /* Expand the old string so it can contain */ /* the new string (if necessary). */ /*=========================================*/ length = strlen(appendStr); if (length + *oldPos + 1 > *oldMax) { oldStr = (char *) genrealloc(theEnv,oldStr,(unsigned) *oldMax,(unsigned) length + *oldPos + 1); *oldMax = length + *oldPos + 1; } /*==============================================================*/ /* Return NULL if the old string was not successfully expanded. */ /*==============================================================*/ if (oldStr == NULL) { return(NULL); } /*===============================================*/ /* Append the new string to the expanded string. */ /*===============================================*/ strcpy(&oldStr[*oldPos],appendStr); *oldPos += (int) length; /*============================================================*/ /* Return the expanded string containing the appended string. */ /*============================================================*/ return(oldStr); } /*******************************************************/ /* AppendNToString: Appends a string to another string */ /* (expanding the other string if necessary). Only a */ /* specified number of characters are appended from */ /* the string. */ /*******************************************************/ globle char *AppendNToString( void *theEnv, char *appendStr, char *oldStr, unsigned length, int *oldPos, unsigned *oldMax) { unsigned lengthWithEOS; /*====================================*/ /* Determine the number of characters */ /* to be appended from the string. */ /*====================================*/ if (appendStr[length-1] != '\0') lengthWithEOS = length + 1; else lengthWithEOS = length; /*=========================================*/ /* Expand the old string so it can contain */ /* the new string (if necessary). */ /*=========================================*/ if (lengthWithEOS + *oldPos > *oldMax) { oldStr = (char *) genrealloc(theEnv,oldStr,(unsigned) *oldMax,(unsigned) *oldPos + lengthWithEOS); *oldMax = (unsigned) *oldPos + lengthWithEOS; } /*==============================================================*/ /* Return NULL if the old string was not successfully expanded. */ /*==============================================================*/ if (oldStr == NULL) { return(NULL); } /*==================================*/ /* Append N characters from the new */ /* string to the expanded string. */ /*==================================*/ strncpy(&oldStr[*oldPos],appendStr,(STD_SIZE) length); *oldPos += (int) (lengthWithEOS - 1); oldStr[*oldPos] = '\0'; /*============================================================*/ /* Return the expanded string containing the appended string. */ /*============================================================*/ return(oldStr); } /*******************************************************/ /* ExpandStringWithChar: Adds a character to a string, */ /* reallocating space for the string if it needs to */ /* be enlarged. The backspace character causes the */ /* size of the string to reduced if it is "added" to */ /* the string. */ /*******************************************************/ globle char *ExpandStringWithChar( void *theEnv, int inchar, char *str, int *pos, unsigned *max, unsigned newSize) { if ((*pos + 1) >= (int) *max) { str = (char *) genrealloc(theEnv,str,*max,newSize); *max = newSize; } if (inchar != '\b') { str[*pos] = (char) inchar; (*pos)++; str[*pos] = '\0'; } else { if (*pos > 0) (*pos)--; str[*pos] = '\0'; } return(str); } /*****************************************************************/ /* AddFunctionToCallList: Adds a function to a list of functions */ /* which are called to perform certain operations (e.g. clear, */ /* reset, and bload functions). */ /*****************************************************************/ globle struct callFunctionItem *AddFunctionToCallList( void *theEnv, char *name, int priority, void (*func)(void *), struct callFunctionItem *head, intBool environmentAware) { struct callFunctionItem *newPtr, *currentPtr, *lastPtr = NULL; newPtr = get_struct(theEnv,callFunctionItem); newPtr->name = name; newPtr->func = func; newPtr->priority = priority; newPtr->environmentAware = (short) environmentAware; if (head == NULL) { newPtr->next = NULL; return(newPtr); } currentPtr = head; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = head; head = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(head); } /*****************************************************************/ /* RemoveFunctionFromCallList: Removes a function from a list of */ /* functions which are called to perform certain operations */ /* (e.g. clear, reset, and bload functions). */ /*****************************************************************/ globle struct callFunctionItem *RemoveFunctionFromCallList( void *theEnv, char *name, struct callFunctionItem *head, int *found) { struct callFunctionItem *currentPtr, *lastPtr; *found = FALSE; lastPtr = NULL; currentPtr = head; while (currentPtr != NULL) { if (strcmp(name,currentPtr->name) == 0) { *found = TRUE; if (lastPtr == NULL) { head = currentPtr->next; } else { lastPtr->next = currentPtr->next; } rtn_struct(theEnv,callFunctionItem,currentPtr); return(head); } lastPtr = currentPtr; currentPtr = currentPtr->next; } return(head); } /**************************************************************/ /* DeallocateCallList: Removes all functions from a list of */ /* functions which are called to perform certain operations */ /* (e.g. clear, reset, and bload functions). */ /**************************************************************/ globle void DeallocateCallList( void *theEnv, struct callFunctionItem *theList) { struct callFunctionItem *tmpPtr, *nextPtr; tmpPtr = theList; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,callFunctionItem,tmpPtr); tmpPtr = nextPtr; } } /*****************************************/ /* ItemHashValue: Returns the hash value */ /* for the specified value. */ /*****************************************/ globle unsigned ItemHashValue( void *theEnv, unsigned short theType, void *theValue, unsigned theRange) { switch(theType) { case FLOAT: return(HashFloat(ValueToDouble(theValue),theRange)); case INTEGER: return(HashInteger(ValueToLong(theValue),theRange)); case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif return(HashSymbol(ValueToString(theValue),theRange)); case MULTIFIELD: return(HashMultifield((struct multifield *) theValue,theRange)); #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS: return(HashFact((struct fact *) theValue) % theRange); #endif case EXTERNAL_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif return(((unsigned) theValue) % theRange); } SystemError(theEnv,"UTILITY",1); return(0); } /********************************************/ /* YieldTime: Yields time to a user-defined */ /* function. Intended to allow foreground */ /* application responsiveness when CLIPS */ /* is running in the background. */ /********************************************/ void YieldTime( void *theEnv) { if ((UtilityData(theEnv)->YieldTimeFunction != NULL) && UtilityData(theEnv)->YieldFunctionEnabled) { (*UtilityData(theEnv)->YieldTimeFunction)(); } } /********************************************/ /* SetGarbageCollectionHeuristics: */ /********************************************/ short SetGarbageCollectionHeuristics( void *theEnv, short newValue) { short oldValue; oldValue = UtilityData(theEnv)->GarbageCollectionHeuristicsEnabled; UtilityData(theEnv)->GarbageCollectionHeuristicsEnabled = newValue; return(oldValue); } /**********************************************/ /* EnvIncrementGCLocks: Increments the number */ /* of garbage collection locks. */ /**********************************************/ globle void EnvIncrementGCLocks( void *theEnv) { UtilityData(theEnv)->GarbageCollectionLocks++; } /**********************************************/ /* EnvDecrementGCLocks: Decrements the number */ /* of garbage collection locks. */ /**********************************************/ globle void EnvDecrementGCLocks( void *theEnv) { if (UtilityData(theEnv)->GarbageCollectionLocks > 0) { UtilityData(theEnv)->GarbageCollectionLocks--; } } /********************************************/ /* EnablePeriodicFunctions: */ /********************************************/ short EnablePeriodicFunctions( void *theEnv, short value) { short oldValue; oldValue = UtilityData(theEnv)->PeriodicFunctionsEnabled; UtilityData(theEnv)->PeriodicFunctionsEnabled = value; return(oldValue); } /********************************************/ /* EnableYieldFunction: */ /********************************************/ short EnableYieldFunction( void *theEnv, short value) { short oldValue; oldValue = UtilityData(theEnv)->YieldFunctionEnabled; UtilityData(theEnv)->YieldFunctionEnabled = value; return(oldValue); } clips-6.24/clipssrc/._modulpsr.c0000400000175000017500000000075410441150035014742 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z:MTTFS FMWBBMPSRclips-6.24/clipssrc/exprnpsr.h0000755000175000017500000000661110441132046014563 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EXPRESSION PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for parsing expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_exprnpsr #define _H_exprnpsr #if (! RUN_TIME) typedef struct saved_contexts { int rtn; int brk; struct saved_contexts *nxt; } SAVED_CONTEXTS; #endif #ifndef _H_extnfunc #include "extnfunc.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _EXPRNPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetSequenceOperatorRecognition(theEnv) EnvGetSequenceOperatorRecognition(theEnv) #define SetSequenceOperatorRecognition(theEnv,a) EnvSetSequenceOperatorRecognition(theEnv,a) #else #define GetSequenceOperatorRecognition() EnvGetSequenceOperatorRecognition(GetCurrentEnvironment()) #define SetSequenceOperatorRecognition(a) EnvSetSequenceOperatorRecognition(GetCurrentEnvironment(),a) #endif LOCALE struct expr *Function0Parse(void *,char *); LOCALE struct expr *Function1Parse(void *,char *); LOCALE struct expr *Function2Parse(void *,char *,char *); LOCALE void PushRtnBrkContexts(void *); LOCALE void PopRtnBrkContexts(void *); LOCALE intBool ReplaceSequenceExpansionOps(void *,struct expr *,struct expr *, void *,void *); LOCALE struct expr *CollectArguments(void *,struct expr *,char *); LOCALE struct expr *ArgumentParse(void *,char *,int *); LOCALE struct expr *ParseAtomOrExpression(void *,char *,struct token *); LOCALE EXPRESSION *ParseConstantArguments(void *,char *,int *); LOCALE intBool EnvSetSequenceOperatorRecognition(void *,int); LOCALE intBool EnvGetSequenceOperatorRecognition(void *); LOCALE struct expr *GroupActions(void *,char *,struct token *,int,char *,int); LOCALE struct expr *RemoveUnneededProgn(void *,struct expr *); #if (! RUN_TIME) LOCALE int CheckExpressionAgainstRestrictions(void *,struct expr *,char *,char *); #endif #endif clips-6.24/clipssrc/._analysis.c0000400000175000017500000000075410441127627014733 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco4949llTTFSFMWBBMPSRclips-6.24/clipssrc/._insquery.c0000400000175000017500000000075410441147617014770 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0c0c9TTFS FMWBBMPSRclips-6.24/clipssrc/._tmpltcmp.c0000400000175000017500000000075410177533462014754 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco00$R//-vTTFe)FMWBBMPSRclips-6.24/clipssrc/._insfun.c0000400000175000017500000000452210441602227014401 0ustar jfsjfsMac OS X  2 R TEXTR*ch ninsfun.cntrol PanelTCmr.txt.docTEXTR*ch@ p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco0mc0mc9yynL,.nGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/insqypsr.c0000755000175000017500000005767310441147636014616 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* INSTANCE-SET QUERIES PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Instance_set Queries Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if INSTANCE_SET_QUERIES && (! RUN_TIME) #include #include "classcom.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "extnfunc.h" #include "insquery.h" #include "prcdrpsr.h" #include "prntutil.h" #include "router.h" #include "scanner.h" #include "strngrtr.h" #define _INSQYPSR_SOURCE_ #include "insqypsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define INSTANCE_SLOT_REF ':' /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static EXPRESSION *ParseQueryRestrictions(void *,EXPRESSION *,char *,struct token *); static intBool ReplaceClassNameWithReference(void *,EXPRESSION *); static int ParseQueryTestExpression(void *,EXPRESSION *,char *); static int ParseQueryActionExpression(void *,EXPRESSION *,char *,EXPRESSION *,struct token *); static void ReplaceInstanceVariables(void *,EXPRESSION *,EXPRESSION *,int,int); static void ReplaceSlotReference(void *,EXPRESSION *,EXPRESSION *, struct FunctionDefinition *,int); static int IsQueryFunction(EXPRESSION *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************************** NAME : ParseQueryNoAction DESCRIPTION : Parses the following functions : (any-instancep) (find-first-instance) (find-all-instances) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : ( ) :== (+) :== ( +) Parses into following form : | V -> -> -> (QDS) -> -> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *ParseQueryNoAction( void *theEnv, EXPRESSION *top, char *readSource) { EXPRESSION *insQuerySetVars; struct token queryInputToken; insQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (insQuerySetVars == NULL) return(NULL); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); GetToken(theEnv,readSource,&queryInputToken); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } ReplaceInstanceVariables(theEnv,insQuerySetVars,top->argList,TRUE,0); ReturnExpression(theEnv,insQuerySetVars); return(top); } /*********************************************************************** NAME : ParseQueryAction DESCRIPTION : Parses the following functions : (do-for-instance) (do-for-all-instances) (delayed-do-for-all-instances) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : ( ) :== (+) :== ( +) Parses into following form : | V -> -> -> -> (QDS) -> -> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *ParseQueryAction( void *theEnv, EXPRESSION *top, char *readSource) { EXPRESSION *insQuerySetVars; struct token queryInputToken; insQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (insQuerySetVars == NULL) return(NULL); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } PPCRAndIndent(theEnv); if (ParseQueryActionExpression(theEnv,top,readSource,insQuerySetVars,&queryInputToken) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } ReplaceInstanceVariables(theEnv,insQuerySetVars,top->argList,TRUE,0); ReplaceInstanceVariables(theEnv,insQuerySetVars,top->argList->nextArg,FALSE,0); ReturnExpression(theEnv,insQuerySetVars); return(top); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************** NAME : ParseQueryRestrictions DESCRIPTION : Parses the class restrictions for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input 3) Caller's token buffer RETURNS : The instance-variable expressions SIDE EFFECTS : Entire query expression deleted on errors Nodes allocated for restrictions and instance variable expressions Class restrictions attached to query-expression as arguments NOTES : Expects top != NULL ***************************************************************/ static EXPRESSION *ParseQueryRestrictions( void *theEnv, EXPRESSION *top, char *readSource, struct token *queryInputToken) { EXPRESSION *insQuerySetVars = NULL,*lastInsQuerySetVars = NULL, *classExp = NULL,*lastClassExp, *tmp,*lastOne = NULL; int error = FALSE; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != LPAREN) goto ParseQueryRestrictionsError1; GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != LPAREN) goto ParseQueryRestrictionsError1; while (queryInputToken->type == LPAREN) { GetToken(theEnv,readSource,queryInputToken); if (queryInputToken->type != SF_VARIABLE) goto ParseQueryRestrictionsError1; tmp = insQuerySetVars; while (tmp != NULL) { if (tmp->value == queryInputToken->value) { PrintErrorID(theEnv,"INSQYPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate instance member variable name in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); goto ParseQueryRestrictionsError2; } tmp = tmp->nextArg; } tmp = GenConstant(theEnv,SF_VARIABLE,queryInputToken->value); if (insQuerySetVars == NULL) insQuerySetVars = tmp; else lastInsQuerySetVars->nextArg = tmp; lastInsQuerySetVars = tmp; SavePPBuffer(theEnv," "); classExp = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseQueryRestrictionsError2; if (classExp == NULL) goto ParseQueryRestrictionsError1; if (ReplaceClassNameWithReference(theEnv,classExp) == FALSE) goto ParseQueryRestrictionsError2; lastClassExp = classExp; SavePPBuffer(theEnv," "); while ((tmp = ArgumentParse(theEnv,readSource,&error)) != NULL) { if (ReplaceClassNameWithReference(theEnv,tmp) == FALSE) goto ParseQueryRestrictionsError2; lastClassExp->nextArg = tmp; lastClassExp = tmp; SavePPBuffer(theEnv," "); } if (error) goto ParseQueryRestrictionsError2; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); tmp = GenConstant(theEnv,SYMBOL,(void *) InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); lastClassExp->nextArg = tmp; lastClassExp = tmp; if (top->argList == NULL) top->argList = classExp; else lastOne->nextArg = classExp; lastOne = lastClassExp; classExp = NULL; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,queryInputToken); } if (queryInputToken->type != RPAREN) goto ParseQueryRestrictionsError1; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); return(insQuerySetVars); ParseQueryRestrictionsError1: SyntaxErrorMessage(theEnv,"instance-set query function"); ParseQueryRestrictionsError2: ReturnExpression(theEnv,classExp); ReturnExpression(theEnv,top); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } /*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing an instance-set query, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current and imported modules for reference ***************************************************/ static intBool ReplaceClassNameWithReference( void *theEnv, EXPRESSION *theExp) { char *theClassName; void *theDefclass; if (theExp->type == SYMBOL) { theClassName = ValueToString(theExp->value); theDefclass = (void *) LookupDefclassByMdlOrScope(theEnv,theClassName); if (theDefclass == NULL) { CantFindItemErrorMessage(theEnv,"class",theClassName); return(FALSE); } theExp->type = DEFCLASS_PTR; theExp->value = theDefclass; } return(TRUE); } /************************************************************* NAME : ParseQueryTestExpression DESCRIPTION : Parses the test-expression for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Entire query-expression deleted on errors Nodes allocated for new expression Test shoved in front of class-restrictions on query argument list NOTES : Expects top != NULL *************************************************************/ static int ParseQueryTestExpression( void *theEnv, EXPRESSION *top, char *readSource) { EXPRESSION *qtest; int error; struct BindInfo *oldBindList; error = FALSE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); qtest = ArgumentParse(theEnv,readSource,&error); if (error == TRUE) { SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(FALSE); } if (qtest == NULL) { SetParsedBindNames(theEnv,oldBindList); SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); return(FALSE); } qtest->nextArg = top->argList; top->argList = qtest; if (ParsedBindNamesEmpty(theEnv) == FALSE) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"INSQYPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in instance-set query in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); ReturnExpression(theEnv,top); return(FALSE); } SetParsedBindNames(theEnv,oldBindList); return(TRUE); } /************************************************************* NAME : ParseQueryActionExpression DESCRIPTION : Parses the action-expression for a query INPUTS : 1) The top node of the query expression 2) The logical name of the input 3) List of query parameters RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Entire query-expression deleted on errors Nodes allocated for new expression Action shoved in front of class-restrictions and in back of test-expression on query argument list NOTES : Expects top != NULL && top->argList != NULL *************************************************************/ static int ParseQueryActionExpression( void *theEnv, EXPRESSION *top, char *readSource, EXPRESSION *insQuerySetVars, struct token *queryInputToken) { EXPRESSION *qaction,*tmpInsSetVars; int error; struct BindInfo *oldBindList,*newBindList,*prev; error = FALSE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); ExpressionData(theEnv)->BreakContext = TRUE; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; qaction = GroupActions(theEnv,readSource,queryInputToken,TRUE,NULL,FALSE); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,queryInputToken->printForm); ExpressionData(theEnv)->BreakContext = FALSE; if (error == TRUE) { SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,top); return(FALSE); } if (qaction == NULL) { SetParsedBindNames(theEnv,oldBindList); SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); return(FALSE); } qaction->nextArg = top->argList->nextArg; top->argList->nextArg = qaction; newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { tmpInsSetVars = insQuerySetVars; while (tmpInsSetVars != NULL) { if (tmpInsSetVars->value == (void *) newBindList->name) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"INSQYPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind instance-set member variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(tmpInsSetVars->value)); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top))); EnvPrintRouter(theEnv,WERROR,".\n"); ReturnExpression(theEnv,top); return(FALSE); } tmpInsSetVars = tmpInsSetVars->nextArg; } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) SetParsedBindNames(theEnv,oldBindList); else prev->next = oldBindList; return(TRUE); } /*********************************************************************************** NAME : ReplaceInstanceVariables DESCRIPTION : Replaces all references to instance-variables within an instance query-function with function calls to query-instance (which references the instance array at run-time) INPUTS : 1) The instance-variable list 2) A boolean expression containing variable references 3) A flag indicating whether to allow slot references of the type : for direct slot access or not 4) Nesting depth of query functions RETURNS : Nothing useful SIDE EFFECTS : If a SF_VARIABLE node is found and is on the list of instance variables, it is replaced with a query-instance function call. NOTES : Other SF_VARIABLE(S) are left alone for replacement by other parsers. This implies that a user may use defgeneric, defrule, and defmessage-handler variables within a query-function where they do not conflict with instance-variable names. ***********************************************************************************/ static void ReplaceInstanceVariables( void *theEnv, EXPRESSION *vlist, EXPRESSION *bexp, int sdirect, int ndepth) { EXPRESSION *eptr; struct FunctionDefinition *rindx_func,*rslot_func; int posn; rindx_func = FindFunction(theEnv,"(query-instance)"); rslot_func = FindFunction(theEnv,"(query-instance-slot)"); while (bexp != NULL) { if (bexp->type == SF_VARIABLE) { eptr = vlist; posn = 0; while ((eptr != NULL) ? (eptr->value != bexp->value) : FALSE) { eptr = eptr->nextArg; posn++; } if (eptr != NULL) { bexp->type = FCALL; bexp->value = (void *) rindx_func; eptr = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) ndepth)); eptr->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) posn)); bexp->argList = eptr; } else if (sdirect == TRUE) ReplaceSlotReference(theEnv,vlist,bexp,rslot_func,ndepth); } if (bexp->argList != NULL) { if (IsQueryFunction(bexp)) ReplaceInstanceVariables(theEnv,vlist,bexp->argList,sdirect,ndepth+1); else ReplaceInstanceVariables(theEnv,vlist,bexp->argList,sdirect,ndepth); } bexp = bexp->nextArg; } } /************************************************************************* NAME : ReplaceSlotReference DESCRIPTION : Replaces instance-set query function variable references of the form: : with function calls to get these instance-slots at run time INPUTS : 1) The instance-set variable list 2) The expression containing the variable 3) The address of the instance slot access function 4) Nesting depth of query functions RETURNS : Nothing useful SIDE EFFECTS : If the variable is a slot reference, then it is replaced with the appropriate function-call. NOTES : None *************************************************************************/ static void ReplaceSlotReference( void *theEnv, EXPRESSION *vlist, EXPRESSION *theExp, struct FunctionDefinition *func, int ndepth) { unsigned len; int posn,oldpp; register unsigned i; register char *str; EXPRESSION *eptr; struct token itkn; str = ValueToString(theExp->value); len = strlen(str); if (len < 3) return; for (i = len-2 ; i >= 1 ; i--) { if ((str[i] == INSTANCE_SLOT_REF) ? (i >= 1) : FALSE) { eptr = vlist; posn = 0; while (eptr && ((i != strlen(ValueToString(eptr->value))) || strncmp(ValueToString(eptr->value),str, (STD_SIZE) i))) { eptr = eptr->nextArg; posn++; } if (eptr != NULL) { OpenStringSource(theEnv,"query-var",str+i+1,0); oldpp = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,OFF); GetToken(theEnv,"query-var",&itkn); SetPPBufferStatus(theEnv,oldpp); CloseStringSource(theEnv,"query-var"); theExp->type = FCALL; theExp->value = (void *) func; theExp->argList = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) ndepth)); theExp->argList->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) posn)); theExp->argList->nextArg->nextArg = GenConstant(theEnv,itkn.type,itkn.value); break; } } } } /******************************************************************** NAME : IsQueryFunction DESCRIPTION : Determines if an expression is a query function call INPUTS : The expression RETURNS : TRUE if query function call, FALSE otherwise SIDE EFFECTS : None NOTES : None ********************************************************************/ static int IsQueryFunction( EXPRESSION *theExp) { int (*fptr)(void); if (theExp->type != FCALL) return(FALSE); fptr = (int (*)(void)) ExpressionFunctionPointer(theExp); if (fptr == (int (*)(void)) AnyInstances) return(TRUE); if (fptr == (int (*)(void)) QueryFindInstance) return(TRUE); if (fptr == (int (*)(void)) QueryFindAllInstances) return(TRUE); if (fptr == (int (*)(void)) QueryDoForInstance) return(TRUE); if (fptr == (int (*)(void)) QueryDoForAllInstances) return(TRUE); if (fptr == (int (*)(void)) DelayedQueryDoForAllInstances) return(TRUE); return(FALSE); } #endif /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips-6.24/clipssrc/analysis.c0000755000175000017500000011753410441127627014540 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* ANALYSIS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Analyzes LHS patterns to check for semantic */ /* errors and to determine variable comparisons and other */ /* tests which must be performed either in the pattern or */ /* join networks. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _ANALYSIS_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "constant.h" #include "symbol.h" #include "memalloc.h" #include "exprnpsr.h" #include "reorder.h" #include "generate.h" #include "pattern.h" #include "router.h" #include "ruledef.h" #include "cstrnchk.h" #include "cstrnutl.h" #include "cstrnops.h" #include "rulecstr.h" #include "modulutl.h" #include "analysis.h" #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #endif /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int GetVariables(void *,struct lhsParseNode *); static intBool UnboundVariablesInPattern(void *,struct lhsParseNode *,int); static int PropagateVariableToNodes(void *, struct lhsParseNode *, int, struct symbolHashNode *, struct lhsParseNode *, int,int,int); static struct lhsParseNode *CheckExpression(void *, struct lhsParseNode *, struct lhsParseNode *, int, struct symbolHashNode *, int); static void VariableReferenceErrorMessage(void *, struct symbolHashNode *, struct lhsParseNode *, int, struct symbolHashNode *, int); static int ProcessField(void *theEnv, struct lhsParseNode *, struct lhsParseNode *, struct lhsParseNode *); static int ProcessVariable(void *, struct lhsParseNode *, struct lhsParseNode *, struct lhsParseNode *); static void VariableMixingErrorMessage(void *,struct symbolHashNode *); static int PropagateVariableDriver(void *, struct lhsParseNode *, struct lhsParseNode *, struct lhsParseNode *, int,struct symbolHashNode *, struct lhsParseNode *, int); /******************************************************************/ /* VariableAnalysis: Propagates variables references to other */ /* variables in the LHS and determines if there are any illegal */ /* variable references (e.g. referring to an unbound variable). */ /* The propagation of variable references simply means all */ /* subsequent references of a variable are made to "point" back */ /* to the variable being propagated. */ /******************************************************************/ globle int VariableAnalysis( void *theEnv, struct lhsParseNode *patternPtr) { struct lhsParseNode *rv, *theList, *tempList; int errorFlag = FALSE; /*======================================================*/ /* Loop through all of the CEs in the rule to determine */ /* which variables refer to other variables and whether */ /* any semantic errors exist when refering to variables */ /* (such as referring to a variable that was not */ /* previously bound). */ /*======================================================*/ while (patternPtr != NULL) { /*=========================================================*/ /* If a pattern CE is encountered, propagate any variables */ /* found in the pattern and note any illegal references to */ /* other variables. */ /*=========================================================*/ if (patternPtr->type == PATTERN_CE) { /*====================================================*/ /* Determine if the fact address associated with this */ /* pattern illegally refers to other variables. */ /*====================================================*/ if ((patternPtr->value != NULL) && (patternPtr->referringNode != NULL)) { errorFlag = TRUE; if (patternPtr->referringNode->index == -1) { PrintErrorID(theEnv,"ANALYSIS",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Duplicate pattern-address ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(patternPtr->value)); EnvPrintRouter(theEnv,WERROR," found in CE #"); PrintLongInteger(theEnv,WERROR,(long) patternPtr->whichCE); EnvPrintRouter(theEnv,WERROR,".\n"); } else { PrintErrorID(theEnv,"ANALYSIS",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Pattern-address ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(patternPtr->value)); EnvPrintRouter(theEnv,WERROR," used in CE #"); PrintLongInteger(theEnv,WERROR,(long) patternPtr->whichCE); EnvPrintRouter(theEnv,WERROR," was previously bound within a pattern CE.\n"); } } /*====================================================*/ /* Propagate the pattern and field location of bound */ /* variables found in this pattern to other variables */ /* in the same semantic scope as the bound variable. */ /*====================================================*/ if (GetVariables(theEnv,patternPtr)) return(TRUE); } /*==============================================================*/ /* If a test CE is encountered, make sure that all references */ /* to variables have been previously bound. If they are bound */ /* then replace the references to variables with function calls */ /* to retrieve the variables. */ /*==============================================================*/ else if (patternPtr->type == TEST_CE) { /*=====================================================*/ /* Verify that all variables were referenced properly. */ /*=====================================================*/ rv = CheckExpression(theEnv,patternPtr->expression,NULL,(int) patternPtr->whichCE,NULL,0); /*=========================================================*/ /* Determine the type and value constraints implied by the */ /* expression and propagate these constraints to other */ /* variables in the LHS. For example, the expression */ /* (+ ?x 1) implies that ?x is a number. */ /*=========================================================*/ theList = GetExpressionVarConstraints(theEnv,patternPtr->expression); for (tempList = theList; tempList != NULL; tempList = tempList->right) { if (PropagateVariableDriver(theEnv,patternPtr,patternPtr,NULL,SF_VARIABLE, (SYMBOL_HN *) tempList->value,tempList,FALSE)) { ReturnLHSParseNodes(theEnv,theList); return(TRUE); } } ReturnLHSParseNodes(theEnv,theList); /*========================================================*/ /* If the variables in the expression were all referenced */ /* properly, then create the expression to use in the */ /* join network. */ /*========================================================*/ if (rv != NULL) { errorFlag = TRUE; } else { patternPtr->networkTest = GetvarReplace(theEnv,patternPtr->expression); } } /*=====================================================*/ /* Move on to the next pattern in the LHS of the rule. */ /*=====================================================*/ patternPtr = patternPtr->bottom; } /*==========================================*/ /* Return the error status of the analysis. */ /*==========================================*/ return(errorFlag); } /****************************************************************/ /* GetVariables: Loops through each field/slot within a pattern */ /* and propagates the pattern and field location of bound */ /* variables found in the pattern to other variables within */ /* the same semantic scope as the bound variables. */ /****************************************************************/ static int GetVariables( void *theEnv, struct lhsParseNode *thePattern) { struct lhsParseNode *patternHead = thePattern; struct lhsParseNode *multifieldHeader = NULL; /*======================================================*/ /* Loop through all the fields/slots found in a pattern */ /* looking for binding instances of variables. */ /*======================================================*/ while (thePattern != NULL) { /*================================================*/ /* A multifield slot contains a sublist of fields */ /* that must be traversed and checked. */ /*================================================*/ if (thePattern->multifieldSlot) { multifieldHeader = thePattern; thePattern = thePattern->bottom; } /*==================================================*/ /* Propagate the binding occurences of single field */ /* variables, multifield variables, and fact */ /* addresses to other occurences of the variable. */ /* If an error is encountered, return TRUE. */ /*==================================================*/ if (thePattern != NULL) { if ((thePattern->type == SF_VARIABLE) || (thePattern->type == MF_VARIABLE) || ((thePattern->type == PATTERN_CE) && (thePattern->value != NULL))) { if (ProcessVariable(theEnv,thePattern,multifieldHeader,patternHead)) { return(TRUE); } } else { if (ProcessField(theEnv,thePattern,multifieldHeader,patternHead)) { return(TRUE); } } } /*===============================================*/ /* Move on to the next field/slot in the pattern */ /* or to the next field in a multifield slot. */ /*===============================================*/ if (thePattern == NULL) { thePattern = multifieldHeader; } else if ((thePattern->right == NULL) && (multifieldHeader != NULL)) { thePattern = multifieldHeader; multifieldHeader = NULL; } thePattern = thePattern->right; } /*===============================*/ /* Return FALSE to indicate that */ /* no errors were detected. */ /*===============================*/ return(FALSE); } /******************************************************/ /* ProcessVariable: Processes a single occurence of a */ /* variable by propagating references to it. */ /******************************************************/ static int ProcessVariable( void *theEnv, struct lhsParseNode *thePattern, struct lhsParseNode *multifieldHeader, struct lhsParseNode *patternHead) { int theType; struct symbolHashNode *theVariable; struct constraintRecord *theConstraints; /*=============================================================*/ /* If a pattern address is being propagated, then treat it as */ /* a single field pattern variable and create a constraint */ /* which indicates that is must be a fact or instance address. */ /* This code will have to be modified for new data types which */ /* can match patterns. */ /*=============================================================*/ if (thePattern->type == PATTERN_CE) { theType = SF_VARIABLE; theVariable = (struct symbolHashNode *) thePattern->value; if (thePattern->derivedConstraints) RemoveConstraint(theEnv,thePattern->constraints); theConstraints = GetConstraintRecord(theEnv); thePattern->constraints = theConstraints; thePattern->constraints->anyAllowed = FALSE; thePattern->constraints->instanceAddressesAllowed = TRUE; thePattern->constraints->factAddressesAllowed = TRUE; thePattern->derivedConstraints = TRUE; } /*===================================================*/ /* Otherwise a pattern variable is being propagated. */ /*===================================================*/ else { theType = thePattern->type; theVariable = (struct symbolHashNode *) thePattern->value; } /*===================================================*/ /* Propagate the variable location to any additional */ /* fields associated with the binding variable. */ /*===================================================*/ if (thePattern->type != PATTERN_CE) { PropagateVariableToNodes(theEnv,thePattern->bottom,theType,theVariable, thePattern,patternHead->beginNandDepth, TRUE,FALSE); if (ProcessField(theEnv,thePattern,multifieldHeader,patternHead)) { return(TRUE); } } /*=================================================================*/ /* Propagate the constraints to other fields, slots, and patterns. */ /*=================================================================*/ return(PropagateVariableDriver(theEnv,patternHead,thePattern,multifieldHeader,theType, theVariable,thePattern,TRUE)); } /*******************************************/ /* PropagateVariableDriver: Driver routine */ /* for propagating variable references. */ /*******************************************/ static int PropagateVariableDriver( void *theEnv, struct lhsParseNode *patternHead, struct lhsParseNode *theNode, struct lhsParseNode *multifieldHeader, int theType, struct symbolHashNode *variableName, struct lhsParseNode *theReference, int assignReference) { /*===================================================*/ /* Propagate the variable location to any additional */ /* constraints associated with the binding variable. */ /*===================================================*/ if (multifieldHeader != NULL) { if (PropagateVariableToNodes(theEnv,multifieldHeader->right,theType,variableName, theReference,patternHead->beginNandDepth,assignReference,FALSE)) { VariableMixingErrorMessage(theEnv,variableName); return(TRUE); } } /*========================================================*/ /* Propagate the variable location to fields/slots in the */ /* same pattern which appear after the binding variable. */ /*========================================================*/ if (PropagateVariableToNodes(theEnv,theNode->right,theType,variableName,theReference, patternHead->beginNandDepth,assignReference,FALSE)) { VariableMixingErrorMessage(theEnv,variableName); return(TRUE); } /*======================================================*/ /* Propagate values to other patterns if the pattern in */ /* which the variable is found is not a "not" CE or the */ /* last pattern within a nand CE. */ /*======================================================*/ if (((patternHead->type == PATTERN_CE) || (patternHead->type == TEST_CE)) && (patternHead->negated == FALSE) && (patternHead->beginNandDepth <= patternHead->endNandDepth)) { int ignoreVariableMixing; /*============================================================*/ /* If the variables are propagated from a test CE, then don't */ /* check for mixing of single and multifield variables (since */ /* previously bound multifield variables typically have the $ */ /* removed when passed as an argument to a function unless */ /* sequence expansion is desired). */ /*============================================================*/ if (patternHead->type == TEST_CE) ignoreVariableMixing = TRUE; else ignoreVariableMixing = FALSE; /*==========================*/ /* Propagate the reference. */ /*==========================*/ if (PropagateVariableToNodes(theEnv,patternHead->bottom,theType,variableName,theReference, patternHead->beginNandDepth,assignReference, ignoreVariableMixing)) { VariableMixingErrorMessage(theEnv,variableName); return(TRUE); } } /*==============================================*/ /* Return FALSE to indicate that no errors were */ /* generated by the variable propagation. */ /*==============================================*/ return(FALSE); } /********************************************************/ /* ProcessField: Processes a field or slot of a pattern */ /* which does not contain a binding variable. */ /********************************************************/ static int ProcessField( void *theEnv, struct lhsParseNode *thePattern, struct lhsParseNode *multifieldHeader, struct lhsParseNode *patternHead) { struct lhsParseNode *theList, *tempList; /*====================================================*/ /* Nothing needs to be done for the node representing */ /* the entire pattern. Return FALSE to indicate that */ /* no errors were generated. */ /*====================================================*/ if (thePattern->type == PATTERN_CE) return(FALSE); /*====================================================================*/ /* Derive a set of constraints based on values found in the slot or */ /* field. For example, if a slot can only contain the values 1, 2, or */ /* 3, the field constraint ~2 would generate a constraint record that */ /* only allows the value 1 or 3. Once generated, the constraints are */ /* propagated to other slots and fields. */ /*====================================================================*/ theList = DeriveVariableConstraints(theEnv,thePattern); for (tempList = theList; tempList != NULL; tempList = tempList->right) { if (PropagateVariableDriver(theEnv,patternHead,thePattern,multifieldHeader,tempList->type, (SYMBOL_HN *) tempList->value,tempList,FALSE)) { ReturnLHSParseNodes(theEnv,theList); return(TRUE); } } ReturnLHSParseNodes(theEnv,theList); /*===========================================================*/ /* Check for "variable referenced, but not previously bound" */ /* errors. Return TRUE if this type of error is detected. */ /*===========================================================*/ if (UnboundVariablesInPattern(theEnv,thePattern,(int) patternHead->whichCE)) { return(TRUE); } /*==================================================*/ /* Check for constraint errors for this slot/field. */ /* If the slot/field has unmatchable constraints */ /* then return TRUE to indicate a semantic error. */ /*==================================================*/ if (ProcessConnectedConstraints(theEnv,thePattern,multifieldHeader,patternHead)) { return(TRUE); } /*==============================================================*/ /* Convert the slot/field constraint to a series of expressions */ /* that will be used in the pattern and join networks. */ /*==============================================================*/ FieldConversion(theEnv,thePattern,patternHead); /*=========================================================*/ /* Return FALSE to indicate that no errors were generated. */ /*=========================================================*/ return(FALSE); } /*************************************************************/ /* PropagateVariableToNodes: Propagates variable references */ /* to all other variables within the semantic scope of the */ /* bound variable. That is, a variable reference cannot be */ /* beyond an enclosing not/and CE combination. The */ /* restriction of propagating variables beyond an enclosing */ /* not CE is handled within the GetVariables function. */ /*************************************************************/ static int PropagateVariableToNodes( void *theEnv, struct lhsParseNode *theNode, int theType, struct symbolHashNode *variableName, struct lhsParseNode *theReference, int startDepth, int assignReference, int ignoreVariableTypes) { struct constraintRecord *tempConstraints; /*===========================================*/ /* Traverse the nodes using the bottom link. */ /*===========================================*/ while (theNode != NULL) { /*==================================================*/ /* If the field/slot contains a predicate or return */ /* value constraint, then propagate the variable to */ /* the expression associated with that constraint. */ /*==================================================*/ if (theNode->expression != NULL) { PropagateVariableToNodes(theEnv,theNode->expression,theType,variableName, theReference,startDepth,assignReference,TRUE); } /*======================================================*/ /* If the field/slot is a single or multifield variable */ /* with the same name as the propagated variable, */ /* then propagate the variable location to this node. */ /*======================================================*/ else if (((theNode->type == SF_VARIABLE) || (theNode->type == MF_VARIABLE)) && (theNode->value == (void *) variableName)) { /*======================================================*/ /* Check for mixing of single and multifield variables. */ /*======================================================*/ if (ignoreVariableTypes == FALSE) { if (((theType == SF_VARIABLE) && (theNode->type == MF_VARIABLE)) || ((theType == MF_VARIABLE) && (theNode->type == SF_VARIABLE))) { return(TRUE); } } /*======================================================*/ /* Intersect the propagated variable's constraints with */ /* the current constraints for this field/slot. */ /*======================================================*/ if ((theReference->constraints != NULL) && (! theNode->negated)) { tempConstraints = theNode->constraints; theNode->constraints = IntersectConstraints(theEnv,theReference->constraints, tempConstraints); if (theNode->derivedConstraints) { RemoveConstraint(theEnv,tempConstraints); } theNode->derivedConstraints = TRUE; } /*=====================================================*/ /* Don't propagate the variable if it originates from */ /* a different type of pattern object and the variable */ /* reference has already been resolved. */ /*=====================================================*/ if (assignReference) { if (theNode->referringNode == NULL) { theNode->referringNode = theReference; } else if (theReference->pattern == theNode->pattern) { theNode->referringNode = theReference; } else if (theReference->patternType == theNode->patternType) { theNode->referringNode = theReference; } } } /*========================================================*/ /* If the field/slot is the node representing the entire */ /* pattern, then propagate the variable location to the */ /* fact address associated with the pattern (if it is the */ /* same variable name). */ /*========================================================*/ else if ((theNode->type == PATTERN_CE) && (theNode->value == (void *) variableName) && (assignReference == TRUE)) { if (theType == MF_VARIABLE) return(TRUE); theNode->referringNode = theReference; } /*=====================================================*/ /* Propagate the variable to other fields contained */ /* within the same & field constraint or same pattern. */ /*=====================================================*/ if (theNode->right != NULL) { if (PropagateVariableToNodes(theEnv,theNode->right,theType,variableName, theReference,startDepth,assignReference,ignoreVariableTypes)) { return(TRUE); } } /*============================================================*/ /* Propagate the variable to other patterns within the same */ /* semantic scope (if dealing with the node for an entire */ /* pattern) or to the next | field constraint within a field. */ /*============================================================*/ if ((theNode->type == PATTERN_CE) || (theNode->type == TEST_CE)) { if (theNode->endNandDepth < startDepth) theNode = NULL; else theNode = theNode->bottom; } else { theNode = theNode->bottom; } } /*========================================================*/ /* Return FALSE to indicate that no errors were detected. */ /*========================================================*/ return(FALSE); } /*************************************************************/ /* UnboundVariablesInPattern: Verifies that variables within */ /* a slot/field have been referenced properly (i.e. that */ /* variables have been previously bound if they are not a */ /* binding occurrence). */ /*************************************************************/ static intBool UnboundVariablesInPattern( void *theEnv, struct lhsParseNode *theSlot, int pattern) { struct lhsParseNode *andField; struct lhsParseNode *rv; int result; struct lhsParseNode *orField; struct symbolHashNode *slotName; CONSTRAINT_RECORD *theConstraints; int theField; /*===================================================*/ /* If a multifield slot is being checked, then check */ /* each of the fields grouped with the multifield. */ /*===================================================*/ if (theSlot->multifieldSlot) { theSlot = theSlot->bottom; while (theSlot != NULL) { if (UnboundVariablesInPattern(theEnv,theSlot,pattern)) { return(TRUE); } theSlot = theSlot->right; } return(FALSE); } /*=======================*/ /* Check a single field. */ /*=======================*/ slotName = theSlot->slot; theField = theSlot->index; theConstraints = theSlot->constraints; /*===========================================*/ /* Loop through each of the '|' constraints. */ /*===========================================*/ for (orField = theSlot->bottom; orField != NULL; orField = orField->bottom) { /*===========================================*/ /* Loop through each of the fields connected */ /* by the '&' within the '|' constraint. */ /*===========================================*/ for (andField = orField; andField != NULL; andField = andField->right) { /*=======================================================*/ /* If this is not a binding occurence of a variable and */ /* there is no previous binding occurence of a variable, */ /* then generate an error message for a variable that is */ /* referred to but not bound. */ /*=======================================================*/ if (((andField->type == SF_VARIABLE) || (andField->type == MF_VARIABLE)) && (andField->referringNode == NULL)) { VariableReferenceErrorMessage(theEnv,(SYMBOL_HN *) andField->value,NULL,pattern, slotName,theField); return(TRUE); } /*==============================================*/ /* Check predicate and return value constraints */ /* to insure that all variables used within the */ /* constraint have been previously bound. */ /*==============================================*/ else if ((andField->type == PREDICATE_CONSTRAINT) || (andField->type == RETURN_VALUE_CONSTRAINT)) { rv = CheckExpression(theEnv,andField->expression,NULL,pattern,slotName,theField); if (rv != NULL) return(TRUE); } /*========================================================*/ /* If static constraint checking is being performed, then */ /* determine if constant values have violated the set of */ /* derived constraints for the slot/field (based on the */ /* deftemplate definition and propagated constraints). */ /*========================================================*/ else if (((andField->type == INTEGER) || (andField->type == FLOAT) || (andField->type == SYMBOL) || (andField->type == STRING) || (andField->type == INSTANCE_NAME)) && EnvGetStaticConstraintChecking(theEnv)) { result = ConstraintCheckValue(theEnv,andField->type,andField->value,theConstraints); if (result != NO_VIOLATION) { ConstraintViolationErrorMessage(theEnv,"A literal restriction value", NULL,FALSE,pattern, slotName,theField,result, theConstraints,TRUE); return(TRUE); } } } } /*===============================*/ /* Return FALSE to indicate that */ /* no errors were detected. */ /*===============================*/ return(FALSE); } /******************************************************************/ /* CheckExpression: Verifies that variables within an expression */ /* have been referenced properly. All variables within an */ /* expression must have been previously bound. */ /******************************************************************/ static struct lhsParseNode *CheckExpression( void *theEnv, struct lhsParseNode *exprPtr, struct lhsParseNode *lastOne, int whichCE, struct symbolHashNode *slotName, int theField) { struct lhsParseNode *rv; int i = 1; while (exprPtr != NULL) { /*===============================================================*/ /* Check that single field variables contained in the expression */ /* were previously defined in the LHS. Also check to see if the */ /* variable has unmatchable constraints. */ /*===============================================================*/ if (exprPtr->type == SF_VARIABLE) { if (exprPtr->referringNode == NULL) { VariableReferenceErrorMessage(theEnv,(SYMBOL_HN *) exprPtr->value,lastOne, whichCE,slotName,theField); return(exprPtr); } else if ((UnmatchableConstraint(exprPtr->constraints)) && EnvGetStaticConstraintChecking(theEnv)) { ConstraintReferenceErrorMessage(theEnv,(SYMBOL_HN *) exprPtr->value,lastOne,i, whichCE,slotName,theField); return(exprPtr); } } /*==================================================*/ /* Check that multifield variables contained in the */ /* expression were previously defined in the LHS. */ /*==================================================*/ else if ((exprPtr->type == MF_VARIABLE) && (exprPtr->referringNode == NULL)) { VariableReferenceErrorMessage(theEnv,(SYMBOL_HN *) exprPtr->value,lastOne, whichCE,slotName,theField); return(exprPtr); } /*=====================================================*/ /* Check that global variables are referenced properly */ /* (i.e. if you reference a global variable, it must */ /* already be defined by a defglobal construct). */ /*=====================================================*/ #if DEFGLOBAL_CONSTRUCT else if (exprPtr->type == GBL_VARIABLE) { int count; if (FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(exprPtr->value), &count,TRUE,NULL) == NULL) { VariableReferenceErrorMessage(theEnv,(SYMBOL_HN *) exprPtr->value,lastOne, whichCE,slotName,theField); return(exprPtr); } } #endif /*============================================*/ /* Recursively check other function calls to */ /* insure variables are referenced correctly. */ /*============================================*/ else if (((exprPtr->type == FCALL) #if DEFGENERIC_CONSTRUCT || (exprPtr->type == GCALL) #endif #if DEFFUNCTION_CONSTRUCT || (exprPtr->type == PCALL) #endif ) && (exprPtr->bottom != NULL)) { if ((rv = CheckExpression(theEnv,exprPtr->bottom,exprPtr,whichCE,slotName,theField)) != NULL) { return(rv); } } /*=============================================*/ /* Move on to the next part of the expression. */ /*=============================================*/ i++; exprPtr = exprPtr->right; } /*================================================*/ /* Return NULL to indicate no error was detected. */ /*================================================*/ return(NULL); } /********************************************************/ /* VariableReferenceErrorMessage: Generic error message */ /* for referencing a variable before it is defined. */ /********************************************************/ static void VariableReferenceErrorMessage( void *theEnv, struct symbolHashNode *theVariable, struct lhsParseNode *theExpression, int whichCE, struct symbolHashNode *slotName, int theField) { struct expr *temprv; /*=============================*/ /* Print the error message ID. */ /*=============================*/ PrintErrorID(theEnv,"ANALYSIS",4,TRUE); /*=================================*/ /* Print the name of the variable. */ /*=================================*/ EnvPrintRouter(theEnv,WERROR,"Variable ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(theVariable)); EnvPrintRouter(theEnv,WERROR," "); /*=================================================*/ /* If the variable was found inside an expression, */ /* then print the expression. */ /*=================================================*/ if (theExpression != NULL) { temprv = LHSParseNodesToExpression(theEnv,theExpression); ReturnExpression(theEnv,temprv->nextArg); temprv->nextArg = NULL; EnvPrintRouter(theEnv,WERROR,"found in the expression "); PrintExpression(theEnv,WERROR,temprv); EnvPrintRouter(theEnv,WERROR,"\n"); ReturnExpression(theEnv,temprv); } /*====================================================*/ /* Print the CE in which the variable was referenced. */ /*====================================================*/ EnvPrintRouter(theEnv,WERROR,"was referenced in CE #"); PrintLongInteger(theEnv,WERROR,(long int) whichCE); /*=====================================*/ /* Identify the slot or field in which */ /* the variable was found. */ /*=====================================*/ if (slotName == NULL) { if (theField > 0) { EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long int) theField); } } else { EnvPrintRouter(theEnv,WERROR," slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(slotName)); } EnvPrintRouter(theEnv,WERROR," before being defined.\n"); } /************************************************************/ /* VariableMixingErrorMessage: Prints the error message for */ /* the illegal mixing of single and multifield variables */ /* on the LHS of a rule. */ /************************************************************/ static void VariableMixingErrorMessage( void *theEnv, struct symbolHashNode *theVariable) { PrintErrorID(theEnv,"ANALYSIS",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Variable ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(theVariable)); EnvPrintRouter(theEnv,WERROR," is used as both a single and multifield variable in the LHS\n"); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/sysdep.c0000755000175000017500000013516310441602335014214 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* SYSTEM DEPENDENT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Isolation of system dependent routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Modified GenOpen to check the file length */ /* against the system constant FILENAME_MAX. */ /* */ /* 6.24: Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* Made gensystem functional for Xcode. */ /* */ /* Added BeforeOpenFunction and AfterOpenFunction */ /* hooks. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Updated UNIX_V gentime functionality. */ /* */ /*************************************************************/ #define _SYSDEP_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #if VAX_VMS #include timeb #include #include #include #include signal extern int LIB$SPAWN(); #endif #if MAC #if MAC_MCW || MAC_XCD #include #endif #define kTwoPower32 (4294967296.0) /* 2^32 */ #if MAC_MCW || MAC_XCD #include #endif #endif #if MAC_MCW || IBM_MCW || MAC_XCD #include #endif #if IBM_ICB #include #include #include #include #include #include #include #include #endif #if IBM_MSC #include #include #include #include #include #include #endif #if IBM_TBC #include #include #include #include #endif #if IBM_MCW #include #include #endif #if IBM_ZTC || IBM_SC #include #include #include #include #include #include #endif #if UNIX_7 || IBM_GCC #include #include #include #endif #if UNIX_V #include #include #include #include #include #endif #include "argacces.h" #include "bmathfun.h" #include "commline.h" #include "conscomp.h" #include "constrnt.h" #include "constrct.h" #include "cstrcpsr.h" #include "emathfun.h" #include "envrnmnt.h" #include "filecom.h" #include "iofun.h" #include "memalloc.h" #include "miscfun.h" #include "multifld.h" #include "multifun.h" #include "parsefun.h" #include "prccode.h" #include "prdctfun.h" #include "proflfun.h" #include "prcdrfun.h" #include "router.h" #include "sortfun.h" #include "strngfun.h" #include "textpro.h" #include "utility.h" #include "watch.h" #include "sysdep.h" #if DEFFACTS_CONSTRUCT #include "dffctdef.h" #endif #if DEFRULE_CONSTRUCT #include "ruledef.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if DEFGLOBAL_CONSTRUCT #include "globldef.h" #endif #if DEFTEMPLATE_CONSTRUCT #include "tmpltdef.h" #endif #if OBJECT_SYSTEM #include "classini.h" #endif #include "moduldef.h" #if EMACS_EDITOR #include "ed.h" #endif #if DEVELOPER #include "developr.h" #endif /***************/ /* DEFINITIONS */ /***************/ #define NO_SWITCH 0 #define BATCH_SWITCH 1 #define BATCH_STAR_SWITCH 2 #define LOAD_SWITCH 3 /********************/ /* ENVIRONMENT DATA */ /********************/ #define SYSTEM_DEPENDENT_DATA 58 struct systemDependentData { void (*RedrawScreenFunction)(void *); void (*PauseEnvFunction)(void *); void (*ContinueEnvFunction)(void *,int); #if ! WINDOW_INTERFACE #if IBM_TBC void interrupt (*OldCtrlC)(void); void interrupt (*OldBreak)(void); #endif #if IBM_MSC void (interrupt *OldCtrlC)(void); void (interrupt *OldBreak)(void); #endif #if IBM_ICB #pragma interrupt (OldCtrlC,OldBreak) void (*OldCtrlC)(void); void (*OldBreak)(void); #endif #endif #if IBM_TBC || IBM_MSC || IBM_ICB /* || IBM_MCW || IBM_ZTC */ int BinaryFileHandle; #endif #if (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) /* && (! IBM_MCW) && (! IBM_ZTC) */ FILE *BinaryFP; #endif int (*BeforeOpenFunction)(void *); int (*AfterOpenFunction)(void *); }; #define SystemDependentData(theEnv) ((struct systemDependentData *) GetEnvironmentData(theEnv,SYSTEM_DEPENDENT_DATA)) /****************************************/ /* GLOBAL EXTERNAL FUNCTION DEFINITIONS */ /****************************************/ extern void UserFunctions(void); extern void EnvUserFunctions(void *); /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void InitializeSystemDependentData(void *); static void SystemFunctionDefinitions(void *); static void InitializeKeywords(void *); static void InitializeNonportableFeatures(void *); #if (VAX_VMS || UNIX_V || UNIX_7 || IBM_GCC) && (! WINDOW_INTERFACE) static void CatchCtrlC(int); #endif #if (IBM_TBC || IBM_MSC) && (! WINDOW_INTERFACE) static void interrupt CatchCtrlC(void); static void RestoreInterruptVectors(void); #endif #if IBM_ICB && (! WINDOW_INTERFACE) #pragma interrupt (CatchCtrlC) static void CatchCtrlC(void); static void RestoreInterruptVectors(void); #endif #if (IBM_ZTC || IBM_SC) && (! WINDOW_INTERFACE) static void _cdecl CatchCtrlC(void); #endif #if MAC && (! WINDOW_INTERFACE) static void CallSystemTask(void); #endif /********************************************************/ /* InitializeSystemDependentData: Allocates environment */ /* data for system dependent routines. */ /********************************************************/ static void InitializeSystemDependentData( void *theEnv) { AllocateEnvironmentData(theEnv,SYSTEM_DEPENDENT_DATA,sizeof(struct systemDependentData),NULL); } /**************************************************/ /* InitializeEnvironment: Performs initialization */ /* of the KB environment. */ /**************************************************/ #if (! ENVIRONMENT_API_ONLY) && ALLOW_ENVIRONMENT_GLOBALS globle void InitializeEnvironment() { if (GetCurrentEnvironment() == NULL) { CreateEnvironment(); } } #endif /*****************************************************/ /* EnvInitializeEnvironment: Performs initialization */ /* of the KB environment. */ /*****************************************************/ globle void EnvInitializeEnvironment( void *vtheEnvironment, struct symbolHashNode **symbolTable, struct floatHashNode **floatTable, struct integerHashNode **integerTable, struct bitMapHashNode **bitmapTable) { struct environmentData *theEnvironment = (struct environmentData *) vtheEnvironment; /*================================================*/ /* Don't allow the initialization to occur twice. */ /*================================================*/ if (theEnvironment->initialized) return; /*================================*/ /* Initialize the memory manager. */ /*================================*/ InitializeMemory(theEnvironment); /*===================================================*/ /* Initialize environment data for various features. */ /*===================================================*/ InitializeCommandLineData(theEnvironment); #if CONSTRUCT_COMPILER && (! RUN_TIME) InitializeConstructCompilerData(theEnvironment); #endif InitializeConstructData(theEnvironment); InitializeEvaluationData(theEnvironment); InitializeExternalFunctionData(theEnvironment); InitializeMultifieldData(theEnvironment); InitializePrettyPrintData(theEnvironment); InitializePrintUtilityData(theEnvironment); InitializeScannerData(theEnvironment); InitializeSystemDependentData(theEnvironment); InitializeUserDataData(theEnvironment); InitializeUtilityData(theEnvironment); #if DEBUGGING_FUNCTIONS InitializeWatchData(theEnvironment); #endif /*===============================================*/ /* Initialize the hash tables for atomic values. */ /*===============================================*/ InitializeAtomTables(theEnvironment,symbolTable,floatTable,integerTable,bitmapTable); /*=========================================*/ /* Initialize file and string I/O routers. */ /*=========================================*/ InitializeDefaultRouters(theEnvironment); /*=========================================================*/ /* Initialize some system dependent features such as time. */ /*=========================================================*/ InitializeNonportableFeatures(theEnvironment); /*=============================================*/ /* Register system and user defined functions. */ /*=============================================*/ SystemFunctionDefinitions(theEnvironment); UserFunctions(); EnvUserFunctions(theEnvironment); /*====================================*/ /* Initialize the constraint manager. */ /*====================================*/ InitializeConstraints(theEnvironment); /*==========================================*/ /* Initialize the expression hash table and */ /* pointers to specific functions. */ /*==========================================*/ InitExpressionData(theEnvironment); /*===================================*/ /* Initialize the construct manager. */ /*===================================*/ #if ! RUN_TIME InitializeConstructs(theEnvironment); #endif /*=====================================*/ /* Initialize the defmodule construct. */ /*=====================================*/ AllocateDefmoduleGlobals(theEnvironment); /*===================================*/ /* Initialize the defrule construct. */ /*===================================*/ #if DEFRULE_CONSTRUCT InitializeDefrules(theEnvironment); #endif /*====================================*/ /* Initialize the deffacts construct. */ /*====================================*/ #if DEFFACTS_CONSTRUCT InitializeDeffacts(theEnvironment); #endif /*=====================================================*/ /* Initialize the defgeneric and defmethod constructs. */ /*=====================================================*/ #if DEFGENERIC_CONSTRUCT SetupGenericFunctions(theEnvironment); #endif /*=======================================*/ /* Initialize the deffunction construct. */ /*=======================================*/ #if DEFFUNCTION_CONSTRUCT SetupDeffunctions(theEnvironment); #endif /*=====================================*/ /* Initialize the defglobal construct. */ /*=====================================*/ #if DEFGLOBAL_CONSTRUCT InitializeDefglobals(theEnvironment); #endif /*=======================================*/ /* Initialize the deftemplate construct. */ /*=======================================*/ #if DEFTEMPLATE_CONSTRUCT InitializeDeftemplates(theEnvironment); #endif /*=============================*/ /* Initialize COOL constructs. */ /*=============================*/ #if OBJECT_SYSTEM SetupObjectSystem(theEnvironment); #endif /*=====================================*/ /* Initialize the defmodule construct. */ /*=====================================*/ InitializeDefmodules(theEnvironment); /*======================================================*/ /* Register commands and functions for development use. */ /*======================================================*/ #if DEVELOPER DeveloperCommands(theEnvironment); #endif /*=========================================*/ /* Install the special function primitives */ /* used by procedural code in constructs. */ /*=========================================*/ InstallProcedurePrimitives(theEnvironment); /*==============================================*/ /* Install keywords in the symbol table so that */ /* they are available for command completion. */ /*==============================================*/ InitializeKeywords(theEnvironment); /*========================*/ /* Issue a clear command. */ /*========================*/ EnvClear(theEnvironment); /*=============================*/ /* Initialization is complete. */ /*=============================*/ theEnvironment->initialized = TRUE; } /******************************************************/ /* SetRedrawFunction: Sets the redraw screen function */ /* for use with a user interface that may be */ /* overwritten by execution of a command. */ /******************************************************/ globle void SetRedrawFunction( void *theEnv, void (*theFunction)(void *)) { SystemDependentData(theEnv)->RedrawScreenFunction = theFunction; } /******************************************************/ /* SetPauseEnvFunction: Set the normal state function */ /* which puts terminal in a normal state. */ /******************************************************/ globle void SetPauseEnvFunction( void *theEnv, void (*theFunction)(void *)) { SystemDependentData(theEnv)->PauseEnvFunction = theFunction; } /*********************************************************/ /* SetContinueEnvFunction: Sets the continue environment */ /* function which returns the terminal to a special */ /* screen interface state. */ /*********************************************************/ globle void SetContinueEnvFunction( void *theEnv, void (*theFunction)(void *,int)) { SystemDependentData(theEnv)->ContinueEnvFunction = theFunction; } /*******************************************************/ /* GetRedrawFunction: Gets the redraw screen function. */ /*******************************************************/ globle void (*GetRedrawFunction(void *theEnv))(void *) { return SystemDependentData(theEnv)->RedrawScreenFunction; } /*****************************************************/ /* GetPauseEnvFunction: Gets the normal state function. */ /*****************************************************/ globle void (*GetPauseEnvFunction(void *theEnv))(void *) { return SystemDependentData(theEnv)->PauseEnvFunction; } /*********************************************/ /* GetContinueEnvFunction: Gets the continue */ /* environment function. */ /*********************************************/ globle void (*GetContinueEnvFunction(void *theEnv))(void *,int) { return SystemDependentData(theEnv)->ContinueEnvFunction; } /*************************************************/ /* RerouteStdin: Processes the -f, -f2, and -l */ /* options available on machines which support */ /* argc and arv command line options. */ /*************************************************/ globle void RerouteStdin( void *theEnv, int argc, char *argv[]) { int i; int theSwitch = NO_SWITCH; /*======================================*/ /* If there aren't enough arguments for */ /* the -f argument, then return. */ /*======================================*/ if (argc < 3) { return; } /*=====================================*/ /* If argv was not passed then return. */ /*=====================================*/ if (argv == NULL) return; /*=============================================*/ /* Process each of the command line arguments. */ /*=============================================*/ for (i = 1 ; i < argc ; i++) { if (strcmp(argv[i],"-f") == 0) theSwitch = BATCH_SWITCH; #if ! RUN_TIME else if (strcmp(argv[i],"-f2") == 0) theSwitch = BATCH_STAR_SWITCH; else if (strcmp(argv[i],"-l") == 0) theSwitch = LOAD_SWITCH; #endif else if (theSwitch == NO_SWITCH) { PrintErrorID(theEnv,"SYSDEP",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Invalid option\n"); } if (i > (argc-1)) { PrintErrorID(theEnv,"SYSDEP",1,FALSE); EnvPrintRouter(theEnv,WERROR,"No file found for "); switch(theSwitch) { case BATCH_SWITCH: EnvPrintRouter(theEnv,WERROR,"-f"); break; case BATCH_STAR_SWITCH: EnvPrintRouter(theEnv,WERROR,"-f2"); break; case LOAD_SWITCH: EnvPrintRouter(theEnv,WERROR,"-l"); } EnvPrintRouter(theEnv,WERROR," option\n"); return; } switch(theSwitch) { case BATCH_SWITCH: OpenBatch(theEnv,argv[++i],TRUE); break; #if (! RUN_TIME) && (! BLOAD_ONLY) case BATCH_STAR_SWITCH: EnvBatchStar(theEnv,argv[++i]); break; case LOAD_SWITCH: EnvLoad(theEnv,argv[++i]); break; #endif } } } /**************************************************/ /* SystemFunctionDefinitions: Sets up definitions */ /* of system defined functions. */ /**************************************************/ static void SystemFunctionDefinitions( void *theEnv) { ProceduralFunctionDefinitions(theEnv); MiscFunctionDefinitions(theEnv); #if BASIC_IO || EXT_IO IOFunctionDefinitions(theEnv); #endif PredicateFunctionDefinitions(theEnv); BasicMathFunctionDefinitions(theEnv); FileCommandDefinitions(theEnv); SortFunctionDefinitions(theEnv); #if DEBUGGING_FUNCTIONS WatchFunctionDefinitions(theEnv); #endif #if MULTIFIELD_FUNCTIONS MultifieldFunctionDefinitions(theEnv); #endif #if STRING_FUNCTIONS StringFunctionDefinitions(theEnv); #endif #if EX_MATH ExtendedMathFunctionDefinitions(theEnv); #endif #if TEXTPRO_FUNCTIONS || HELP_FUNCTIONS HelpFunctionDefinitions(theEnv); #endif #if EMACS_EDITOR EditorFunctionDefinition(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) ConstructsToCCommandDefinition(theEnv); #endif #if PROFILING_FUNCTIONS ConstructProfilingFunctionDefinitions(theEnv); #endif ParseFunctionDefinitions(theEnv); } /*********************************************************/ /* gentime: A function to return a floating point number */ /* which indicates the present time. Used internally */ /* for timing rule firings and debugging. */ /*********************************************************/ globle double gentime() { #if MAC UnsignedWide result; Microseconds(&result); return(((((double) result.hi) * kTwoPower32) + result.lo) / 1000000.0); #elif IBM_MCW unsigned long int result; result = GetTickCount(); return((double) result / 1000.0); #elif IBM_TBC && (! WINDOW_INTERFACE) unsigned long int result; result = biostime(0,(long int) 0); return((double) result / 18.2); #elif UNIX_V #if defined(_POSIX_TIMERS) && (_POSIX_TIMERS > 0) struct timespec now; clock_gettime( #if defined(_POSIX_MONOTONIC_CLOCK) CLOCK_MONOTONIC, #else CLOCK_REALTIME, #endif &now); return (now.tv_nsec / 1000000000.0) + now.tv_sec; #else struct timeval now; gettimeofday(&now, 0); return (now.tv_usec / 1000000.0) + now.tv_sec; #endif #else return((double) clock() / (double) CLOCKS_PER_SEC); #endif } /*****************************************************/ /* gensystem: Generic routine for passing a string */ /* representing a command to the operating system. */ /*****************************************************/ globle void gensystem( void *theEnv) { char *commandBuffer = NULL; int bufferPosition = 0; unsigned bufferMaximum = 0; int numa, i; DATA_OBJECT tempValue; char *theString; /*===========================================*/ /* Check for the corret number of arguments. */ /*===========================================*/ if ((numa = EnvArgCountCheck(theEnv,"system",AT_LEAST,1)) == -1) return; /*============================================================*/ /* Concatenate the arguments together to form a single string */ /* containing the command to be sent to the operating system. */ /*============================================================*/ for (i = 1 ; i <= numa; i++) { EnvRtnUnknown(theEnv,i,&tempValue); if ((GetType(tempValue) != STRING) && (GetType(tempValue) != SYMBOL)) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); ExpectedTypeError2(theEnv,"system",i); return; } theString = DOToString(tempValue); commandBuffer = AppendToString(theEnv,theString,commandBuffer,&bufferPosition,&bufferMaximum); } if (commandBuffer == NULL) return; /*=======================================*/ /* Execute the operating system command. */ /*=======================================*/ #if VAX_VMS if (SystemDependentData(theEnv)->PauseEnvFunction != NULL) (*SystemDependentData(theEnv)->PauseEnvFunction)(theEnv); VMSSystem(commandBuffer); putchar('\n'); if (SystemDependentData(theEnv)->ContinueEnvFunction != NULL) (*SystemDependentData(theEnv)->ContinueEnvFunction)(theEnv,1); if (SystemDependentData(theEnv)->RedrawScreenFunction != NULL) (*SystemDependentData(theEnv)->RedrawScreenFunction)(theEnv); #endif #if UNIX_7 || UNIX_V || IBM_MSC || IBM_TBC || IBM_ICB || IBM_ZTC || IBM_SC || IBM_MCW || IBM_GCC || MAC_XCD if (SystemDependentData(theEnv)->PauseEnvFunction != NULL) (*SystemDependentData(theEnv)->PauseEnvFunction)(theEnv); system(commandBuffer); if (SystemDependentData(theEnv)->ContinueEnvFunction != NULL) (*SystemDependentData(theEnv)->ContinueEnvFunction)(theEnv,1); if (SystemDependentData(theEnv)->RedrawScreenFunction != NULL) (*SystemDependentData(theEnv)->RedrawScreenFunction)(theEnv); #else #if ! VAX_VMS EnvPrintRouter(theEnv,WDIALOG, "System function not fully defined for this system.\n"); #endif #endif /*==================================================*/ /* Return the string buffer containing the command. */ /*==================================================*/ rm(theEnv,commandBuffer,bufferMaximum); return; } #if VAX_VMS /*************************************************/ /* VMSSystem: Implements system command for VMS. */ /*************************************************/ globle void VMSSystem( char *cmd) { long status, complcode; struct dsc$descriptor_s cmd_desc; cmd_desc.dsc$w_length = strlen(cmd); cmd_desc.dsc$a_pointer = cmd; cmd_desc.dsc$b_class = DSC$K_CLASS_S; cmd_desc.dsc$b_dtype = DSC$K_DTYPE_T; status = LIB$SPAWN(&cmd_desc,0,0,0,0,0,&complcode,0,0,0); } #endif /***********************************************************/ /* InitializeNonportableFeatures: Initializes non-portable */ /* features. Currently, the only non-portable feature */ /* requiring initialization is the interrupt handler */ /* which allows execution to be halted. */ /***********************************************************/ #if IBM_TBC #pragma argsused #endif static void InitializeNonportableFeatures( void *theEnv) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #if ! WINDOW_INTERFACE #if MAC AddPeriodicFunction("systemtask",CallSystemTask,0); #endif #if VAX_VMS || UNIX_V || UNIX_7 || IBM_GCC signal(SIGINT,CatchCtrlC); #endif #if IBM_TBC SystemDependentData(theEnv)->OldCtrlC = getvect(0x23); SystemDependentData(theEnv)->OldBreak = getvect(0x1b); setvect(0x23,CatchCtrlC); setvect(0x1b,CatchCtrlC); atexit(RestoreInterruptVectors); #endif #if IBM_MSC || IBM_ICB SystemDependentData(theEnv)->OldCtrlC = _dos_getvect(0x23); SystemDependentData(theEnv)->OldBreak = _dos_getvect(0x1b); _dos_setvect(0x23,CatchCtrlC); _dos_setvect(0x1b,CatchCtrlC); atexit(RestoreInterruptVectors); #endif #if IBM_ZTC || IBM_SC _controlc_handler = CatchCtrlC; controlc_open(); #endif #endif } /*************************************************************/ /* Functions For Handling Control C Interrupt: The following */ /* functions handle interrupt processing for several */ /* machines. For the Macintosh control-c is not handle, */ /* but a function is provided to call periodically which */ /* calls SystemTask (allowing periodic tasks to be handled */ /* by the operating system). */ /*************************************************************/ #if ! WINDOW_INTERFACE #if MAC /************************************************************/ /* CallSystemTask: Macintosh specific function which allows */ /* periodic tasks to be handled by the operating system. */ /************************************************************/ static void CallSystemTask() { static unsigned long int lastCall; if (TickCount() < (lastCall + 10)) return; SystemTask(); lastCall = TickCount(); return; } #endif #if VAX_VMS || UNIX_V || UNIX_7 || IBM_GCC /**********************************************/ /* CatchCtrlC: VMS and UNIX specific function */ /* to allow control-c interrupts. */ /**********************************************/ static void CatchCtrlC( int sgnl) { #if ALLOW_ENVIRONMENT_GLOBALS SetHaltExecution(GetCurrentEnvironment(),TRUE); CloseAllBatchSources(GetCurrentEnvironment()); #endif signal(SIGINT,CatchCtrlC); } #endif #if IBM_TBC || IBM_MSC /******************************************************/ /* CatchCtrlC: IBM Microsoft C and Borland Turbo C */ /* specific function to allow control-c interrupts. */ /******************************************************/ static void interrupt CatchCtrlC() { #if ALLOW_ENVIRONMENT_GLOBALS SetHaltExecution(GetCurrentEnvironment(),TRUE); CloseAllBatchSources(GetCurrentEnvironment()); #endif } /**************************************************************/ /* RestoreInterruptVectors: IBM Microsoft C and Borland Turbo */ /* C specific function for restoring interrupt vectors. */ /**************************************************************/ static void RestoreInterruptVectors() { #if ALLOW_ENVIRONMENT_GLOBALS void *theEnv; theEnv = GetCurrentEnvironment(); #if IBM_TBC setvect(0x23,SystemDependentData(theEnv)->OldCtrlC); setvect(0x1b,SystemDependentData(theEnv)->OldBreak); #else _dos_setvect(0x23,SystemDependentData(theEnv)->OldCtrlC); _dos_setvect(0x1b,SystemDependentData(theEnv)->OldBreak); #endif #endif } #endif #if IBM_ZTC || IBM_SC /***********************************************/ /* CatchCtrlC: IBM Zortech C specific function */ /* to allow control-c interrupts. */ /***********************************************/ static void _cdecl CatchCtrlC() { #if ALLOW_ENVIRONMENT_GLOBALS SetHaltExecution(GetCurrentEnvironment(),TRUE); CloseAllBatchSources(GetCurrentEnvironment()); #endif } #endif #if IBM_ICB /*************************************************/ /* CatchCtrlC: IBM Intel C Code Builder specific */ /* function to allow control-c interrupts. */ /*************************************************/ static void CatchCtrlC() { #if ALLOW_ENVIRONMENT_GLOBALS _XSTACK *sf; /* Real-mode interrupt handler stack frame. */ sf = (_XSTACK *) _get_stk_frame(); /* Get pointer to V86 _XSTACK frame. */ SetHaltExecution(GetCurrentEnvironment(),TRUE); /* Terminate execution and */ CloseAllBatchSources(GetCurrentEnvironment()); /* return to the command prompt. */ sf->opts |= _STK_NOINT; /* Set _ST_NOINT to prevent V86 call. */ #endif } /********************************************************/ /* RestoreInterruptVectors: IBM Intel C Code Builder */ /* specific function for restoring interrupt vectors. */ /********************************************************/ static void RestoreInterruptVectors() { #if ALLOW_ENVIRONMENT_GLOBALS void *theEnv; theEnv = GetCurrentEnvironment(); _dos_setvect(0x23,SystemDependentData(theEnv)->OldCtrlC); _dos_setvect(0x1b,SystemDependentData(theEnv)->OldBreak); #endif } #endif #endif /**************************************/ /* GENEXIT: A generic exit function. */ /**************************************/ globle void genexit( int num) { exit(num); } /******************************************************/ /* genrand: Generic random number generator function. */ /******************************************************/ int genrand() { return(rand()); } /**********************************************************************/ /* genseed: Generic function for seeding the random number generator. */ /**********************************************************************/ globle void genseed( int seed) { srand((unsigned) seed); } /*********************************************/ /* gengetcwd: Generic function for returning */ /* the current directory. */ /*********************************************/ #if IBM_TBC #pragma argsused #endif globle char *gengetcwd( char *buffer, int buflength) { #if MAC_MCW || IBM_MCW || MAC_XCD return(getcwd(buffer,buflength)); #endif if (buffer != NULL) { buffer[0] = 0; } return(buffer); } /****************************************************/ /* genremove: Generic function for removing a file. */ /****************************************************/ globle int genremove( char *fileName) { if (remove(fileName)) return(FALSE); return(TRUE); } /****************************************************/ /* genrename: Generic function for renaming a file. */ /****************************************************/ globle int genrename( char *oldFileName, char *newFileName) { if (rename(oldFileName,newFileName)) return(FALSE); return(TRUE); } /**************************************/ /* EnvSetBeforeOpenFunction: Sets the */ /* value of BeforeOpenFunction. */ /**************************************/ globle int (*EnvSetBeforeOpenFunction(void *theEnv, int (*theFunction)(void *)))(void *) { int (*tempFunction)(void *); tempFunction = SystemDependentData(theEnv)->BeforeOpenFunction; SystemDependentData(theEnv)->BeforeOpenFunction = theFunction; return(tempFunction); } /*************************************/ /* EnvSetAfterOpenFunction: Sets the */ /* value of AfterOpenFunction. */ /*************************************/ globle int (*EnvSetAfterOpenFunction(void *theEnv, int (*theFunction)(void *)))(void *) { int (*tempFunction)(void *); tempFunction = SystemDependentData(theEnv)->AfterOpenFunction; SystemDependentData(theEnv)->AfterOpenFunction = theFunction; return(tempFunction); } /*********************************************/ /* GenOpen: Trap routine for opening a file. */ /*********************************************/ globle FILE *GenOpen( void *theEnv, char *fileName, char *accessType) { FILE *theFile; if (strlen(fileName) > FILENAME_MAX) { return(NULL); } if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL) { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); } theFile = fopen(fileName,accessType); if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } return theFile; } /**********************************************/ /* GenClose: Trap routine for closing a file. */ /**********************************************/ globle int GenClose( void *theEnv, FILE *theFile) { int rv; if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL) { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); } rv = fclose(theFile); if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } return rv; } /************************************************************/ /* GenOpenReadBinary: Generic and machine specific code for */ /* opening a file for binary access. Only one file may be */ /* open at a time when using this function since the file */ /* pointer is stored in a global variable. */ /************************************************************/ globle int GenOpenReadBinary( void *theEnv, char *funcName, char *fileName) { if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL) { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); } #if IBM_TBC || IBM_MSC || IBM_ICB SystemDependentData(theEnv)->BinaryFileHandle = open(fileName,O_RDONLY | O_BINARY); if (SystemDependentData(theEnv)->BinaryFileHandle == -1) { if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } OpenErrorMessage(theEnv,funcName,fileName); return(FALSE); } #endif #if (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) if ((SystemDependentData(theEnv)->BinaryFP = fopen(fileName,"rb")) == NULL) { if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } OpenErrorMessage(theEnv,funcName,fileName); return(FALSE); } #endif if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } return(TRUE); } /***********************************************/ /* GenReadBinary: Generic and machine specific */ /* code for reading from a file. */ /***********************************************/ globle void GenReadBinary( void *theEnv, void *dataPtr, unsigned long size) { /* #if MAC long dataSize; dataSize = (long) size; FSRead(SystemDependentData(theEnv)->BinaryRefNum,&dataSize,dataPtr); #endif */ #if IBM_TBC || IBM_MSC || IBM_ICB /* || IBM_MCW */ char *tempPtr; tempPtr = (char *) dataPtr; while (size > INT_MAX) { read(SystemDependentData(theEnv)->BinaryFileHandle,tempPtr,INT_MAX); size -= INT_MAX; tempPtr = tempPtr + INT_MAX; } if (size > 0) { read(SystemDependentData(theEnv)->BinaryFileHandle,tempPtr,(STD_SIZE) size); } #endif #if (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) /* && (! IBM_MCW) && (! IBM_ZTC) */ unsigned int temp, number_of_reads, read_size; if (sizeof(int) == sizeof(long)) { read_size = size; } else { read_size = (1L << (sizeof(int) * 8L)) - 1L ; } number_of_reads = size / read_size; temp = size - ((long) number_of_reads * (long) read_size); while (number_of_reads > 0) { fread(dataPtr,(STD_SIZE) read_size,1,SystemDependentData(theEnv)->BinaryFP); dataPtr = ((char *) dataPtr) + read_size; number_of_reads--; } fread(dataPtr,(STD_SIZE) temp,1,SystemDependentData(theEnv)->BinaryFP); #endif } /***************************************************/ /* GetSeekCurBinary: Generic and machine specific */ /* code for seeking a position in a file. */ /***************************************************/ globle void GetSeekCurBinary( void *theEnv, long offset) { /* #if MAC SetFPos(SystemDependentData(theEnv)->BinaryRefNum,fsFromMark,offset); #endif */ #if IBM_TBC || IBM_MSC || IBM_ICB /* || IBM_MCW || IBM_ZTC */ lseek(SystemDependentData(theEnv)->BinaryFileHandle,offset,SEEK_CUR); #endif #if (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) /* && (! IBM_MCW) && (! IBM_ZTC) */ fseek(SystemDependentData(theEnv)->BinaryFP,offset,SEEK_CUR); #endif } /***************************************************/ /* GetSeekSetBinary: Generic and machine specific */ /* code for seeking a position in a file. */ /***************************************************/ globle void GetSeekSetBinary( void *theEnv, long offset) { /* #if MAC SetFPos(SystemDependentData(theEnv)->BinaryRefNum,fsFromStart,offset); #endif */ #if IBM_TBC || IBM_MSC || IBM_ICB /* || IBM_MCW || IBM_ZTC */ lseek(SystemDependentData(theEnv)->BinaryFileHandle,offset,SEEK_SET); #endif #if (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) /* && (! IBM_MCW) && (! IBM_ZTC) */ fseek(SystemDependentData(theEnv)->BinaryFP,offset,SEEK_SET); #endif } /************************************************/ /* GenTellBinary: Generic and machine specific */ /* code for telling a position in a file. */ /************************************************/ globle void GenTellBinary( void *theEnv, long *offset) { /* #if MAC GetFPos(SystemDependentData(theEnv)->BinaryRefNum,offset); #endif */ #if IBM_TBC || IBM_MSC || IBM_ICB /* || IBM_MCW || IBM_ZTC */ *offset = lseek(SystemDependentData(theEnv)->BinaryFileHandle,0,SEEK_CUR); #endif #if (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) /* && (! IBM_MCW) && (! IBM_ZTC) */ *offset = ftell(SystemDependentData(theEnv)->BinaryFP); #endif } /****************************************/ /* GenCloseBinary: Generic and machine */ /* specific code for closing a file. */ /****************************************/ globle void GenCloseBinary( void *theEnv) { /* #if MAC FSClose(SystemDependentData(theEnv)->BinaryRefNum); #endif */ if (SystemDependentData(theEnv)->BeforeOpenFunction != NULL) { (*SystemDependentData(theEnv)->BeforeOpenFunction)(theEnv); } #if IBM_TBC || IBM_MSC || IBM_ICB /* || IBM_MCW */ close(SystemDependentData(theEnv)->BinaryFileHandle); #endif #if (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) /* && (! IBM_MCW) */ fclose(SystemDependentData(theEnv)->BinaryFP); #endif if (SystemDependentData(theEnv)->AfterOpenFunction != NULL) { (*SystemDependentData(theEnv)->AfterOpenFunction)(theEnv); } } /***********************************************/ /* GenWrite: Generic routine for writing to a */ /* file. No machine specific code as of yet. */ /***********************************************/ globle void GenWrite( void *dataPtr, unsigned long size, FILE *fp) { if (size == 0) return; #if UNIX_7 fwrite(dataPtr,(STD_SIZE) size,1,fp); #else fwrite(dataPtr,(STD_SIZE) size,1,fp); #endif } /*********************************************/ /* InitializeKeywords: Adds key words to the */ /* symbol table so that they are available */ /* for command completion. */ /*********************************************/ static void InitializeKeywords( void *theEnv) { #if (! RUN_TIME) && WINDOW_INTERFACE void *ts; /*====================*/ /* construct keywords */ /*====================*/ ts = EnvAddSymbol(theEnv,"defrule"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defglobal"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deftemplate"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffacts"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffunction"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defmethod"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defgeneric"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defclass"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defmessage-handler"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"definstances"); IncrementSymbolCount(ts); /*=======================*/ /* set-strategy keywords */ /*=======================*/ ts = EnvAddSymbol(theEnv,"depth"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"breadth"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"lex"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"mea"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"simplicity"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"complexity"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"random"); IncrementSymbolCount(ts); /*==================================*/ /* set-salience-evaluation keywords */ /*==================================*/ ts = EnvAddSymbol(theEnv,"when-defined"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"when-activated"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"every-cycle"); IncrementSymbolCount(ts); /*======================*/ /* deftemplate keywords */ /*======================*/ ts = EnvAddSymbol(theEnv,"field"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"multifield"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"default"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"type"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-symbols"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-strings"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-numbers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-integers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-floats"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-values"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"min-number-of-elements"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"max-number-of-elements"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"NONE"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"VARIABLE"); IncrementSymbolCount(ts); /*==================*/ /* defrule keywords */ /*==================*/ ts = EnvAddSymbol(theEnv,"declare"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"salience"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"test"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"or"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"and"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"not"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"logical"); IncrementSymbolCount(ts); /*===============*/ /* COOL keywords */ /*===============*/ ts = EnvAddSymbol(theEnv,"is-a"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"role"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"abstract"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"concrete"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"pattern-match"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"reactive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"non-reactive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"slot"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"field"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"multiple"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"single"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"storage"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"shared"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"local"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"access"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"write"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read-only"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read-write"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"initialize-only"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"propagation"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"inherit"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"no-inherit"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"source"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"composite"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"exclusive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-lexemes"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-instances"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"around"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"before"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"primary"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"after"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"of"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"self"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"visibility"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"override-message"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"private"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"public"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"create-accessor"); IncrementSymbolCount(ts); /*================*/ /* watch keywords */ /*================*/ ts = EnvAddSymbol(theEnv,"compilations"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffunctions"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"globals"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"rules"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"activations"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"statistics"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"facts"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"generic-functions"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"methods"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"instances"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"slots"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"messages"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"message-handlers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"focus"); IncrementSymbolCount(ts); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } clips-6.24/clipssrc/._prcdrfun.c0000400000175000017500000000452210441150533014720 0ustar jfsjfsMac OS X  2 R TEXTR*chn prcdrfun.crol PanelTCmr.txt.docTEXTR*ch p)C " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monacoxwxw;nS _nGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/._conscomp.h0000400000175000017500000000075410441131317014725 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zTTFS EFMWBBMPSRclips-6.24/clipssrc/._cstrccom.c0000400000175000017500000000075410443377275014735 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacofGHfGHhhhdTTFLFMPSRMWBBLclips-6.24/clipssrc/factmngr.c0000755000175000017500000015003410441162076014503 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* FACT MANAGER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for maintaining the fact */ /* list including assert/retract operations, data */ /* structure creation/deletion, printing, slot access, */ /* and other utility functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* AssignFactSlotDefaults function does not */ /* properly handle defaults for multifield slots. */ /* DR0869 */ /* */ /* Support for ppfact command. */ /* */ /*************************************************************/ #define _FACTMNGR_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "constant.h" #include "symbol.h" #include "memalloc.h" #include "exprnpsr.h" #include "argacces.h" #include "scanner.h" #include "router.h" #include "strngrtr.h" #include "match.h" #include "factbld.h" #include "factqury.h" #include "reteutil.h" #include "retract.h" #include "factcmp.h" #include "filecom.h" #include "factfun.h" #include "factcom.h" #include "constrct.h" #include "factrhs.h" #include "factmch.h" #include "watch.h" #include "utility.h" #include "factbin.h" #include "factmngr.h" #include "facthsh.h" #include "default.h" #include "commline.h" #include "envrnmnt.h" #include "engine.h" #include "lgcldpnd.h" #include "drive.h" #include "ruledlt.h" #include "tmpltbsc.h" #include "tmpltdef.h" #include "tmpltutl.h" #include "tmpltfun.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ResetFacts(void *); static int ClearFactsReady(void *); static void RemoveGarbageFacts(void *); static void DeallocateFactData(void *); /**************************************************************/ /* InitializeFacts: Initializes the fact data representation. */ /* Facts are only available when both the defrule and */ /* deftemplate constructs are available. */ /**************************************************************/ globle void InitializeFacts( void *theEnv) { struct patternEntityRecord factInfo = { { "FACT_ADDRESS", FACT_ADDRESS,1,0,0, PrintFactIdentifier, PrintFactIdentifierInLongForm, EnvRetract, NULL, EnvGetNextFact, EnvIncrementFactCount, EnvDecrementFactCount,NULL,NULL,NULL,NULL }, DecrementFactBasisCount, IncrementFactBasisCount, MatchFactFunction, NULL }; struct fact dummyFact = { { NULL }, NULL, NULL, -1L, 0, 1, NULL, NULL, NULL, NULL, { 1, 0, 0 } }; AllocateEnvironmentData(theEnv,FACTS_DATA,sizeof(struct factsData),DeallocateFactData); memcpy(&FactData(theEnv)->FactInfo,&factInfo,sizeof(struct patternEntityRecord)); dummyFact.factHeader.theInfo = &FactData(theEnv)->FactInfo; memcpy(&FactData(theEnv)->DummyFact,&dummyFact,sizeof(struct fact)); FactData(theEnv)->LastModuleIndex = -1; /*=========================================*/ /* Initialize the fact hash table (used to */ /* quickly determine if a fact exists). */ /*=========================================*/ InitializeFactHashTable(theEnv); /*============================================*/ /* Initialize the fact callback functions for */ /* use with the reset and clear commands. */ /*============================================*/ EnvAddResetFunction(theEnv,"facts",ResetFacts,60); AddClearReadyFunction(theEnv,"facts",ClearFactsReady,0); /*=============================*/ /* Initialize periodic garbage */ /* collection for facts. */ /*=============================*/ AddCleanupFunction(theEnv,"facts",RemoveGarbageFacts,0); /*===================================*/ /* Initialize fact pattern matching. */ /*===================================*/ InitializeFactPatterns(theEnv); /*==================================*/ /* Initialize the facts keyword for */ /* use with the watch command. */ /*==================================*/ #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"facts",0,&FactData(theEnv)->WatchFacts,80,DeftemplateWatchAccess,DeftemplateWatchPrint); #endif /*=========================================*/ /* Initialize fact commands and functions. */ /*=========================================*/ FactCommandDefinitions(theEnv); FactFunctionDefinitions(theEnv); /*==============================*/ /* Initialize fact set queries. */ /*==============================*/ #if FACT_SET_QUERIES SetupFactQuery(theEnv); #endif /*==================================*/ /* Initialize fact patterns for use */ /* with the bload/bsave commands. */ /*==================================*/ #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) FactBinarySetup(theEnv); #endif /*===================================*/ /* Initialize fact patterns for use */ /* with the constructs-to-c command. */ /*===================================*/ #if CONSTRUCT_COMPILER && (! RUN_TIME) FactPatternsCompilerSetup(theEnv); #endif } /***********************************/ /* DeallocateFactData: Deallocates */ /* environment data for facts. */ /***********************************/ static void DeallocateFactData( void *theEnv) { struct factHashEntry *tmpFHEPtr, *nextFHEPtr; struct fact *tmpFactPtr, *nextFactPtr; int i; struct patternMatch *theMatch, *tmpMatch; for (i = 0; i < SIZE_FACT_HASH; i++) { tmpFHEPtr = FactData(theEnv)->FactHashTable[i]; while (tmpFHEPtr != NULL) { nextFHEPtr = tmpFHEPtr->next; rtn_struct(theEnv,factHashEntry,tmpFHEPtr); tmpFHEPtr = nextFHEPtr; } } rm3(theEnv,FactData(theEnv)->FactHashTable, sizeof(struct factHashEntry *) * SIZE_FACT_HASH); tmpFactPtr = FactData(theEnv)->FactList; while (tmpFactPtr != NULL) { nextFactPtr = tmpFactPtr->nextFact; theMatch = (struct patternMatch *) tmpFactPtr->list; while (theMatch != NULL) { tmpMatch = theMatch->next; rtn_struct(theEnv,patternMatch,theMatch); theMatch = tmpMatch; } ReturnFact(theEnv,tmpFactPtr); tmpFactPtr = nextFactPtr; } tmpFactPtr = FactData(theEnv)->GarbageFacts; while (tmpFactPtr != NULL) { nextFactPtr = tmpFactPtr->nextFact; ReturnFact(theEnv,tmpFactPtr); tmpFactPtr = nextFactPtr; } } /**********************************************/ /* PrintFactWithIdentifier: Displays a single */ /* fact preceded by its fact identifier. */ /**********************************************/ globle void PrintFactWithIdentifier( void *theEnv, char *logicalName, struct fact *factPtr) { char printSpace[20]; sprintf(printSpace,"f-%-5ld ",factPtr->factIndex); EnvPrintRouter(theEnv,logicalName,printSpace); PrintFact(theEnv,logicalName,factPtr,FALSE,FALSE); } /****************************************************/ /* PrintFactIdentifier: Displays a fact identifier. */ /****************************************************/ globle void PrintFactIdentifier( void *theEnv, char *logicalName, void *factPtr) { char printSpace[20]; sprintf(printSpace,"f-%ld",((struct fact *) factPtr)->factIndex); EnvPrintRouter(theEnv,logicalName,printSpace); } /********************************************/ /* PrintFactIdentifierInLongForm: Display a */ /* fact identifier in a longer format. */ /********************************************/ globle void PrintFactIdentifierInLongForm( void *theEnv, char *logicalName, void *factPtr) { if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); if (factPtr != (void *) &FactData(theEnv)->DummyFact) { EnvPrintRouter(theEnv,logicalName,"factIndex); EnvPrintRouter(theEnv,logicalName,">"); } else { EnvPrintRouter(theEnv,logicalName,""); } if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); } /*******************************************/ /* DecrementFactBasisCount: Decrements the */ /* partial match busy count of a fact */ /*******************************************/ globle void DecrementFactBasisCount( void *theEnv, void *vFactPtr) { struct fact *factPtr = (struct fact *) vFactPtr; struct multifield *theSegment; int i; EnvDecrementFactCount(theEnv,factPtr); theSegment = &factPtr->theProposition; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { AtomDeinstall(theEnv,theSegment->theFields[i].type,theSegment->theFields[i].value); } } /*******************************************/ /* IncrementFactBasisCount: Increments the */ /* partial match busy count of a fact. */ /*******************************************/ globle void IncrementFactBasisCount( void *theEnv, void *vFactPtr) { struct fact *factPtr = (struct fact *) vFactPtr; struct multifield *theSegment; int i; EnvIncrementFactCount(theEnv,factPtr); theSegment = &factPtr->theProposition; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { AtomInstall(theEnv,theSegment->theFields[i].type,theSegment->theFields[i].value); } } /**************************************************/ /* PrintFact: Displays the printed representation */ /* of a fact containing the relation name and */ /* all of the fact's slots or fields. */ /**************************************************/ globle void PrintFact( void *theEnv, char *logicalName, struct fact *factPtr, int seperateLines, int ignoreDefaults) { struct multifield *theMultifield; /*=========================================*/ /* Print a deftemplate (non-ordered) fact. */ /*=========================================*/ if (factPtr->whichDeftemplate->implied == FALSE) { PrintTemplateFact(theEnv,logicalName,factPtr,seperateLines,ignoreDefaults); return; } /*==============================*/ /* Print an ordered fact (which */ /* has an implied deftemplate). */ /*==============================*/ EnvPrintRouter(theEnv,logicalName,"("); EnvPrintRouter(theEnv,logicalName,factPtr->whichDeftemplate->header.name->contents); theMultifield = (struct multifield *) factPtr->theProposition.theFields[0].value; if (theMultifield->multifieldLength != 0) { EnvPrintRouter(theEnv,logicalName," "); PrintMultifield(theEnv,logicalName,theMultifield,0, (long) (theMultifield->multifieldLength - 1), FALSE); } EnvPrintRouter(theEnv,logicalName,")"); } /*********************************************/ /* MatchFactFunction: Filters a fact through */ /* the appropriate fact pattern network. */ /*********************************************/ globle void MatchFactFunction( void *theEnv, void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; FactPatternMatch(theEnv,theFact,theFact->whichDeftemplate->patternNetwork,0,NULL,NULL); } /*********************************************************/ /* EnvRetract: C access routine for the retract command. */ /*********************************************************/ globle intBool EnvRetract( void *theEnv, void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theTemplate = theFact->whichDeftemplate; /*===========================================*/ /* A fact can not be retracted while another */ /* fact is being asserted or retracted. */ /*===========================================*/ if (EngineData(theEnv)->JoinOperationInProgress) { PrintErrorID(theEnv,"FACTMNGR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Facts may not be retracted during pattern-matching\n"); return(FALSE); } /*====================================*/ /* A NULL fact pointer indicates that */ /* all facts should be retracted. */ /*====================================*/ if (theFact == NULL) { RemoveAllFacts(theEnv); return(TRUE); } /*======================================================*/ /* Check to see if the fact has already been retracted. */ /*======================================================*/ if (theFact->garbage) return(FALSE); /*============================*/ /* Print retraction output if */ /* facts are being watched. */ /*============================*/ #if DEBUGGING_FUNCTIONS if (theFact->whichDeftemplate->watch) { EnvPrintRouter(theEnv,WTRACE,"<== "); PrintFactWithIdentifier(theEnv,WTRACE,theFact); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*==================================*/ /* Set the change flag to indicate */ /* the fact-list has been modified. */ /*==================================*/ FactData(theEnv)->ChangeToFactList = TRUE; /*===============================================*/ /* Remove any links between the fact and partial */ /* matches in the join network. These links are */ /* used to keep track of logical dependencies. */ /*===============================================*/ RemoveEntityDependencies(theEnv,(struct patternEntity *) theFact); /*===========================================*/ /* Remove the fact from the fact hash table. */ /*===========================================*/ RemoveHashedFact(theEnv,theFact); /*=========================================*/ /* Remove the fact from its template list. */ /*=========================================*/ if (theFact == theTemplate->lastFact) { theTemplate->lastFact = theFact->previousTemplateFact; } if (theFact->previousTemplateFact == NULL) { theTemplate->factList = theTemplate->factList->nextTemplateFact; if (theTemplate->factList != NULL) { theTemplate->factList->previousTemplateFact = NULL; } } else { theFact->previousTemplateFact->nextTemplateFact = theFact->nextTemplateFact; if (theFact->nextTemplateFact != NULL) { theFact->nextTemplateFact->previousTemplateFact = theFact->previousTemplateFact; } } /*=====================================*/ /* Remove the fact from the fact list. */ /*=====================================*/ if (theFact == FactData(theEnv)->LastFact) { FactData(theEnv)->LastFact = theFact->previousFact; } if (theFact->previousFact == NULL) { FactData(theEnv)->FactList = FactData(theEnv)->FactList->nextFact; if (FactData(theEnv)->FactList != NULL) { FactData(theEnv)->FactList->previousFact = NULL; } } else { theFact->previousFact->nextFact = theFact->nextFact; if (theFact->nextFact != NULL) { theFact->nextFact->previousFact = theFact->previousFact; } } /*==================================*/ /* Update busy counts and ephemeral */ /* garbage information. */ /*==================================*/ FactDeinstall(theEnv,theFact); UtilityData(theEnv)->EphemeralItemCount++; UtilityData(theEnv)->EphemeralItemSize += sizeof(struct fact) + (sizeof(struct field) * theFact->theProposition.multifieldLength); /*========================================*/ /* Add the fact to the fact garbage list. */ /*========================================*/ theFact->nextFact = FactData(theEnv)->GarbageFacts; FactData(theEnv)->GarbageFacts = theFact; theFact->garbage = TRUE; /*===================================================*/ /* Reset the evaluation error flag since expressions */ /* will be evaluated as part of the retract. */ /*===================================================*/ SetEvaluationError(theEnv,FALSE); /*===========================================*/ /* Loop through the list of all the patterns */ /* that matched the fact and process the */ /* retract operation for each one. */ /*===========================================*/ EngineData(theEnv)->JoinOperationInProgress = TRUE; NetworkRetract(theEnv,(struct patternMatch *) theFact->list); EngineData(theEnv)->JoinOperationInProgress = FALSE; /*=========================================*/ /* Free partial matches that were released */ /* by the retraction of the fact. */ /*=========================================*/ if (EngineData(theEnv)->ExecutingRule == NULL) { FlushGarbagePartialMatches(theEnv); } /*=========================================*/ /* Retract other facts that were logically */ /* dependent on the fact just retracted. */ /*=========================================*/ ForceLogicalRetractions(theEnv); /*===========================================*/ /* Force periodic cleanup if the retract was */ /* executed from an embedded application. */ /*===========================================*/ if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } /*==================================*/ /* Return TRUE to indicate the fact */ /* was successfully retracted. */ /*==================================*/ return(TRUE); } /*******************************************************************/ /* RemoveGarbageFacts: Returns facts that have been retracted to */ /* the pool of available memory. It is necessary to postpone */ /* returning the facts to memory because RHS actions retrieve */ /* their variable bindings directly from the fact data structure */ /* and the facts may be in use in other data structures. */ /*******************************************************************/ static void RemoveGarbageFacts( void *theEnv) { struct fact *factPtr, *nextPtr, *lastPtr = NULL; factPtr = FactData(theEnv)->GarbageFacts; while (factPtr != NULL) { nextPtr = factPtr->nextFact; if ((factPtr->factHeader.busyCount == 0) && (((int) factPtr->depth) > EvaluationData(theEnv)->CurrentEvaluationDepth)) { UtilityData(theEnv)->EphemeralItemCount--; UtilityData(theEnv)->EphemeralItemSize -= sizeof(struct fact) + (sizeof(struct field) * factPtr->theProposition.multifieldLength); ReturnFact(theEnv,factPtr); if (lastPtr == NULL) FactData(theEnv)->GarbageFacts = nextPtr; else lastPtr->nextFact = nextPtr; } else { lastPtr = factPtr; } factPtr = nextPtr; } } /********************************************************/ /* EnvAssert: C access routine for the assert function. */ /********************************************************/ globle void *EnvAssert( void *theEnv, void *vTheFact) { int hashValue; unsigned long length, i; struct field *theField; struct fact *theFact = (struct fact *) vTheFact; /*==========================================*/ /* A fact can not be asserted while another */ /* fact is being asserted or retracted. */ /*==========================================*/ if (EngineData(theEnv)->JoinOperationInProgress) { ReturnFact(theEnv,theFact); PrintErrorID(theEnv,"FACTMNGR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Facts may not be asserted during pattern-matching\n"); return(NULL); } /*=============================================================*/ /* Replace invalid data types in the fact with the symbol nil. */ /*=============================================================*/ length = theFact->theProposition.multifieldLength; theField = theFact->theProposition.theFields; for (i = 0; i < length; i++) { if (theField[i].type == RVOID) { theField[i].type = SYMBOL; theField[i].value = (void *) EnvAddSymbol(theEnv,"nil"); } } /*========================================================*/ /* If fact assertions are being checked for duplications, */ /* then search the fact list for a duplicate fact. */ /*========================================================*/ hashValue = HandleFactDuplication(theEnv,theFact); if (hashValue < 0) return(NULL); /*==========================================================*/ /* If necessary, add logical dependency links between the */ /* fact and the partial match which is its logical support. */ /*==========================================================*/ if (AddLogicalDependencies(theEnv,(struct patternEntity *) theFact,FALSE) == FALSE) { ReturnFact(theEnv,theFact); return(NULL); } /*======================================*/ /* Add the fact to the fact hash table. */ /*======================================*/ AddHashedFact(theEnv,theFact,hashValue); /*================================*/ /* Add the fact to the fact list. */ /*================================*/ theFact->nextFact = NULL; theFact->list = NULL; theFact->previousFact = FactData(theEnv)->LastFact; if (FactData(theEnv)->LastFact == NULL) { FactData(theEnv)->FactList = theFact; } else { FactData(theEnv)->LastFact->nextFact = theFact; } FactData(theEnv)->LastFact = theFact; /*====================================*/ /* Add the fact to its template list. */ /*====================================*/ theFact->previousTemplateFact = theFact->whichDeftemplate->lastFact; theFact->nextTemplateFact = NULL; if (theFact->whichDeftemplate->lastFact == NULL) { theFact->whichDeftemplate->factList = theFact; } else { theFact->whichDeftemplate->lastFact->nextTemplateFact = theFact; } theFact->whichDeftemplate->lastFact = theFact; /*==================================*/ /* Set the fact index and time tag. */ /*==================================*/ theFact->factIndex = FactData(theEnv)->NextFactIndex++; theFact->factHeader.timeTag = DefruleData(theEnv)->CurrentEntityTimeTag++; /*=====================*/ /* Update busy counts. */ /*=====================*/ FactInstall(theEnv,theFact); /*==========================*/ /* Print assert output if */ /* facts are being watched. */ /*==========================*/ #if DEBUGGING_FUNCTIONS if (theFact->whichDeftemplate->watch) { EnvPrintRouter(theEnv,WTRACE,"==> "); PrintFactWithIdentifier(theEnv,WTRACE,theFact); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*==================================*/ /* Set the change flag to indicate */ /* the fact-list has been modified. */ /*==================================*/ FactData(theEnv)->ChangeToFactList = TRUE; /*==========================================*/ /* Check for constraint errors in the fact. */ /*==========================================*/ CheckTemplateFact(theEnv,theFact); /*===================================================*/ /* Reset the evaluation error flag since expressions */ /* will be evaluated as part of the assert . */ /*===================================================*/ SetEvaluationError(theEnv,FALSE); /*=============================================*/ /* Pattern match the fact using the associated */ /* deftemplate's pattern network. */ /*=============================================*/ EngineData(theEnv)->JoinOperationInProgress = TRUE; FactPatternMatch(theEnv,theFact,theFact->whichDeftemplate->patternNetwork,0,NULL,NULL); EngineData(theEnv)->JoinOperationInProgress = FALSE; /*===================================================*/ /* Retract other facts that were logically dependent */ /* on the non-existence of the fact just asserted. */ /*===================================================*/ ForceLogicalRetractions(theEnv); /*=========================================*/ /* Free partial matches that were released */ /* by the assertion of the fact. */ /*=========================================*/ if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv); /*==========================================*/ /* Force periodic cleanup if the assert was */ /* executed from an embedded application. */ /*==========================================*/ if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } /*===============================*/ /* Return a pointer to the fact. */ /*===============================*/ return((void *) theFact); } /**************************************/ /* RemoveAllFacts: Loops through the */ /* fact-list and removes each fact. */ /**************************************/ globle void RemoveAllFacts( void *theEnv) { while (FactData(theEnv)->FactList != NULL) { EnvRetract(theEnv,(void *) FactData(theEnv)->FactList); } } /************************************************/ /* EnvCreateFact: Creates a fact data structure */ /* of the specified deftemplate. */ /************************************************/ globle struct fact *EnvCreateFact( void *theEnv, void *vTheDeftemplate) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; struct fact *newFact; int i; /*=================================*/ /* A deftemplate must be specified */ /* in order to create a fact. */ /*=================================*/ if (theDeftemplate == NULL) return(NULL); /*============================================*/ /* Create a fact for an explicit deftemplate. */ /*============================================*/ if (theDeftemplate->implied == FALSE) { newFact = CreateFactBySize(theEnv,theDeftemplate->numberOfSlots); for (i = 0; i < (int) theDeftemplate->numberOfSlots; i++) { newFact->theProposition.theFields[i].type = RVOID; } } /*===========================================*/ /* Create a fact for an implied deftemplate. */ /*===========================================*/ else { newFact = CreateFactBySize(theEnv,1); newFact->theProposition.theFields[0].type = MULTIFIELD; newFact->theProposition.theFields[0].value = CreateMultifield2(theEnv,0L); } /*===============================*/ /* Return a pointer to the fact. */ /*===============================*/ newFact->whichDeftemplate = theDeftemplate; return(newFact); } /******************************************/ /* EnvGetFactSlot: Returns the slot value */ /* from the specified slot of a fact. */ /******************************************/ globle intBool EnvGetFactSlot( void *theEnv, void *vTheFact, char *slotName, DATA_OBJECT *theValue) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theDeftemplate; short whichSlot; /*===============================================*/ /* Get the deftemplate associated with the fact. */ /*===============================================*/ theDeftemplate = theFact->whichDeftemplate; /*==============================================*/ /* Handle retrieving the slot value from a fact */ /* having an implied deftemplate. An implied */ /* facts has a single multifield slot. */ /*==============================================*/ if (theDeftemplate->implied) { if (slotName != NULL) return(FALSE); theValue->type = theFact->theProposition.theFields[0].type; theValue->value = theFact->theProposition.theFields[0].value; SetpDOBegin(theValue,1); SetpDOEnd(theValue,((struct multifield *) theValue->value)->multifieldLength); return(TRUE); } /*===================================*/ /* Make sure the slot name requested */ /* corresponds to a valid slot name. */ /*===================================*/ if (FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&whichSlot) == NULL) { return(FALSE); } /*======================================================*/ /* Return the slot value. If the slot value wasn't set, */ /* then return FALSE to indicate that an appropriate */ /* slot value wasn't available. */ /*======================================================*/ theValue->type = theFact->theProposition.theFields[whichSlot-1].type; theValue->value = theFact->theProposition.theFields[whichSlot-1].value; if (theValue->type == MULTIFIELD) { SetpDOBegin(theValue,1); SetpDOEnd(theValue,((struct multifield *) theValue->value)->multifieldLength); } if (theValue->type == RVOID) return(FALSE); return(TRUE); } /***************************************/ /* EnvPutFactSlot: Sets the slot value */ /* of the specified slot of a fact. */ /***************************************/ globle intBool EnvPutFactSlot( void *theEnv, void *vTheFact, char *slotName, DATA_OBJECT *theValue) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theDeftemplate; struct templateSlot *theSlot; short whichSlot; /*===============================================*/ /* Get the deftemplate associated with the fact. */ /*===============================================*/ theDeftemplate = theFact->whichDeftemplate; /*============================================*/ /* Handle setting the slot value of a fact */ /* having an implied deftemplate. An implied */ /* facts has a single multifield slot. */ /*============================================*/ if (theDeftemplate->implied) { if ((slotName != NULL) || (theValue->type != MULTIFIELD)) { return(FALSE); } if (theFact->theProposition.theFields[0].type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theFact->theProposition.theFields[0].value); } theFact->theProposition.theFields[0].type = theValue->type; theFact->theProposition.theFields[0].value = DOToMultifield(theEnv,theValue); return(TRUE); } /*===================================*/ /* Make sure the slot name requested */ /* corresponds to a valid slot name. */ /*===================================*/ if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&whichSlot)) == NULL) { return(FALSE); } /*=============================================*/ /* Make sure a single field value is not being */ /* stored in a multifield slot or vice versa. */ /*=============================================*/ if (((theSlot->multislot == 0) && (theValue->type == MULTIFIELD)) || ((theSlot->multislot == 1) && (theValue->type != MULTIFIELD))) { return(FALSE); } /*=====================*/ /* Set the slot value. */ /*=====================*/ if (theFact->theProposition.theFields[whichSlot-1].type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theFact->theProposition.theFields[whichSlot-1].value); } theFact->theProposition.theFields[whichSlot-1].type = theValue->type; if (theValue->type == MULTIFIELD) { theFact->theProposition.theFields[whichSlot-1].value = DOToMultifield(theEnv,theValue); } else { theFact->theProposition.theFields[whichSlot-1].value = theValue->value; } return(TRUE); } /********************************************************/ /* EnvAssignFactSlotDefaults: Sets a fact's slot values */ /* to its default value if the value of the slot has */ /* not yet been set. */ /********************************************************/ globle intBool EnvAssignFactSlotDefaults( void *theEnv, void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; int i; DATA_OBJECT theResult; /*===============================================*/ /* Get the deftemplate associated with the fact. */ /*===============================================*/ theDeftemplate = theFact->whichDeftemplate; /*================================================*/ /* The value for the implied multifield slot of */ /* an implied deftemplate is set to a multifield */ /* of length zero when the fact is created. */ /*================================================*/ if (theDeftemplate->implied) return(TRUE); /*============================================*/ /* Loop through each slot of the deftemplate. */ /*============================================*/ for (i = 0, slotPtr = theDeftemplate->slotList; i < (int) theDeftemplate->numberOfSlots; i++, slotPtr = slotPtr->next) { /*===================================*/ /* If the slot's value has been set, */ /* then move on to the next slot. */ /*===================================*/ if (theFact->theProposition.theFields[i].type != RVOID) continue; /*======================================================*/ /* Assign the default value for the slot if one exists. */ /*======================================================*/ if (DeftemplateSlotDefault(theEnv,theDeftemplate,slotPtr,&theResult,FALSE)) { theFact->theProposition.theFields[i].type = theResult.type; theFact->theProposition.theFields[i].value = theResult.value; } } /*==========================================*/ /* Return TRUE to indicate that the default */ /* values have been successfully set. */ /*==========================================*/ return(TRUE); } /********************************************************/ /* DeftemplateSlotDefault: Determines the default value */ /* for the specified slot of a deftemplate. */ /********************************************************/ globle intBool DeftemplateSlotDefault( void *theEnv, struct deftemplate *theDeftemplate, struct templateSlot *slotPtr, DATA_OBJECT *theResult, int garbageMultifield) { /*================================================*/ /* The value for the implied multifield slot of an */ /* implied deftemplate does not have a default. */ /*=================================================*/ if (theDeftemplate->implied) return(FALSE); /*===============================================*/ /* If the (default ?NONE) attribute was declared */ /* for the slot, then return FALSE to indicate */ /* the default values for the fact couldn't be */ /* supplied since this attribute requires that a */ /* default value can't be used for the slot. */ /*===============================================*/ if (slotPtr->noDefault) return(FALSE); /*==============================================*/ /* Otherwise if a static default was specified, */ /* use this as the default value. */ /*==============================================*/ else if (slotPtr->defaultPresent) { if (slotPtr->multislot) { StoreInMultifield(theEnv,theResult,slotPtr->defaultList,garbageMultifield); } else { theResult->type = slotPtr->defaultList->type; theResult->value = slotPtr->defaultList->value; } } /*================================================*/ /* Otherwise if a dynamic-default was specified, */ /* evaluate it and use this as the default value. */ /*================================================*/ else if (slotPtr->defaultDynamic) { if (! EvaluateAndStoreInDataObject(theEnv,(int) slotPtr->multislot, (EXPRESSION *) slotPtr->defaultList, theResult,garbageMultifield)) { return(FALSE); } } /*====================================*/ /* Otherwise derive the default value */ /* from the slot's constraints. */ /*====================================*/ else { DeriveDefaultFromConstraints(theEnv,slotPtr->constraints,theResult, (int) slotPtr->multislot,garbageMultifield); } /*==========================================*/ /* Return TRUE to indicate that the default */ /* values have been successfully set. */ /*==========================================*/ return(TRUE); } /***************************************************************/ /* CopyFactSlotValues: Copies the slot values from one fact to */ /* another. Both facts must have the same relation name. */ /***************************************************************/ globle intBool CopyFactSlotValues( void *theEnv, void *vTheDestFact, void *vTheSourceFact) { struct fact *theDestFact = (struct fact *) vTheDestFact; struct fact *theSourceFact = (struct fact *) vTheSourceFact; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; int i; /*===================================*/ /* Both facts must be the same type. */ /*===================================*/ theDeftemplate = theSourceFact->whichDeftemplate; if (theDestFact->whichDeftemplate != theDeftemplate) { return(FALSE); } /*===================================================*/ /* Loop through each slot of the deftemplate copying */ /* the source fact value to the destination fact. */ /*===================================================*/ for (i = 0, slotPtr = theDeftemplate->slotList; i < (int) theDeftemplate->numberOfSlots; i++, slotPtr = slotPtr->next) { theDestFact->theProposition.theFields[i].type = theSourceFact->theProposition.theFields[i].type; if (theSourceFact->theProposition.theFields[i].type != MULTIFIELD) { theDestFact->theProposition.theFields[i].value = theSourceFact->theProposition.theFields[i].value; } else { theDestFact->theProposition.theFields[i].value = CopyMultifield(theEnv,(struct multifield *) theSourceFact->theProposition.theFields[i].value); } } /*========================================*/ /* Return TRUE to indicate that fact slot */ /* values were successfully copied. */ /*========================================*/ return(TRUE); } /*********************************************/ /* CreateFactBySize: Allocates a fact data */ /* structure based on the number of slots. */ /*********************************************/ globle struct fact *CreateFactBySize( void *theEnv, unsigned size) { struct fact *theFact; unsigned newSize; if (size <= 0) newSize = 1; else newSize = size; theFact = get_var_struct2(theEnv,fact,sizeof(struct field) * (newSize - 1)); theFact->depth = (unsigned) EvaluationData(theEnv)->CurrentEvaluationDepth; theFact->garbage = FALSE; theFact->factIndex = 0L; theFact->factHeader.busyCount = 0; theFact->factHeader.theInfo = &FactData(theEnv)->FactInfo; theFact->factHeader.dependents = NULL; theFact->whichDeftemplate = NULL; theFact->nextFact = NULL; theFact->previousFact = NULL; theFact->previousTemplateFact = NULL; theFact->nextTemplateFact = NULL; theFact->list = NULL; theFact->theProposition.multifieldLength = size; theFact->theProposition.depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth; theFact->theProposition.busyCount = 0; return(theFact); } /*********************************************/ /* ReturnFact: Returns a fact data structure */ /* to the pool of free memory. */ /*********************************************/ globle void ReturnFact( void *theEnv, struct fact *theFact) { struct multifield *theSegment; unsigned newSize, i; theSegment = &theFact->theProposition; for (i = 0; i < theSegment->multifieldLength; i++) { if (theSegment->theFields[i].type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theSegment->theFields[i].value); } } if (theFact->theProposition.multifieldLength == 0) newSize = 1; else newSize = theFact->theProposition.multifieldLength; rtn_var_struct2(theEnv,fact,sizeof(struct field) * (newSize - 1),theFact); } /*************************************************************/ /* FactInstall: Increments the fact, deftemplate, and atomic */ /* data value busy counts associated with the fact. */ /*************************************************************/ globle void FactInstall( void *theEnv, struct fact *newFact) { struct multifield *theSegment; int i; FactData(theEnv)->NumberOfFacts++; newFact->whichDeftemplate->busyCount++; theSegment = &newFact->theProposition; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { AtomInstall(theEnv,theSegment->theFields[i].type,theSegment->theFields[i].value); } newFact->factHeader.busyCount++; } /***************************************************************/ /* FactDeinstall: Decrements the fact, deftemplate, and atomic */ /* data value busy counts associated with the fact. */ /***************************************************************/ globle void FactDeinstall( void *theEnv, struct fact *newFact) { struct multifield *theSegment; int i; FactData(theEnv)->NumberOfFacts--; theSegment = &newFact->theProposition; newFact->whichDeftemplate->busyCount--; for (i = 0 ; i < (int) theSegment->multifieldLength ; i++) { AtomDeinstall(theEnv,theSegment->theFields[i].type,theSegment->theFields[i].value); } newFact->factHeader.busyCount--; } /************************************************/ /* EnvIncrementFactCount: Increments the number */ /* of references to a specified fact. */ /************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvIncrementFactCount( void *theEnv, void *factPtr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((struct fact *) factPtr)->factHeader.busyCount++; } /************************************************/ /* EnvDecrementFactCount: Decrements the number */ /* of references to a specified fact. */ /************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvDecrementFactCount( void *theEnv, void *factPtr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((struct fact *) factPtr)->factHeader.busyCount--; } /*********************************************************/ /* EnvGetNextFact: If passed a NULL pointer, returns the */ /* first fact in the fact-list. Otherwise returns the */ /* next fact following the fact passed as an argument. */ /*********************************************************/ globle void *EnvGetNextFact( void *theEnv, void *factPtr) { if (factPtr == NULL) { return((void *) FactData(theEnv)->FactList); } if (((struct fact *) factPtr)->garbage) return(NULL); return((void *) ((struct fact *) factPtr)->nextFact); } /**************************************************/ /* GetNextFactInScope: Returns the next fact that */ /* is in scope of the current module. Works in */ /* a similar fashion to GetNextFact, but skips */ /* facts that are out of scope. */ /**************************************************/ globle void *GetNextFactInScope( void *theEnv, void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; /*=======================================================*/ /* If fact passed as an argument is a NULL pointer, then */ /* we're just beginning a traversal of the fact list. If */ /* the module index has changed since that last time the */ /* fact list was traversed by this routine, then */ /* determine all of the deftemplates that are in scope */ /* of the current module. */ /*=======================================================*/ if (theFact == NULL) { theFact = FactData(theEnv)->FactList; if (FactData(theEnv)->LastModuleIndex != DefmoduleData(theEnv)->ModuleChangeIndex) { UpdateDeftemplateScope(theEnv); FactData(theEnv)->LastModuleIndex = DefmoduleData(theEnv)->ModuleChangeIndex; } } /*==================================================*/ /* Otherwise, if the fact passed as an argument has */ /* been retracted, then there's no way to determine */ /* the next fact, so return a NULL pointer. */ /*==================================================*/ else if (((struct fact *) theFact)->garbage) { return(NULL); } /*==================================================*/ /* Otherwise, start the search for the next fact in */ /* scope with the fact immediately following the */ /* fact passed as an argument. */ /*==================================================*/ else { theFact = theFact->nextFact; } /*================================================*/ /* Continue traversing the fact-list until a fact */ /* is found that's associated with a deftemplate */ /* that's in scope. */ /*================================================*/ while (theFact != NULL) { if (theFact->whichDeftemplate->inScope) return((void *) theFact); theFact = theFact->nextFact; } return(NULL); } /****************************************/ /* EnvGetFactPPForm: Returns the pretty */ /* print representation of a fact. */ /****************************************/ globle void EnvGetFactPPForm( void *theEnv, char *buffer, unsigned bufferLength, void *theFact) { OpenStringDestination(theEnv,"FactPPForm",buffer,bufferLength); PrintFactWithIdentifier(theEnv,"FactPPForm",(struct fact *) theFact); CloseStringDestination(theEnv,"FactPPForm"); } /**********************************/ /* EnvFactIndex: C access routine */ /* for the fact-index function. */ /**********************************/ #if IBM_TBC #pragma argsused #endif globle long int EnvFactIndex( void *theEnv, void *factPtr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((struct fact *) factPtr)->factIndex); } /*************************************/ /* EnvAssertString: C access routine */ /* for the assert-string function. */ /*************************************/ globle void *EnvAssertString( void *theEnv, char *theString) { struct fact *theFact; if ((theFact = StringToFact(theEnv,theString)) == NULL) return(NULL); return((void *) EnvAssert(theEnv,(void *) theFact)); } /******************************************************/ /* EnvGetFactListChanged: Returns the flag indicating */ /* whether a change to the fact-list has been made. */ /******************************************************/ globle int EnvGetFactListChanged( void *theEnv) { return(FactData(theEnv)->ChangeToFactList); } /***********************************************************/ /* EnvSetFactListChanged: Sets the flag indicating whether */ /* a change to the fact-list has been made. */ /***********************************************************/ globle void EnvSetFactListChanged( void *theEnv, int value) { FactData(theEnv)->ChangeToFactList = value; } /****************************************/ /* GetNumberOfFacts: Returns the number */ /* of facts in the fact-list. */ /****************************************/ globle unsigned long GetNumberOfFacts( void *theEnv) { return(FactData(theEnv)->NumberOfFacts); } /***********************************************************/ /* ResetFacts: Reset function for facts. Sets the starting */ /* fact index to zero and removes all facts. */ /***********************************************************/ static void ResetFacts( void *theEnv) { /*====================================*/ /* Initialize the fact index to zero. */ /*====================================*/ FactData(theEnv)->NextFactIndex = 0L; /*======================================*/ /* Remove all facts from the fact list. */ /*======================================*/ RemoveAllFacts(theEnv); } /************************************************************/ /* ClearFactsReady: Clear ready function for facts. Returns */ /* TRUE if facts were successfully removed and the clear */ /* command can continue, otherwise FALSE. */ /************************************************************/ static int ClearFactsReady( void *theEnv) { /*====================================*/ /* Initialize the fact index to zero. */ /*====================================*/ FactData(theEnv)->NextFactIndex = 0L; /*======================================*/ /* Remove all facts from the fact list. */ /*======================================*/ RemoveAllFacts(theEnv); /*==============================================*/ /* If for some reason there are any facts still */ /* remaining, don't continue with the clear. */ /*==============================================*/ if (EnvGetNextFact(theEnv,NULL) != NULL) return(FALSE); /*=============================*/ /* Return TRUE to indicate the */ /* clear command can continue. */ /*=============================*/ return(TRUE); } /***************************************************/ /* FindIndexedFact: Returns a pointer to a fact in */ /* the fact list with the specified fact index. */ /***************************************************/ globle struct fact *FindIndexedFact( void *theEnv, long int factIndexSought) { struct fact *theFact; for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL); theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact)) { if (theFact->factIndex == factIndexSought) { return(theFact); } } return(NULL); } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/ruledlt.c0000755000175000017500000003532410441151115014351 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* RULE DELETION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for deleting a rule including */ /* freeing the defrule data structures and removing the */ /* appropriate joins from the join network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _RULEDLT_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "memalloc.h" #include "engine.h" #include "envrnmnt.h" #include "reteutil.h" #include "pattern.h" #include "agenda.h" #include "drive.h" #include "retract.h" #include "constrct.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "ruledlt.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static void RemoveIntranetworkLink(void *,struct joinNode *); #endif static void DetachJoins(void *,struct defrule *,intBool); /**********************************************************************/ /* ReturnDefrule: Returns a defrule data structure and its associated */ /* data structures to the memory manager. Note that the first */ /* disjunct of a rule is the only disjunct which allocates storage */ /* for the rule's dynamic salience and pretty print form (so these */ /* are only deallocated for the first disjunct). */ /**********************************************************************/ globle void ReturnDefrule( void *theEnv, void *vWaste) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vWaste) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) struct defrule *waste = (struct defrule *) vWaste; int first = TRUE; struct defrule *nextPtr; if (waste == NULL) return; /*======================================*/ /* If a rule is redefined, then we want */ /* to save its breakpoint status. */ /*======================================*/ #if DEBUGGING_FUNCTIONS DefruleData(theEnv)->DeletedRuleDebugFlags = 0; if (waste->afterBreakpoint) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,0); if (waste->watchActivation) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,1); if (waste->watchFiring) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,2); #endif /*================================*/ /* Clear the agenda of all the */ /* activations added by the rule. */ /*================================*/ ClearRuleFromAgenda(theEnv,waste); /*======================*/ /* Get rid of the rule. */ /*======================*/ while (waste != NULL) { /*================================================*/ /* Remove the rule's joins from the join network. */ /*================================================*/ DetachJoins(theEnv,waste,FALSE); /*=============================================*/ /* If this is the first disjunct, get rid of */ /* the dynamic salience and pretty print form. */ /*=============================================*/ if (first) { if (waste->dynamicSalience != NULL) { ExpressionDeinstall(theEnv,waste->dynamicSalience); ReturnPackedExpression(theEnv,waste->dynamicSalience); waste->dynamicSalience = NULL; } if (waste->header.ppForm != NULL) { rm(theEnv,waste->header.ppForm,strlen(waste->header.ppForm) + 1); waste->header.ppForm = NULL; } first = FALSE; } /*===========================*/ /* Get rid of any user data. */ /*===========================*/ if (waste->header.usrData != NULL) { ClearUserDataList(theEnv,waste->header.usrData); } /*===========================================*/ /* Decrement the count for the defrule name. */ /*===========================================*/ DecrementSymbolCount(theEnv,waste->header.name); /*========================================*/ /* Get rid of the the rule's RHS actions. */ /*========================================*/ if (waste->actions != NULL) { ExpressionDeinstall(theEnv,waste->actions); ReturnPackedExpression(theEnv,waste->actions); } /*===============================*/ /* Move on to the next disjunct. */ /*===============================*/ nextPtr = waste->disjunct; rtn_struct(theEnv,defrule,waste); waste = nextPtr; } /*==========================*/ /* Free up partial matches. */ /*==========================*/ if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv); #endif } /********************************************************/ /* DestroyDefrule: Action used to remove defrules */ /* as a result of DestroyEnvironment. */ /********************************************************/ globle void DestroyDefrule( void *theEnv, void *vTheDefrule) { struct defrule *theDefrule = (struct defrule *) vTheDefrule; struct defrule *nextDisjunct; int first = TRUE; if (theDefrule == NULL) return; while (theDefrule != NULL) { DetachJoins(theEnv,theDefrule,TRUE); if (first) { #if (! BLOAD_ONLY) && (! RUN_TIME) if (theDefrule->dynamicSalience != NULL) { ReturnPackedExpression(theEnv,theDefrule->dynamicSalience); } if (theDefrule->header.ppForm != NULL) { rm(theEnv,theDefrule->header.ppForm,strlen(theDefrule->header.ppForm) + 1); } #endif first = FALSE; } if (theDefrule->header.usrData != NULL) { ClearUserDataList(theEnv,theDefrule->header.usrData); } #if (! BLOAD_ONLY) && (! RUN_TIME) if (theDefrule->actions != NULL) { ReturnPackedExpression(theEnv,theDefrule->actions); } #endif nextDisjunct = theDefrule->disjunct; #if (! BLOAD_ONLY) && (! RUN_TIME) rtn_struct(theEnv,defrule,theDefrule); #endif theDefrule = nextDisjunct; } } /**********************************************************************/ /* DetachJoins: Removes a join node and all of its parent nodes from */ /* the join network. Nodes are only removed if they are no required */ /* by other rules (the same join can be shared by multiple rules). */ /* Any partial matches associated with the join are also removed. */ /* A rule's joins are typically removed by removing the bottom most */ /* join used by the rule and then removing any parent joins which */ /* are not shared by other rules. */ /**********************************************************************/ static void DetachJoins( void *theEnv, struct defrule *theRule, intBool destroy) { struct joinNode *join; struct joinNode *prevJoin; struct joinNode *joinPtr, *lastJoin, *rightJoin; /*==================================*/ /* Find the last join for the rule. */ /*==================================*/ join = theRule->lastJoin; theRule->lastJoin = NULL; if (join == NULL) return; /*===================================================*/ /* Remove the activation link from the last join. If */ /* there are joins below this join, then all of the */ /* joins for this rule were shared with another rule */ /* and thus no joins can be deleted. */ /*===================================================*/ join->ruleToActivate = NULL; if (join->nextLevel != NULL) return; /*===========================*/ /* Begin removing the joins. */ /*===========================*/ while (join != NULL) { /*==========================================================*/ /* Remember the join "above" this join (the one that enters */ /* from the left). If the join is entered from the right by */ /* another join, remember the right entering join as well. */ /*==========================================================*/ prevJoin = join->lastLevel; if (join->joinFromTheRight) { rightJoin = (struct joinNode *) join->rightSideEntryStructure; } else { rightJoin = NULL; } /*=================================================*/ /* If the join was attached to a pattern, remove */ /* any structures associated with the pattern that */ /* are no longer needed. */ /*=================================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) if (! destroy) { if ((join->rightSideEntryStructure != NULL) && (join->joinFromTheRight == FALSE)) { RemoveIntranetworkLink(theEnv,join); } } #endif /*======================================*/ /* Remove any partial matches contained */ /* in the beta memory of the join. */ /*======================================*/ if (destroy) { DestroyAlphaBetaMemory(theEnv,join->beta); } else { FlushAlphaBetaMemory(theEnv,join->beta); } join->beta = NULL; /*===================================*/ /* Remove the expressions associated */ /* with the join. */ /*===================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) if (! destroy) { RemoveHashedExpression(theEnv,join->networkTest); } #endif /*==================================================*/ /* Remove the link to the join from the join above. */ /*==================================================*/ if (prevJoin == NULL) { #if (! RUN_TIME) && (! BLOAD_ONLY) rtn_struct(theEnv,joinNode,join); #endif return; } lastJoin = NULL; joinPtr = prevJoin->nextLevel; while (joinPtr != NULL) { if (joinPtr == join) { if (lastJoin == NULL) { prevJoin->nextLevel = joinPtr->rightDriveNode; } else { lastJoin->rightDriveNode = joinPtr->rightDriveNode; } joinPtr = NULL; } else { lastJoin = joinPtr; joinPtr = joinPtr->rightDriveNode; } } /*==================*/ /* Delete the join. */ /*==================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) rtn_struct(theEnv,joinNode,join); #endif /*==========================================*/ /* Remove the right join link if it exists. */ /*==========================================*/ if (rightJoin != NULL) { rightJoin->nextLevel = NULL; prevJoin = rightJoin; } /*===========================================================*/ /* Move on to the next join to be removed. All the joins of */ /* a rule can be deleted by following the right joins links */ /* (when these links exist) and then following the left join */ /* links. This works because if join A enters join B from */ /* the right, the right/left links of join A eventually lead */ /* to the join which enters join B from the left. */ /*===========================================================*/ if (prevJoin->ruleToActivate != NULL) { join = NULL; } else if (prevJoin->nextLevel == NULL) { join = prevJoin; } else { join = NULL; } } } #if (! RUN_TIME) && (! BLOAD_ONLY) /***********************************************************************/ /* RemoveIntranetworkLink: Removes the link between a join node in the */ /* join network and its corresponding pattern node in the pattern */ /* network. If the pattern node is then no longer associated with */ /* any other joins, it is removed using the function DetachPattern. */ /***********************************************************************/ static void RemoveIntranetworkLink( void *theEnv, struct joinNode *join) { struct patternNodeHeader *patternPtr; struct joinNode *joinPtr, *lastJoin; /*================================================*/ /* Determine the pattern that enters this join. */ /* Determine the list of joins which this pattern */ /* enters from the right. */ /*================================================*/ patternPtr = (struct patternNodeHeader *) join->rightSideEntryStructure; joinPtr = patternPtr->entryJoin; lastJoin = NULL; /*=================================================*/ /* Loop through the list of joins that the pattern */ /* enters until the join being removed is found. */ /* Remove this join from the list. */ /*=================================================*/ while (joinPtr != NULL) { if (joinPtr == join) { if (lastJoin == NULL) { patternPtr->entryJoin = joinPtr->rightMatchNode; } else { lastJoin->rightMatchNode = joinPtr->rightMatchNode; } joinPtr = NULL; } else { lastJoin = joinPtr; joinPtr = joinPtr->rightMatchNode; } } /*===================================================*/ /* If the terminal node of the pattern doesn't point */ /* to any joins, then start removing the pattern. */ /*===================================================*/ if (patternPtr->entryJoin == NULL) { DetachPattern(theEnv,(int) join->rhsType,patternPtr); } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._tmpltrhs.c0000400000175000017500000000075410441167041014757 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0{0{551TTF/B#FMPSRMWBBLclips-6.24/clipssrc/._commline.h0000400000175000017500000000075410441602067014714 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zTTFL(FMPSRMWBBLclips-6.24/clipssrc/._cstrcpsr.h0000400000175000017500000000075407422634630014762 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco<0<0paTTFYFMWBBMPSRclips-6.24/clipssrc/lgcldpnd.c0000755000175000017500000006152310441162373014475 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* LOGICAL DEPENDENCIES MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provide support routines for managing truth */ /* maintenance using the logical conditional element. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /*************************************************************/ #define _LGCLDPND_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFRULE_CONSTRUCT #include "memalloc.h" #include "router.h" #include "envrnmnt.h" #include "evaluatn.h" #include "engine.h" #include "reteutil.h" #include "pattern.h" #include "argacces.h" #include "factmngr.h" #if OBJECT_SYSTEM #include "insfun.h" #endif #include "lgcldpnd.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct partialMatch *FindLogicalBind(struct joinNode *,struct partialMatch *); static struct dependency *DetachAssociatedDependencies(void *,struct dependency *,void *); /***********************************************************************/ /* AddLogicalDependencies: Adds the logical dependency links between a */ /* data entity (such as a fact or instance) and the partial match */ /* which logically supports that data entity. If a data entity is */ /* unconditionally asserted (i.e. the global variable TheLogicalJoin */ /* is NULL), then existing logical support for the data entity is no */ /* longer needed and it is removed. If a data entity is already */ /* unconditionally supported and that data entity is conditionally */ /* asserted (i.e. the global variable TheLogicalJoin is not NULL), */ /* then the logical support is ignored. Otherwise, the partial match */ /* is linked to the data entity and the data entity is linked to the */ /* partial match. Note that the word assert is used to refer to */ /* creating a fact with the assert command and creating an instance */ /* with the make-instance command. */ /***********************************************************************/ globle intBool AddLogicalDependencies( void *theEnv, struct patternEntity *theEntity, int 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); } /*============================================================*/ /* Find the partial match in the logical join associated with */ /* activation partial match. If the partial match cannot be */ /* found, then the partial match must have been deleted by a */ /* previous RHS action and the dependency link should not be */ /* added. */ /*============================================================*/ theBinds = FindLogicalBind(EngineData(theEnv)->TheLogicalJoin,EngineData(theEnv)->GlobalLHSBinds); if (theBinds == 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 = (void *) theEntity; newDependency->next = (struct dependency *) theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue; theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue = (void *) newDependency; /*================================================================*/ /* Add a dependency link between the entity and the partialMatch. */ /*================================================================*/ newDependency = get_struct(theEnv,dependency); newDependency->dPtr = (void *) theBinds; newDependency->next = (struct dependency *) theEntity->dependents; theEntity->dependents = (void *) newDependency; /*==================================================================*/ /* Return TRUE to indicate that the data entity should be asserted. */ /*==================================================================*/ return(TRUE); } /************************************************************************/ /* FindLogicalBind: Finds the partial match associated with the logical */ /* CE which will provide logical support for a data entity asserted */ /* from the currently executing rule. The function is called when */ /* creating logical support links between the data entity and */ /* supporting partial matches. It compares each partial match found */ /* at a specified join to the partial match associated with a rule */ /* activation until it finds the partial match that generated the */ /* rule activation. */ /************************************************************************/ static struct partialMatch *FindLogicalBind( struct joinNode *theJoin, struct partialMatch *theBinds) { struct partialMatch *compPtr; unsigned int i; int found; /*==================================*/ /* Loop through each of the partial */ /* matches in the beta memory. */ /*==================================*/ for (compPtr = theJoin->beta; compPtr != NULL; compPtr = compPtr->next) { /*==================================================*/ /* Compare each of the data entities in the partial */ /* match being examined and the partial match used */ /* in the dependency link. */ /*==================================================*/ found = TRUE; for (i = 0; i < compPtr->bcount; i++) { if (compPtr->binds[i].gm.theMatch != theBinds->binds[i].gm.theMatch) { found = FALSE; break; } } /*========================================================*/ /* If all of the data entities in the partial match are */ /* identical to the partial match in the dependency link, */ /* then this is the partial match we're looking for. */ /*========================================================*/ if (found) return(compPtr); } /*========================================*/ /* The partial match corresponding to the */ /* logical dependency couldn't be found. */ /*========================================*/ return(NULL); } /*********************************************************************/ /* RemoveEntityDependencies: Removes all logical support links from */ /* a pattern entity that point to partial matches or other pattern */ /* entities. Also removes the associated links from the partial */ /* matches or pattern entities which point back to the pattern */ /* entities. */ /*********************************************************************/ globle void RemoveEntityDependencies( void *theEnv, struct patternEntity *theEntity) { struct dependency *fdPtr, *nextPtr, *theList; struct partialMatch *theBinds; /*===============================*/ /* Get the list of dependencies. */ /*===============================*/ fdPtr = (struct dependency *) theEntity->dependents; /*========================================*/ /* Loop through each of the dependencies. */ /*========================================*/ while (fdPtr != NULL) { /*===============================*/ /* Remember the next dependency. */ /*===============================*/ nextPtr = fdPtr->next; /*================================================================*/ /* Remove the link between the data entity and the partial match. */ /*================================================================*/ theBinds = (struct partialMatch *) fdPtr->dPtr; theList = (struct dependency *) theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue; theList = DetachAssociatedDependencies(theEnv,theList,(void *) theEntity); theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue = (void *) theList; /*========================*/ /* Return the dependency. */ /*========================*/ rtn_struct(theEnv,dependency,fdPtr); /*=================================*/ /* Move on to the next dependency. */ /*=================================*/ fdPtr = nextPtr; } /*=====================================================*/ /* Set the dependency list of the data entity to NULL. */ /*=====================================================*/ theEntity->dependents = NULL; } /********************************************************************/ /* ReturnEntityDependencies: Removes all logical support links from */ /* a pattern entity. This is unidirectional. The links from the */ /* the partial match to the entity are not removed. */ /********************************************************************/ globle void ReturnEntityDependencies( void *theEnv, struct patternEntity *theEntity) { struct dependency *fdPtr, *nextPtr; fdPtr = (struct dependency *) theEntity->dependents; while (fdPtr != NULL) { nextPtr = fdPtr->next; rtn_struct(theEnv,dependency,fdPtr); fdPtr = nextPtr; } theEntity->dependents = NULL; } /*******************************************************************/ /* DetachAssociatedDependencies: Removes all logical support links */ /* which pointer to a pattern entity from a list of dependencies */ /* (which may be associated with either a partial match or */ /* another pattern entity). Does not remove links which point in */ /* the other direction. */ /*******************************************************************/ static struct dependency *DetachAssociatedDependencies( void *theEnv, struct dependency *theList, void *theEntity) { struct dependency *fdPtr, *nextPtr, *lastPtr = NULL; fdPtr = theList; while (fdPtr != NULL) { if (fdPtr->dPtr == theEntity) { nextPtr = fdPtr->next; if (lastPtr == NULL) theList = nextPtr; else lastPtr->next = nextPtr; rtn_struct(theEnv,dependency,fdPtr); fdPtr = nextPtr; } else { lastPtr = fdPtr; fdPtr = fdPtr->next; } } return(theList); } /**************************************************************************/ /* RemovePMDependencies: Removes all logical support links from a partial */ /* match that point to any data entities. Also removes the associated */ /* links from the data entities which point back to the partial match. */ /**************************************************************************/ globle void RemovePMDependencies( void *theEnv, struct partialMatch *theBinds) { struct dependency *fdPtr, *nextPtr, *theList; struct patternEntity *theEntity; fdPtr = (struct dependency *) theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue; while (fdPtr != NULL) { nextPtr = fdPtr->next; theEntity = (struct patternEntity *) fdPtr->dPtr; theList = (struct dependency *) theEntity->dependents; theList = DetachAssociatedDependencies(theEnv,theList,(void *) theBinds); theEntity->dependents = (void *) theList; rtn_struct(theEnv,dependency,fdPtr); fdPtr = nextPtr; } theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue = NULL; } /************************************************************/ /* DestroyPMDependencies: Removes all logical support links */ /* from a partial match that point to any data entities. */ /************************************************************/ globle void DestroyPMDependencies( void *theEnv, struct partialMatch *theBinds) { struct dependency *fdPtr, *nextPtr; fdPtr = (struct dependency *) theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue; while (fdPtr != NULL) { nextPtr = fdPtr->next; rtn_struct(theEnv,dependency,fdPtr); fdPtr = nextPtr; } theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue = NULL; } /************************************************************************/ /* RemoveLogicalSupport: Removes the dependency links between a partial */ /* match and the data entities it logically supports. Also removes */ /* the associated links from the data entities which point back to */ /* the partial match by calling DetachAssociatedEntityDependencies. */ /* If an entity has all of its logical support removed as a result of */ /* this procedure, the dependency link from the partial match is */ /* added to the list of unsupported data entities so that the entity */ /* will be deleted as a result of losing its logical support. */ /************************************************************************/ globle void RemoveLogicalSupport( void *theEnv, struct partialMatch *theBinds) { struct dependency *dlPtr, *tempPtr, *theList; struct patternEntity *theEntity; /*========================================*/ /* If the partial match has no associated */ /* dependencies, then return. */ /*========================================*/ if (theBinds->dependentsf == FALSE) return; /*=======================================*/ /* Loop through each of the dependencies */ /* attached to the partial match. */ /*=======================================*/ dlPtr = (struct dependency *) theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue; while (dlPtr != NULL) { /*===============================*/ /* Remember the next dependency. */ /*===============================*/ tempPtr = dlPtr->next; /*==========================================================*/ /* Determine the data entity associated with the dependency */ /* structure and delete its dependency references to this */ /* partial match. */ /*==========================================================*/ theEntity = (struct patternEntity *) dlPtr->dPtr; theList = (struct dependency *) theEntity->dependents; theList = DetachAssociatedDependencies(theEnv,theList,(void *) theBinds); theEntity->dependents = (void *) theList; /*==============================================================*/ /* If the data entity has lost all of its logical support, then */ /* add the dependency structure from the partial match to the */ /* list of unsupported data entities to be deleted. Otherwise, */ /* just delete the dependency structure. */ /*==============================================================*/ if (theEntity->dependents == NULL) { (*theEntity->theInfo->base.incrementBusyCount)(theEnv,theEntity); dlPtr->next = EngineData(theEnv)->UnsupportedDataEntities; EngineData(theEnv)->UnsupportedDataEntities = dlPtr; } else { rtn_struct(theEnv,dependency,dlPtr); } /*==================================*/ /* Move on to the next dependency. */ /*==================================*/ dlPtr = tempPtr; } /*=====================================*/ /* The partial match no longer has any */ /* dependencies associated with it. */ /*=====================================*/ theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue = NULL; } /********************************************************************/ /* ForceLogicalRetractions: Deletes the data entities found on the */ /* list of items that have lost their logical support. The delete */ /* function associated with each data entity is called to delete */ /* that data entity. Calling the delete function may in turn */ /* add more data entities to the list of data entities which have */ /* lost their logical support. */ /********************************************************************/ globle void ForceLogicalRetractions( void *theEnv) { struct dependency *tempPtr; struct patternEntity *theEntity; /*===================================================*/ /* Don't reenter this function once it's called. Any */ /* new additions to the list of items to be deleted */ /* as a result of losing their logical support will */ /* be handled properly. */ /*===================================================*/ if (EngineData(theEnv)->alreadyEntered) return; EngineData(theEnv)->alreadyEntered = TRUE; /*=======================================================*/ /* Continue to delete the first item on the list as long */ /* as one exists. This is done because new items may be */ /* placed at the beginning of the list as other data */ /* entities are deleted. */ /*=======================================================*/ while (EngineData(theEnv)->UnsupportedDataEntities != NULL) { /*==========================================*/ /* Determine the data entity to be deleted. */ /*==========================================*/ theEntity = (struct patternEntity *) EngineData(theEnv)->UnsupportedDataEntities->dPtr; /*================================================*/ /* Remove the dependency structure from the list. */ /*================================================*/ tempPtr = EngineData(theEnv)->UnsupportedDataEntities; EngineData(theEnv)->UnsupportedDataEntities = EngineData(theEnv)->UnsupportedDataEntities->next; rtn_struct(theEnv,dependency,tempPtr); /*=========================*/ /* Delete the data entity. */ /*=========================*/ (*theEntity->theInfo->base.decrementBusyCount)(theEnv,theEntity); (*theEntity->theInfo->base.deleteFunction)(theEnv,theEntity); } /*============================================*/ /* Deletion of items on the list is complete. */ /*============================================*/ EngineData(theEnv)->alreadyEntered = FALSE; } /****************************************************************/ /* Dependencies: C access routine for the dependencies command. */ /****************************************************************/ globle void Dependencies( void *theEnv, struct patternEntity *theEntity) { struct dependency *fdPtr; /*=========================================*/ /* If the data entity has no dependencies, */ /* then print "None" and return. */ /*=========================================*/ if (theEntity->dependents == NULL) { EnvPrintRouter(theEnv,WDISPLAY,"None\n"); return; } /*============================================*/ /* Loop through the list of the data entities */ /* dependencies and print them. */ /*============================================*/ for (fdPtr = (struct dependency *) theEntity->dependents; fdPtr != NULL; fdPtr = fdPtr->next) { if (GetHaltExecution(theEnv) == TRUE) return; PrintPartialMatch(theEnv,WDISPLAY,(struct partialMatch *) fdPtr->dPtr); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } /************************************************************/ /* Dependents: C access routine for the dependents command. */ /************************************************************/ globle void Dependents( void *theEnv, struct patternEntity *theEntity) { struct patternEntity *entityPtr = NULL; struct patternParser *theParser = NULL; struct dependency *fdPtr; struct partialMatch *theBinds; int found = FALSE; /*=================================*/ /* Loop through every data entity. */ /*=================================*/ for (GetNextPatternEntity(theEnv,&theParser,&entityPtr); entityPtr != NULL; GetNextPatternEntity(theEnv,&theParser,&entityPtr)) { if (GetHaltExecution(theEnv) == TRUE) return; /*====================================*/ /* Loop through every dependency link */ /* associated with the data entity. */ /*====================================*/ for (fdPtr = (struct dependency *) entityPtr->dependents; fdPtr != NULL; fdPtr = fdPtr->next) { if (GetHaltExecution(theEnv) == TRUE) return; /*=====================================================*/ /* If the data entity which was the argument passed to */ /* the dependents command is contained in one of the */ /* partial matches of the data entity currently being */ /* examined, then the data entity being examined is a */ /* dependent. Print the data entity and then move on */ /* to the next data entity. */ /*=====================================================*/ theBinds = (struct partialMatch *) fdPtr->dPtr; if (FindEntityInPartialMatch(theEntity,theBinds) == TRUE) { if (found) EnvPrintRouter(theEnv,WDISPLAY,","); (*entityPtr->theInfo->base.shortPrintFunction)(theEnv,WDISPLAY,entityPtr); found = TRUE; break; } } } /*=================================================*/ /* If no dependents were found, then print "None." */ /* Otherwise print a carriage return after the */ /* list of dependents. */ /*=================================================*/ if (! found) EnvPrintRouter(theEnv,WDISPLAY,"None\n"); else EnvPrintRouter(theEnv,WDISPLAY,"\n"); } #if DEBUGGING_FUNCTIONS /*********************************************/ /* DependenciesCommand: H/L access routine */ /* for the dependencies command. */ /*********************************************/ globle void DependenciesCommand( void *theEnv) { DATA_OBJECT item; void *ptr; if (EnvArgCountCheck(theEnv,"dependencies",EXACTLY,1) == -1) return; ptr = GetFactOrInstanceArgument(theEnv,1,&item,"dependencies"); if (ptr == NULL) return; #if DEFRULE_CONSTRUCT Dependencies(theEnv,(struct patternEntity *) ptr); #else EnvPrintRouter(theEnv,WDISPLAY,"None\n"); #endif } /*******************************************/ /* DependentsCommand: H/L access routine */ /* for the dependents command. */ /*******************************************/ globle void DependentsCommand( void *theEnv) { DATA_OBJECT item; void *ptr; if (EnvArgCountCheck(theEnv,"dependents",EXACTLY,1) == -1) return; ptr = GetFactOrInstanceArgument(theEnv,1,&item,"dependents"); if (ptr == NULL) return; #if DEFRULE_CONSTRUCT Dependents(theEnv,(struct patternEntity *) ptr); #else EnvPrintRouter(theEnv,WDISPLAY,"None\n"); #endif } #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._dffctcmp.h0000400000175000017500000000012207422634717014700 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/extnfunc.h0000755000175000017500000001173610441132060014534 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EXTERNAL FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for adding new user or system defined */ /* functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_extnfunc #define _H_extnfunc #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #include "userdata.h" struct FunctionDefinition { struct symbolHashNode *callFunctionName; char *actualFunctionName; char returnValueType; int (*functionPointer)(void); struct expr *(*parser)(void *,struct expr *,char *); char *restrictions; short int overloadable; short int sequenceuseok; short int environmentAware; short int bsaveIndex; struct FunctionDefinition *next; struct userData *usrData; }; #define ValueFunctionType(target) (((struct FunctionDefinition *) target)->returnValueType) #define ExpressionFunctionType(target) (((struct FunctionDefinition *) ((target)->value))->returnValueType) #define ExpressionFunctionPointer(target) (((struct FunctionDefinition *) ((target)->value))->functionPointer) #define ExpressionFunctionCallName(target) (((struct FunctionDefinition *) ((target)->value))->callFunctionName) #define ExpressionFunctionRealName(target) (((struct FunctionDefinition *) ((target)->value))->actualFunctionName) #define PTIF (int (*)(void)) #define PTIEF (int (*)(void *)) /*==================*/ /* ENVIRONMENT DATA */ /*==================*/ #define EXTERNAL_FUNCTION_DATA 50 struct externalFunctionData { struct FunctionDefinition *ListOfFunctions; struct FunctionHash **FunctionHashtable; }; #define ExternalFunctionData(theEnv) ((struct externalFunctionData *) GetEnvironmentData(theEnv,EXTERNAL_FUNCTION_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _EXTNFUNC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifdef LOCALE struct FunctionHash { struct FunctionDefinition *fdPtr; struct FunctionHash *next; }; #define SIZE_FUNCTION_HASH 517 #endif #if ENVIRONMENT_API_ONLY #define DefineFunction(theEnv,a,b,c,d) EnvDefineFunction(theEnv,a,b,c,d) #define DefineFunction2(theEnv,a,b,c,d,e) EnvDefineFunction2(theEnv,a,b,c,d,e) #else LOCALE int DefineFunction(char *,int,int (*)(void),char *); LOCALE int DefineFunction2(char *,int,int (*)(void),char *,char *); #endif LOCALE void InitializeExternalFunctionData(void *); LOCALE int EnvDefineFunction(void *,char *,int, int (*)(void *),char *); LOCALE int EnvDefineFunction2(void *,char *,int, int (*)(void *),char *,char *); LOCALE int DefineFunction3(void *,char *,int, int (*)(void *),char *,char *,intBool); LOCALE int AddFunctionParser(void *,char *, struct expr *(*)( void *,struct expr *,char *)); LOCALE int RemoveFunctionParser(void *,char *); LOCALE int FuncSeqOvlFlags(void *,char *,int,int); LOCALE struct FunctionDefinition *GetFunctionList(void *); LOCALE void InstallFunctionList(void *,struct FunctionDefinition *); LOCALE struct FunctionDefinition *FindFunction(void *,char *); LOCALE int GetNthRestriction(struct FunctionDefinition *,int); LOCALE char *GetArgumentTypeName(int); LOCALE int UndefineFunction(void *,char *); LOCALE int GetMinimumArgs(struct FunctionDefinition *); LOCALE int GetMaximumArgs(struct FunctionDefinition *); #endif clips-6.24/clipssrc/proflfun.c0000755000175000017500000007233610441602277014547 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* CONSTRUCT PROFILING FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for profiling the amount of */ /* time spent in constructs and user defined functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Modified OutputProfileInfo to allow a before */ /* and after prefix so that a string buffer does */ /* not need to be created to contain the entire */ /* prefix. This allows a buffer overflow problem */ /* to be corrected. DR0857. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /*************************************************************/ #define _PROFLFUN_SOURCE_ #include "setup.h" #if PROFILING_FUNCTIONS #include "argacces.h" #include "classcom.h" #include "dffnxfun.h" #include "envrnmnt.h" #include "extnfunc.h" #include "genrccom.h" #include "genrcfun.h" #include "memalloc.h" #include "msgcom.h" #include "router.h" #include "sysdep.h" #include "proflfun.h" #include #define NO_PROFILE 0 #define USER_FUNCTIONS 1 #define CONSTRUCTS_CODE 2 #define OUTPUT_STRING "%-40s %7ld %15.6f %8.2f%% %15.6f %8.2f%%\n" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool OutputProfileInfo(void *,char *,struct constructProfileInfo *, char *,char *,char *,char **); static void OutputUserFunctionsInfo(void *); static void OutputConstructsCodeInfo(void *); #if (! RUN_TIME) static void ProfileClearFunction(void *); #endif /******************************************************/ /* ConstructProfilingFunctionDefinitions: Initializes */ /* the construct profiling functions. */ /******************************************************/ globle void ConstructProfilingFunctionDefinitions( void *theEnv) { struct userDataRecord profileDataInfo = { 0, CreateProfileData, DeleteProfileData }; AllocateEnvironmentData(theEnv,PROFLFUN_DATA,sizeof(struct profileFunctionData),NULL); memcpy(&ProfileFunctionData(theEnv)->ProfileDataInfo,&profileDataInfo,sizeof(struct userDataRecord)); ProfileFunctionData(theEnv)->LastProfileInfo = NO_PROFILE; ProfileFunctionData(theEnv)->PercentThreshold = 0.0; ProfileFunctionData(theEnv)->OutputString = OUTPUT_STRING; #if ! RUN_TIME EnvDefineFunction2(theEnv,"profile",'v', PTIEF ProfileCommand,"ProfileCommand","11w"); EnvDefineFunction2(theEnv,"profile-info",'v', PTIEF ProfileInfoCommand,"ProfileInfoCommand","01w"); EnvDefineFunction2(theEnv,"profile-reset",'v', PTIEF ProfileResetCommand,"ProfileResetCommand","00"); EnvDefineFunction2(theEnv,"set-profile-percent-threshold",'d', PTIEF SetProfilePercentThresholdCommand, "SetProfilePercentThresholdCommand","11n"); EnvDefineFunction2(theEnv,"get-profile-percent-threshold",'d', PTIEF GetProfilePercentThresholdCommand, "GetProfilePercentThresholdCommand","00"); ProfileFunctionData(theEnv)->ProfileDataID = InstallUserDataRecord(theEnv,&ProfileFunctionData(theEnv)->ProfileDataInfo); EnvAddClearFunction(theEnv,"profile",ProfileClearFunction,0); #endif } /**********************************/ /* CreateProfileData: Allocates a */ /* profile user data structure. */ /**********************************/ globle void *CreateProfileData( void *theEnv) { struct constructProfileInfo *theInfo; theInfo = (struct constructProfileInfo *) genalloc(theEnv,sizeof(struct constructProfileInfo)); theInfo->numberOfEntries = 0; theInfo->childCall = FALSE; theInfo->startTime = 0.0; theInfo->totalSelfTime = 0.0; theInfo->totalWithChildrenTime = 0.0; return(theInfo); } /**************************************/ /* DeleteProfileData: */ /**************************************/ globle void DeleteProfileData( void *theEnv, void *theData) { genfree(theEnv,theData,sizeof(struct constructProfileInfo)); } /**************************************/ /* ProfileCommand: H/L access routine */ /* for the profile command. */ /**************************************/ globle void ProfileCommand( void *theEnv) { char *argument; DATA_OBJECT theValue; if (EnvArgCountCheck(theEnv,"profile",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"profile",1,SYMBOL,&theValue) == FALSE) return; argument = DOToString(theValue); if (! Profile(theEnv,argument)) { ExpectedTypeError1(theEnv,"profile",1,"symbol with value constructs, user-functions, or off"); return; } return; } /******************************/ /* Profile: C access routine */ /* for the profile command. */ /******************************/ globle intBool Profile( void *theEnv, char *argument) { /*======================================================*/ /* If the argument is the symbol "user-functions", then */ /* user-defined functions should be profiled. If the */ /* argument is the symbol "constructs", then */ /* deffunctions, generic functions, message-handlers, */ /* and rule RHS actions are profiled. */ /*======================================================*/ if (strcmp(argument,"user-functions") == 0) { ProfileFunctionData(theEnv)->ProfileStartTime = gentime(); ProfileFunctionData(theEnv)->ProfileUserFunctions = TRUE; ProfileFunctionData(theEnv)->ProfileConstructs = FALSE; ProfileFunctionData(theEnv)->LastProfileInfo = USER_FUNCTIONS; } else if (strcmp(argument,"constructs") == 0) { ProfileFunctionData(theEnv)->ProfileStartTime = gentime(); ProfileFunctionData(theEnv)->ProfileUserFunctions = FALSE; ProfileFunctionData(theEnv)->ProfileConstructs = TRUE; ProfileFunctionData(theEnv)->LastProfileInfo = CONSTRUCTS_CODE; } /*======================================================*/ /* Otherwise, if the argument is the symbol "off", then */ /* don't profile constructs and user-defined functions. */ /*======================================================*/ else if (strcmp(argument,"off") == 0) { ProfileFunctionData(theEnv)->ProfileEndTime = gentime(); ProfileFunctionData(theEnv)->ProfileTotalTime += (ProfileFunctionData(theEnv)->ProfileEndTime - ProfileFunctionData(theEnv)->ProfileStartTime); ProfileFunctionData(theEnv)->ProfileUserFunctions = FALSE; ProfileFunctionData(theEnv)->ProfileConstructs = FALSE; } /*=====================================================*/ /* Otherwise, generate an error since the only allowed */ /* arguments are "on" or "off." */ /*=====================================================*/ else { return(FALSE); } return(TRUE); } /******************************************/ /* ProfileInfoCommand: H/L access routine */ /* for the profile-info command. */ /******************************************/ globle void ProfileInfoCommand( void *theEnv) { int argCount; DATA_OBJECT theValue; char buffer[512]; /*===================================*/ /* The profile-info command expects */ /* at most a single symbol argument. */ /*===================================*/ if ((argCount = EnvArgCountCheck(theEnv,"profile",NO_MORE_THAN,1)) == -1) return; /*===========================================*/ /* The first profile-info argument indicates */ /* the field on which sorting is performed. */ /*===========================================*/ if (argCount == 1) { if (EnvArgTypeCheck(theEnv,"profile",1,SYMBOL,&theValue) == FALSE) return; } /*==================================*/ /* If code is still being profiled, */ /* update the profile end time. */ /*==================================*/ if (ProfileFunctionData(theEnv)->ProfileUserFunctions || ProfileFunctionData(theEnv)->ProfileConstructs) { ProfileFunctionData(theEnv)->ProfileEndTime = gentime(); ProfileFunctionData(theEnv)->ProfileTotalTime += (ProfileFunctionData(theEnv)->ProfileEndTime - ProfileFunctionData(theEnv)->ProfileStartTime); } /*==================================*/ /* Print the profiling information. */ /*==================================*/ if (ProfileFunctionData(theEnv)->LastProfileInfo != NO_PROFILE) { sprintf(buffer,"Profile elapsed time = %g seconds\n", ProfileFunctionData(theEnv)->ProfileTotalTime); EnvPrintRouter(theEnv,WDISPLAY,buffer); if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS) { EnvPrintRouter(theEnv,WDISPLAY,"Function Name "); } else if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE) { EnvPrintRouter(theEnv,WDISPLAY,"Construct Name "); } EnvPrintRouter(theEnv,WDISPLAY,"Entries Time % Time+Kids %+Kids\n"); if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS) { EnvPrintRouter(theEnv,WDISPLAY,"------------- "); } else if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE) { EnvPrintRouter(theEnv,WDISPLAY,"-------------- "); } EnvPrintRouter(theEnv,WDISPLAY,"------- ------ ----- --------- ------\n"); } if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS) OutputUserFunctionsInfo(theEnv); if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE) OutputConstructsCodeInfo(theEnv); } /**********************************************/ /* StartProfile: Initiates bookkeeping needed */ /* to profile a construct or function. */ /**********************************************/ globle void StartProfile( void *theEnv, struct profileFrameInfo *theFrame, struct userData **theList, intBool checkFlag) { double startTime, addTime; struct constructProfileInfo *profileInfo; if (! checkFlag) { theFrame->profileOnExit = FALSE; return; } profileInfo = (struct constructProfileInfo *) FetchUserData(theEnv,ProfileFunctionData(theEnv)->ProfileDataID,theList); theFrame->profileOnExit = TRUE; theFrame->parentCall = FALSE; startTime = gentime(); theFrame->oldProfileFrame = ProfileFunctionData(theEnv)->ActiveProfileFrame; if (ProfileFunctionData(theEnv)->ActiveProfileFrame != NULL) { addTime = startTime - ProfileFunctionData(theEnv)->ActiveProfileFrame->startTime; ProfileFunctionData(theEnv)->ActiveProfileFrame->totalSelfTime += addTime; } ProfileFunctionData(theEnv)->ActiveProfileFrame = profileInfo; ProfileFunctionData(theEnv)->ActiveProfileFrame->numberOfEntries++; ProfileFunctionData(theEnv)->ActiveProfileFrame->startTime = startTime; if (! ProfileFunctionData(theEnv)->ActiveProfileFrame->childCall) { theFrame->parentCall = TRUE; theFrame->parentStartTime = startTime; ProfileFunctionData(theEnv)->ActiveProfileFrame->childCall = TRUE; } } /*******************************************/ /* EndProfile: Finishes bookkeeping needed */ /* to profile a construct or function. */ /*******************************************/ globle void EndProfile( void *theEnv, struct profileFrameInfo *theFrame) { double endTime, addTime; if (! theFrame->profileOnExit) return; endTime = gentime(); if (theFrame->parentCall) { addTime = endTime - theFrame->parentStartTime; ProfileFunctionData(theEnv)->ActiveProfileFrame->totalWithChildrenTime += addTime; ProfileFunctionData(theEnv)->ActiveProfileFrame->childCall = FALSE; } ProfileFunctionData(theEnv)->ActiveProfileFrame->totalSelfTime += (endTime - ProfileFunctionData(theEnv)->ActiveProfileFrame->startTime); if (theFrame->oldProfileFrame != NULL) { theFrame->oldProfileFrame->startTime = endTime; } ProfileFunctionData(theEnv)->ActiveProfileFrame = theFrame->oldProfileFrame; } /******************************************/ /* OutputProfileInfo: Prints out a single */ /* line of profile information. */ /******************************************/ static intBool OutputProfileInfo( void *theEnv, char *itemName, struct constructProfileInfo *profileInfo, char *printPrefixBefore, char *printPrefix, char *printPrefixAfter, char **banner) { double percent = 0.0, percentWithKids = 0.0; char buffer[512]; if (profileInfo == NULL) return(FALSE); if (profileInfo->numberOfEntries == 0) return(FALSE); if (ProfileFunctionData(theEnv)->ProfileTotalTime != 0.0) { percent = (profileInfo->totalSelfTime * 100.0) / ProfileFunctionData(theEnv)->ProfileTotalTime; if (percent < 0.005) percent = 0.0; percentWithKids = (profileInfo->totalWithChildrenTime * 100.0) / ProfileFunctionData(theEnv)->ProfileTotalTime; if (percentWithKids < 0.005) percentWithKids = 0.0; } if (percent < ProfileFunctionData(theEnv)->PercentThreshold) return(FALSE); if ((banner != NULL) && (*banner != NULL)) { EnvPrintRouter(theEnv,WDISPLAY,*banner); *banner = NULL; } if (printPrefixBefore != NULL) { EnvPrintRouter(theEnv,WDISPLAY,printPrefixBefore); } if (printPrefix != NULL) { EnvPrintRouter(theEnv,WDISPLAY,printPrefix); } if (printPrefixAfter != NULL) { EnvPrintRouter(theEnv,WDISPLAY,printPrefixAfter); } if (strlen(itemName) >= 40) { EnvPrintRouter(theEnv,WDISPLAY,itemName); EnvPrintRouter(theEnv,WDISPLAY,"\n"); itemName = ""; } sprintf(buffer,ProfileFunctionData(theEnv)->OutputString, itemName, (long) profileInfo->numberOfEntries, (double) profileInfo->totalSelfTime, (double) percent, (double) profileInfo->totalWithChildrenTime, (double) percentWithKids); EnvPrintRouter(theEnv,WDISPLAY,buffer); return(TRUE); } /*******************************************/ /* ProfileResetCommand: H/L access routine */ /* for the profile-reset command. */ /*******************************************/ globle void ProfileResetCommand( void *theEnv) { struct FunctionDefinition *theFunction; int i; #if DEFFUNCTION_CONSTRUCT DEFFUNCTION *theDeffunction; #endif #if DEFRULE_CONSTRUCT struct defrule *theDefrule; #endif #if DEFGENERIC_CONSTRUCT DEFGENERIC *theDefgeneric; unsigned int methodIndex; DEFMETHOD *theMethod; #endif #if OBJECT_SYSTEM DEFCLASS *theDefclass; HANDLER *theHandler; unsigned handlerIndex; #endif ProfileFunctionData(theEnv)->ProfileStartTime = 0.0; ProfileFunctionData(theEnv)->ProfileEndTime = 0.0; ProfileFunctionData(theEnv)->ProfileTotalTime = 0.0; ProfileFunctionData(theEnv)->LastProfileInfo = NO_PROFILE; for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theFunction->usrData)); } for (i = 0; i < MAXIMUM_PRIMITIVES; i++) { if (EvaluationData(theEnv)->PrimitivesArray[i] != NULL) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,EvaluationData(theEnv)->PrimitivesArray[i]->usrData)); } } #if DEFFUNCTION_CONSTRUCT for (theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); theDeffunction != NULL; theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,theDeffunction)) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDeffunction->header.usrData)); } #endif #if DEFRULE_CONSTRUCT for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefrule->header.usrData)); } #endif #if DEFGENERIC_CONSTRUCT for (theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); theDefgeneric != NULL; theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric)) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefgeneric->header.usrData)); for (methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,0); methodIndex != 0; methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,methodIndex)) { theMethod = GetDefmethodPointer(theDefgeneric,methodIndex); ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theMethod->usrData)); } } #endif #if OBJECT_SYSTEM for (theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL); theDefclass != NULL; theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,theDefclass)) { ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefclass->header.usrData)); for (handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,0); handlerIndex != 0; handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,handlerIndex)) { theHandler = GetDefmessageHandlerPointer(theDefclass,handlerIndex); ResetProfileInfo((struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theHandler->usrData)); } } #endif } /*************************************************/ /* ResetProfileInfo: Sets the initial values for */ /* a constructProfileInfo data structure. */ /*************************************************/ globle void ResetProfileInfo( struct constructProfileInfo *profileInfo) { if (profileInfo == NULL) return; profileInfo->numberOfEntries = 0; profileInfo->childCall = FALSE; profileInfo->startTime = 0.0; profileInfo->totalSelfTime = 0.0; profileInfo->totalWithChildrenTime = 0.0; } /*************************************************/ /* OutputUserFunctionsInfo: */ /*************************************************/ static void OutputUserFunctionsInfo( void *theEnv) { struct FunctionDefinition *theFunction; int i; for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { OutputProfileInfo(theEnv,ValueToString(theFunction->callFunctionName), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, theFunction->usrData), NULL,NULL,NULL,NULL); } for (i = 0; i < MAXIMUM_PRIMITIVES; i++) { if (EvaluationData(theEnv)->PrimitivesArray[i] != NULL) { OutputProfileInfo(theEnv,EvaluationData(theEnv)->PrimitivesArray[i]->name, (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, EvaluationData(theEnv)->PrimitivesArray[i]->usrData), NULL,NULL,NULL,NULL); } } } /*************************************************/ /* OutputConstructsCodeInfo: */ /*************************************************/ #if IBM_TBC && (! DEFFUNCTION_CONSTRUCT) && (! DEFGENERIC_CONSTRUCT) && (! OBJECT_SYSTEM) && (! DEFRULE_CONSTRUCT) #pragma argsused #endif static void OutputConstructsCodeInfo( void *theEnv) { #if (! DEFFUNCTION_CONSTRUCT) && (! DEFGENERIC_CONSTRUCT) && (! OBJECT_SYSTEM) && (! DEFRULE_CONSTRUCT) #pragma unused(theEnv) #endif #if DEFFUNCTION_CONSTRUCT DEFFUNCTION *theDeffunction; #endif #if DEFRULE_CONSTRUCT struct defrule *theDefrule; #endif #if DEFGENERIC_CONSTRUCT DEFGENERIC *theDefgeneric; DEFMETHOD *theMethod; unsigned methodIndex; char methodBuffer[512]; #endif #if OBJECT_SYSTEM DEFCLASS *theDefclass; HANDLER *theHandler; unsigned handlerIndex; #endif #if DEFGENERIC_CONSTRUCT || OBJECT_SYSTEM char *prefix, *prefixBefore, *prefixAfter; #endif char *banner; banner = "\n*** Deffunctions ***\n\n"; #if DEFFUNCTION_CONSTRUCT for (theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); theDeffunction != NULL; theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,theDeffunction)) { OutputProfileInfo(theEnv,EnvGetDeffunctionName(theEnv,theDeffunction), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDeffunction->header.usrData), NULL,NULL,NULL,&banner); } #endif banner = "\n*** Defgenerics ***\n"; #if DEFGENERIC_CONSTRUCT for (theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL); theDefgeneric != NULL; theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric)) { prefixBefore = "\n"; prefix = EnvGetDefgenericName(theEnv,theDefgeneric); prefixAfter = "\n"; for (methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,0); methodIndex != 0; methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,methodIndex)) { theMethod = GetDefmethodPointer(theDefgeneric,methodIndex); EnvGetDefmethodDescription(theEnv,methodBuffer,510,theDefgeneric,methodIndex); if (OutputProfileInfo(theEnv,methodBuffer, (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theMethod->usrData), prefixBefore,prefix,prefixAfter,&banner)) { prefixBefore = NULL; prefix = NULL; prefixAfter = NULL; } } } #endif banner = "\n*** Defclasses ***\n"; #if OBJECT_SYSTEM for (theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL); theDefclass != NULL; theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,theDefclass)) { prefixAfter = "\n"; prefix = EnvGetDefclassName(theEnv,theDefclass); prefixBefore = "\n"; for (handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,0); handlerIndex != 0; handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,handlerIndex)) { theHandler = GetDefmessageHandlerPointer(theDefclass,handlerIndex); if (OutputProfileInfo(theEnv,EnvGetDefmessageHandlerName(theEnv,theDefclass,handlerIndex), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID, theHandler->usrData), prefixBefore,prefix,prefixAfter,&banner)) { prefixBefore = NULL; prefix = NULL; prefixAfter = NULL; } } } #endif banner = "\n*** Defrules ***\n\n"; #if DEFRULE_CONSTRUCT for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { OutputProfileInfo(theEnv,EnvGetDefruleName(theEnv,theDefrule), (struct constructProfileInfo *) TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefrule->header.usrData), NULL,NULL,NULL,&banner); } #endif } /*********************************************************/ /* SetProfilePercentThresholdCommand: H/L access routine */ /* for the set-profile-percent-threshold command. */ /*********************************************************/ globle double SetProfilePercentThresholdCommand( void *theEnv) { DATA_OBJECT theValue; double newThreshold; if (EnvArgCountCheck(theEnv,"set-profile-percent-threshold",EXACTLY,1) == -1) { return(ProfileFunctionData(theEnv)->PercentThreshold); } if (EnvArgTypeCheck(theEnv,"set-profile-percent-threshold",1,INTEGER_OR_FLOAT,&theValue) == FALSE) { return(ProfileFunctionData(theEnv)->PercentThreshold); } if (GetType(theValue) == INTEGER) { newThreshold = (double) DOToLong(theValue); } else { newThreshold = (double) DOToDouble(theValue); } if ((newThreshold < 0.0) || (newThreshold > 100.0)) { ExpectedTypeError1(theEnv,"set-profile-percent-threshold",1, "number in the range 0 to 100"); return(-1.0); } return(SetProfilePercentThreshold(theEnv,newThreshold)); } /****************************************************/ /* SetProfilePercentThreshold: C access routine for */ /* the set-profile-percent-threshold command. */ /****************************************************/ globle double SetProfilePercentThreshold( void *theEnv, double value) { double oldPercentThreshhold; if ((value < 0.0) || (value > 100.0)) { return(-1.0); } oldPercentThreshhold = ProfileFunctionData(theEnv)->PercentThreshold; ProfileFunctionData(theEnv)->PercentThreshold = value; return(oldPercentThreshhold); } /*********************************************************/ /* GetProfilePercentThresholdCommand: H/L access routine */ /* for the get-profile-percent-threshold command. */ /*********************************************************/ globle double GetProfilePercentThresholdCommand( void *theEnv) { EnvArgCountCheck(theEnv,"get-profile-percent-threshold",EXACTLY,0); return(ProfileFunctionData(theEnv)->PercentThreshold); } /****************************************************/ /* GetProfilePercentThreshold: C access routine for */ /* the get-profile-percent-threshold command. */ /****************************************************/ globle double GetProfilePercentThreshold( void *theEnv) { return(ProfileFunctionData(theEnv)->PercentThreshold); } /**********************************************************/ /* SetProfileOutputString: Sets the output string global. */ /**********************************************************/ globle char *SetProfileOutputString( void *theEnv, char *value) { char *oldOutputString; if (value == NULL) { return(ProfileFunctionData(theEnv)->OutputString); } oldOutputString = ProfileFunctionData(theEnv)->OutputString; ProfileFunctionData(theEnv)->OutputString = value; return(oldOutputString); } #if (! RUN_TIME) /******************************************************************/ /* ProfileClearFunction: Profiling clear routine for use with the */ /* clear command. Removes user data attached to user functions. */ /******************************************************************/ static void ProfileClearFunction( void *theEnv) { struct FunctionDefinition *theFunction; int i; for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { theFunction->usrData = DeleteUserData(theEnv,ProfileFunctionData(theEnv)->ProfileDataID,theFunction->usrData); } for (i = 0; i < MAXIMUM_PRIMITIVES; i++) { if (EvaluationData(theEnv)->PrimitivesArray[i] != NULL) { EvaluationData(theEnv)->PrimitivesArray[i]->usrData = DeleteUserData(theEnv,ProfileFunctionData(theEnv)->ProfileDataID,EvaluationData(theEnv)->PrimitivesArray[i]->usrData); } } } #endif #endif /* PROFILING_FUNCTIONS */ clips-6.24/clipssrc/._watch.h0000400000175000017500000000075410443631632014221 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco00llTTFH8,FMWBBMPSRclips-6.24/clipssrc/._cmptblty.h0000400000175000017500000000012207422634640014743 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._filertr.c0000400000175000017500000000075410441602212014543 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaconx+nx+SR,,TTFL+FMPSRMWBBLclips-6.24/clipssrc/conscomp.h0000755000175000017500000001036710441131317014526 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_conscomp #define _H_conscomp #define ArbitraryPrefix(codeItem,i) (codeItem)->arrayNames[(i)] #define ModulePrefix(codeItem) (codeItem)->arrayNames[0] #define ConstructPrefix(codeItem) (codeItem)->arrayNames[1] #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_extnfunc #include "extnfunc.h" #endif #ifndef _H_symblcmp #include "symblcmp.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #define CONSTRUCT_COMPILER_DATA 41 struct CodeGeneratorItem { char *name; void (*beforeFunction)(void *); void (*initFunction)(void *,FILE *,int,int); int (*generateFunction)(void *,char *,int,FILE *,int,int); int priority; char **arrayNames; int arrayCount; struct CodeGeneratorItem *next; }; struct constructCompilerData { int ImageID; FILE *HeaderFP; int MaxIndices; FILE *ExpressionFP; FILE *FixupFP; char *FilePrefix; intBool ExpressionHeader; long ExpressionCount; int ExpressionVersion; int CodeGeneratorCount; struct CodeGeneratorItem *ListOfCodeGeneratorItems; }; #define ConstructCompilerData(theEnv) ((struct constructCompilerData *) GetEnvironmentData(theEnv,CONSTRUCT_COMPILER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif struct CodeGeneratorFile { char *filePrefix; int id,version; }; #ifdef _CONSCOMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeConstructCompilerData(void *); LOCALE void ConstructsToCCommandDefinition(void *); LOCALE FILE *NewCFile(void *,char *,int,int,int); LOCALE int ExpressionToCode(void *,FILE *,struct expr *); LOCALE void PrintFunctionReference(void *,FILE *,struct FunctionDefinition *); LOCALE struct CodeGeneratorItem *AddCodeGeneratorItem(void *,char *,int, void (*)(void *), void (*)(void *,FILE *,int,int), int (*)(void *,char *,int,FILE *,int,int),int); LOCALE FILE *CloseFileIfNeeded(void *,FILE *,int *,int *,int,int *,struct CodeGeneratorFile *); LOCALE FILE *OpenFileIfNeeded(void *,FILE *,char *,int,int,int *,int,FILE *, char *,char *,int,struct CodeGeneratorFile *); LOCALE void MarkConstructBsaveIDs(void *,int); LOCALE void ConstructHeaderToCode(void *,FILE *,struct constructHeader *,int,int, int,char *,char *); LOCALE void ConstructModuleToCode(void *,FILE *,struct defmodule *,int,int, int,char *); LOCALE void PrintHashedExpressionReference(void *,FILE *,struct expr *,int,int); #endif clips-6.24/clipssrc/._rulebsc.c0000400000175000017500000000075410441150727014544 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0z0z<,,TTFS FMWBBMPSRclips-6.24/clipssrc/._scanner.h0000400000175000017500000000012207422634745014544 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/exprnops.c0000755000175000017500000004403210441132020014542 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EXPRESSION OPERATIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides utility routines for manipulating and */ /* examining expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _EXPRNOPS_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include "memalloc.h" #include "envrnmnt.h" #include "router.h" #include "extnfunc.h" #include "cstrnchk.h" #include "prntutil.h" #include "cstrnutl.h" #include "cstrnops.h" #include "exprnops.h" #if (! RUN_TIME) /**************************************************************/ /* CheckArgumentAgainstRestriction: Compares an argument to a */ /* function to the set of restrictions for that function to */ /* determine if any incompatibilities exist. If so, the */ /* value TRUE is returned, otherwise FALSE is returned. */ /* Restrictions checked are: */ /* a - external address */ /* d - float */ /* e - instance address, instance name, or symbol */ /* f - float */ /* g - integer, float, or symbol */ /* h - instance address, instance name, fact address, */ /* integer, or symbol */ /* i - integer */ /* j - symbol, string, or instance name */ /* k - symbol or string */ /* l - integer */ /* m - multifield */ /* n - float or integer */ /* o - instance name */ /* p - instance name or symbol */ /* q - string, symbol, or multifield */ /* s - string */ /* u - unknown (any type allowed) */ /* w - symbol */ /* x - instance address */ /* y - fact address */ /* z - fact address, integer, or symbol (*) */ /**************************************************************/ globle int CheckArgumentAgainstRestriction( void *theEnv, struct expr *theExpression, int theRestriction) { CONSTRAINT_RECORD *cr1, *cr2, *cr3; /*=============================================*/ /* Generate a constraint record for the actual */ /* argument passed to the function. */ /*=============================================*/ cr1 = ExpressionToConstraintRecord(theEnv,theExpression); /*================================================*/ /* Generate a constraint record based on the type */ /* of argument expected by the function. */ /*================================================*/ cr2 = ArgumentTypeToConstraintRecord(theEnv,theRestriction); /*===============================================*/ /* Intersect the two constraint records and then */ /* discard them. */ /*===============================================*/ cr3 = IntersectConstraints(theEnv,cr1,cr2); RemoveConstraint(theEnv,cr1); RemoveConstraint(theEnv,cr2); /*====================================================*/ /* If the intersection of the two constraint records */ /* is empty, then the argument passed to the function */ /* doesn't satisfy the restrictions for the argument. */ /*====================================================*/ if (UnmatchableConstraint(cr3)) { RemoveConstraint(theEnv,cr3); return(TRUE); } /*===================================================*/ /* The argument satisfies the function restrictions. */ /*===================================================*/ RemoveConstraint(theEnv,cr3); return(FALSE); } #endif /* (! RUN_TIME) */ /************************************************************/ /* ConstantExpression: Returns TRUE if the expression */ /* is a constant, otherwise FALSE. */ /************************************************************/ globle intBool ConstantExpression( struct expr *testPtr) { while (testPtr != NULL) { if ((testPtr->type != SYMBOL) && (testPtr->type != STRING) && #if OBJECT_SYSTEM (testPtr->type != INSTANCE_NAME) && (testPtr->type != INSTANCE_ADDRESS) && #endif (testPtr->type != INTEGER) && (testPtr->type != FLOAT)) { return(FALSE); } testPtr = testPtr->nextArg; } return(TRUE); } /************************************************/ /* ConstantType: Returns TRUE if the type */ /* is a constant, otherwise FALSE. */ /************************************************/ globle intBool ConstantType( int theType) { switch (theType) { case SYMBOL: case STRING: case INTEGER: case FLOAT: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif return(TRUE); } return(FALSE); } /*****************************************************************************/ /* IdenticalExpression: Determines if two expressions are identical. Returns */ /* TRUE if the expressions are identical, otherwise FALSE is returned. */ /*****************************************************************************/ globle intBool IdenticalExpression( struct expr *firstList, struct expr *secondList) { /*==============================================*/ /* Compare each argument in both expressions by */ /* following the nextArg list. */ /*==============================================*/ for (; (firstList != NULL) && (secondList != NULL); firstList = firstList->nextArg, secondList = secondList->nextArg) { /*=========================*/ /* Compare type and value. */ /*=========================*/ if (firstList->type != secondList->type) { return(FALSE); } if (firstList->value != secondList->value) { return (FALSE); } /*==============================*/ /* Compare the arguments lists. */ /*==============================*/ if (IdenticalExpression(firstList->argList,secondList->argList) == FALSE) { return(FALSE); } } /*=====================================================*/ /* If firstList and secondList aren't both NULL, then */ /* one of the lists contains more expressions than the */ /* other. */ /*=====================================================*/ if (firstList != secondList) return(FALSE); /*============================*/ /* Expressions are identical. */ /*============================*/ return(TRUE); } /****************************************************/ /* CountArguments: Returns the number of structures */ /* stored in an expression as traversed through */ /* the nextArg pointer but not the argList */ /* pointer. */ /****************************************************/ globle int CountArguments( struct expr *testPtr) { int size = 0; while (testPtr != NULL) { size++; testPtr = testPtr->nextArg; } return(size); } /******************************************/ /* CopyExpresssion: Copies an expression. */ /******************************************/ globle struct expr *CopyExpression( void *theEnv, struct expr *original) { struct expr *topLevel, *next, *last; if (original == NULL) return(NULL); topLevel = GenConstant(theEnv,original->type,original->value); topLevel->argList = CopyExpression(theEnv,original->argList); last = topLevel; original = original->nextArg; while (original != NULL) { next = GenConstant(theEnv,original->type,original->value); next->argList = CopyExpression(theEnv,original->argList); last->nextArg = next; last = next; original = original->nextArg; } return(topLevel); } /************************************************************/ /* ExpressionContainsVariables: Determines if an expression */ /* contains any variables. Returns TRUE if the expression */ /* contains any variables, otherwise FALSE is returned. */ /************************************************************/ globle intBool ExpressionContainsVariables( struct expr *theExpression, intBool globalsAreVariables) { while (theExpression != NULL) { if (theExpression->argList != NULL) { if (ExpressionContainsVariables(theExpression->argList,globalsAreVariables)) { return(TRUE); } } if ((theExpression->type == MF_VARIABLE) || (theExpression->type == SF_VARIABLE) || (theExpression->type == FACT_ADDRESS) || (((theExpression->type == GBL_VARIABLE) || (theExpression->type == MF_GBL_VARIABLE)) && (globalsAreVariables == TRUE))) { return(TRUE); } theExpression = theExpression->nextArg; } return(FALSE); } /*****************************************/ /* ExpressionSize: Returns the number of */ /* structures stored in an expression. */ /*****************************************/ globle long ExpressionSize( struct expr *testPtr) { long size = 0; while (testPtr != NULL) { size++; if (testPtr->argList != NULL) { size += ExpressionSize(testPtr->argList); } testPtr = testPtr->nextArg; } return(size); } /************************************************/ /* GenConstant: Generates a constant expression */ /* value of type string, symbol, or number. */ /************************************************/ globle struct expr *GenConstant( void *theEnv, unsigned short type, void *value) { struct expr *top; top = get_struct(theEnv,expr); top->nextArg = NULL; top->argList = NULL; top->type = type; top->value = value; return(top); } /*************************************************/ /* PrintExpression: Pretty prints an expression. */ /*************************************************/ globle void PrintExpression( void *theEnv, char *fileid, struct expr *theExpression) { struct expr *oldExpression; if (theExpression == NULL) { return; } while (theExpression != NULL) { switch (theExpression->type) { case SF_VARIABLE: case GBL_VARIABLE: EnvPrintRouter(theEnv,fileid,"?"); EnvPrintRouter(theEnv,fileid,ValueToString(theExpression->value)); break; case MF_VARIABLE: case MF_GBL_VARIABLE: EnvPrintRouter(theEnv,fileid,"$?"); EnvPrintRouter(theEnv,fileid,ValueToString(theExpression->value)); break; case FCALL: EnvPrintRouter(theEnv,fileid,"("); EnvPrintRouter(theEnv,fileid,ValueToString(ExpressionFunctionCallName(theExpression))); if (theExpression->argList != NULL) { EnvPrintRouter(theEnv,fileid," "); } PrintExpression(theEnv,fileid,theExpression->argList); EnvPrintRouter(theEnv,fileid,")"); break; default: oldExpression = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = theExpression; PrintAtom(theEnv,fileid,theExpression->type,theExpression->value); EvaluationData(theEnv)->CurrentExpression = oldExpression; break; } theExpression = theExpression->nextArg; if (theExpression != NULL) EnvPrintRouter(theEnv,fileid," "); } return; } /*************************************************************************/ /* CombineExpressions: Combines two expressions into a single equivalent */ /* expression. Mainly serves to merge expressions containing "and" */ /* and "or" expressions without unnecessary duplication of the "and" */ /* and "or" expressions (i.e., two "and" expressions can be merged by */ /* placing them as arguments within another "and" expression, but it */ /* is more efficient to add the arguments of one of the "and" */ /* expressions to the list of arguments for the other and expression). */ /*************************************************************************/ globle struct expr *CombineExpressions( void *theEnv, struct expr *expr1, struct expr *expr2) { struct expr *tempPtr; /*===========================================================*/ /* If the 1st expression is NULL, return the 2nd expression. */ /*===========================================================*/ if (expr1 == NULL) return(expr2); /*===========================================================*/ /* If the 2nd expression is NULL, return the 1st expression. */ /*===========================================================*/ if (expr2 == NULL) return(expr1); /*============================================================*/ /* If the 1st expression is an "and" expression, and the 2nd */ /* expression is not an "and" expression, then include the */ /* 2nd expression in the argument list of the 1st expression. */ /*============================================================*/ if ((expr1->value == ExpressionData(theEnv)->PTR_AND) && (expr2->value != ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr1->argList; if (tempPtr == NULL) { rtn_struct(theEnv,expr,expr1); return(expr2); } while (tempPtr->nextArg != NULL) { tempPtr = tempPtr->nextArg; } tempPtr->nextArg = expr2; return(expr1); } /*============================================================*/ /* If the 2nd expression is an "and" expression, and the 1st */ /* expression is not an "and" expression, then include the */ /* 1st expression in the argument list of the 2nd expression. */ /*============================================================*/ if ((expr1->value != ExpressionData(theEnv)->PTR_AND) && (expr2->value == ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr2->argList; if (tempPtr == NULL) { rtn_struct(theEnv,expr,expr2); return(expr1); } expr2->argList = expr1; expr1->nextArg = tempPtr; return(expr2); } /*===========================================================*/ /* If both expressions are "and" expressions, then add the */ /* 2nd expression to the argument list of the 1st expression */ /* and throw away the extraneous "and" expression. */ /*===========================================================*/ if ((expr1->value == ExpressionData(theEnv)->PTR_AND) && (expr2->value == ExpressionData(theEnv)->PTR_AND)) { tempPtr = expr1->argList; if (tempPtr == NULL) { rtn_struct(theEnv,expr,expr1); return(expr2); } while (tempPtr->nextArg != NULL) { tempPtr = tempPtr->nextArg; } tempPtr->nextArg = expr2->argList; rtn_struct(theEnv,expr,expr2); return(expr1); } /*=====================================================*/ /* If neither expression is an "and" expression, then */ /* create an "and" expression and add both expressions */ /* to the argument list of that "and" expression. */ /*=====================================================*/ tempPtr = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_AND); tempPtr->argList = expr1; expr1->nextArg = expr2; return(tempPtr); } /********************************************************/ /* AppendExpressions: Attaches an expression to the end */ /* of another expression's nextArg list. */ /********************************************************/ globle struct expr *AppendExpressions( struct expr *expr1, struct expr *expr2) { struct expr *tempPtr; /*===========================================================*/ /* If the 1st expression is NULL, return the 2nd expression. */ /*===========================================================*/ if (expr1 == NULL) return(expr2); /*===========================================================*/ /* If the 2nd expression is NULL, return the 1st expression. */ /*===========================================================*/ if (expr2 == NULL) return(expr1); /*====================================*/ /* Find the end of the 1st expression */ /* and attach the 2nd expression. */ /*====================================*/ tempPtr = expr1; while (tempPtr->nextArg != NULL) tempPtr = tempPtr->nextArg; tempPtr->nextArg = expr2; /*===============================*/ /* Return the merged expression. */ /*===============================*/ return(expr1); } clips-6.24/clipssrc/cstrnchk.c0000755000175000017500000007226610441131446014530 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT CHECKING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for constraint checking of */ /* data types. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Donnell */ /* */ /* Revision History: */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _CSTRNCHK_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "router.h" #include "multifld.h" #include "envrnmnt.h" #include "extnfunc.h" #include "cstrnutl.h" #if OBJECT_SYSTEM #include "inscom.h" #include "insfun.h" #include "classcom.h" #include "classexm.h" #endif #include "cstrnchk.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static intBool CheckRangeAgainstCardinalityConstraint(void *,int,int,CONSTRAINT_RECORD *); static int CheckFunctionReturnType(int,CONSTRAINT_RECORD *); static intBool CheckTypeConstraint(int,CONSTRAINT_RECORD *); static intBool CheckRangeConstraint(void *,int,void *,CONSTRAINT_RECORD *); static void PrintRange(void *,char *,CONSTRAINT_RECORD *); /******************************************************/ /* CheckFunctionReturnType: Checks a functions return */ /* type against a set of permissable return values. */ /* Returns TRUE if the return type is included */ /* among the permissible values, otherwise FALSE. */ /******************************************************/ static int CheckFunctionReturnType( int functionReturnType, CONSTRAINT_RECORD *constraints) { if (constraints == NULL) return(TRUE); if (constraints->anyAllowed) return(TRUE); switch(functionReturnType) { case 'c': case 'w': case 'b': if (constraints->symbolsAllowed) return(TRUE); else return(FALSE); case 's': if (constraints->stringsAllowed) return(TRUE); else return(FALSE); case 'j': if ((constraints->symbolsAllowed) || (constraints->stringsAllowed) || (constraints->instanceNamesAllowed)) return(TRUE); else return(FALSE); case 'k': if ((constraints->symbolsAllowed) || (constraints->stringsAllowed)) return(TRUE); else return(FALSE); case 'd': case 'f': if (constraints->floatsAllowed) return(TRUE); else return(FALSE); case 'i': case 'l': if (constraints->integersAllowed) return(TRUE); else return(FALSE); case 'n': if ((constraints->integersAllowed) || (constraints->floatsAllowed)) return(TRUE); else return(FALSE); case 'm': if (constraints->multifieldsAllowed) return(TRUE); else return(FALSE); case 'a': if (constraints->externalAddressesAllowed) return(TRUE); else return(FALSE); case 'x': if (constraints->instanceAddressesAllowed) return(TRUE); else return(FALSE); case 'o': if (constraints->instanceNamesAllowed) return(TRUE); else return(FALSE); case 'u': return(TRUE); case 'v': if (constraints->voidAllowed) return(TRUE); } return(TRUE); } /****************************************************/ /* CheckTypeConstraint: Determines if a primitive */ /* data type satisfies the type constraint fields */ /* of aconstraint record. */ /****************************************************/ static intBool CheckTypeConstraint( int type, CONSTRAINT_RECORD *constraints) { if (type == RVOID) return(FALSE); if (constraints == NULL) return(TRUE); if (constraints->anyAllowed == TRUE) return(TRUE); if ((type == SYMBOL) && (constraints->symbolsAllowed != TRUE)) { return(FALSE); } if ((type == STRING) && (constraints->stringsAllowed != TRUE)) { return(FALSE); } if ((type == FLOAT) && (constraints->floatsAllowed != TRUE)) { return(FALSE); } if ((type == INTEGER) && (constraints->integersAllowed != TRUE)) { return(FALSE); } #if OBJECT_SYSTEM if ((type == INSTANCE_NAME) && (constraints->instanceNamesAllowed != TRUE)) { return(FALSE); } if ((type == INSTANCE_ADDRESS) && (constraints->instanceAddressesAllowed != TRUE)) { return(FALSE); } #endif if ((type == EXTERNAL_ADDRESS) && (constraints->externalAddressesAllowed != TRUE)) { return(FALSE); } if ((type == RVOID) && (constraints->voidAllowed != TRUE)) { return(FALSE); } if ((type == FACT_ADDRESS) && (constraints->factAddressesAllowed != TRUE)) { return(FALSE); } return(TRUE); } /********************************************************/ /* CheckCardinalityConstraint: Determines if an integer */ /* falls within the range of allowed cardinalities */ /* for a constraint record. */ /********************************************************/ globle intBool CheckCardinalityConstraint( void *theEnv, long number, CONSTRAINT_RECORD *constraints) { /*=========================================*/ /* If the constraint record is NULL, there */ /* are no cardinality restrictions. */ /*=========================================*/ if (constraints == NULL) return(TRUE); /*==================================*/ /* Determine if the integer is less */ /* than the minimum cardinality. */ /*==================================*/ if (constraints->minFields != NULL) { if (constraints->minFields->value != SymbolData(theEnv)->NegativeInfinity) { if (number < ValueToLong(constraints->minFields->value)) { return(FALSE); } } } /*=====================================*/ /* Determine if the integer is greater */ /* than the maximum cardinality. */ /*=====================================*/ if (constraints->maxFields != NULL) { if (constraints->maxFields->value != SymbolData(theEnv)->PositiveInfinity) { if (number > ValueToLong(constraints->maxFields->value)) { return(FALSE); } } } /*=========================================================*/ /* The integer falls within the allowed cardinality range. */ /*=========================================================*/ return(TRUE); } /*****************************************************************/ /* CheckRangeAgainstCardinalityConstraint: Determines if a range */ /* of numbers could possibly fall within the range of allowed */ /* cardinalities for a constraint record. Returns TRUE if at */ /* least one of the numbers in the range is within the allowed */ /* cardinality, otherwise FALSE is returned. */ /*****************************************************************/ static intBool CheckRangeAgainstCardinalityConstraint( void *theEnv, int min, int max, CONSTRAINT_RECORD *constraints) { /*=========================================*/ /* If the constraint record is NULL, there */ /* are no cardinality restrictions. */ /*=========================================*/ if (constraints == NULL) return(TRUE); /*===============================================================*/ /* If the minimum value of the range is greater than the maximum */ /* value of the cardinality, then there are no numbers in the */ /* range which could fall within the cardinality range, and so */ /* FALSE is returned. */ /*===============================================================*/ if (constraints->maxFields != NULL) { if (constraints->maxFields->value != SymbolData(theEnv)->PositiveInfinity) { if (min > ValueToLong(constraints->maxFields->value)) { return(FALSE); } } } /*===============================================================*/ /* If the maximum value of the range is less than the minimum */ /* value of the cardinality, then there are no numbers in the */ /* range which could fall within the cardinality range, and so */ /* FALSE is returned. A maximum range value of -1 indicates that */ /* the maximum possible value of the range is positive infinity. */ /*===============================================================*/ if ((constraints->minFields != NULL) && (max != -1)) { if (constraints->minFields->value != SymbolData(theEnv)->NegativeInfinity) { if (max < ValueToLong(constraints->minFields->value)) { return(FALSE); } } } /*=============================================*/ /* At least one number in the specified range */ /* falls within the allowed cardinality range. */ /*=============================================*/ return(TRUE); } /**********************************************************************/ /* CheckAllowedValuesConstraint: Determines if a primitive data type */ /* satisfies the allowed-... constraint fields of a constraint */ /* record. Returns TRUE if the constraints are satisfied, otherwise */ /* FALSE is returned. */ /**********************************************************************/ globle intBool CheckAllowedValuesConstraint( int type, void *vPtr, CONSTRAINT_RECORD *constraints) { struct expr *tmpPtr; /*=========================================*/ /* If the constraint record is NULL, there */ /* are no allowed-... restrictions. */ /*=========================================*/ if (constraints == NULL) return(TRUE); /*=====================================================*/ /* Determine if there are any allowed-... restrictions */ /* for the type of the value being checked. */ /*=====================================================*/ switch (type) { case SYMBOL: if ((constraints->symbolRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; #if OBJECT_SYSTEM case INSTANCE_NAME: if ((constraints->instanceNameRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; #endif case STRING: if ((constraints->stringRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; case INTEGER: if ((constraints->integerRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; case FLOAT: if ((constraints->floatRestriction == FALSE) && (constraints->anyRestriction == FALSE)) { return(TRUE); } break; default: return(TRUE); } /*=========================================================*/ /* Search through the restriction list to see if the value */ /* matches one of the allowed values in the list. */ /*=========================================================*/ for (tmpPtr = constraints->restrictionList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { if ((tmpPtr->type == type) && (tmpPtr->value == vPtr)) return(TRUE); } /*====================================================*/ /* If the value wasn't found in the list, then return */ /* FALSE because the constraint has been violated. */ /*====================================================*/ return(FALSE); } /**********************************************************************/ /* CheckAllowedClassesConstraint: Determines if a primitive data type */ /* satisfies the allowed-classes constraint fields of a constraint */ /* record. Returns TRUE if the constraints are satisfied, otherwise */ /* FALSE is returned. */ /**********************************************************************/ globle intBool CheckAllowedClassesConstraint( void *theEnv, int type, void *vPtr, CONSTRAINT_RECORD *constraints) { #if OBJECT_SYSTEM struct expr *tmpPtr; INSTANCE_TYPE *ins; DEFCLASS *insClass, *cmpClass; /*=========================================*/ /* If the constraint record is NULL, there */ /* is no allowed-classes restriction. */ /*=========================================*/ if (constraints == NULL) return(TRUE); /*======================================*/ /* The constraint is satisfied if there */ /* aren't any class restrictions. */ /*======================================*/ if (constraints->classList == NULL) { return(TRUE); } /*==================================*/ /* Class restrictions only apply to */ /* instances and instance names. */ /*==================================*/ if ((type != INSTANCE_ADDRESS) && (type != INSTANCE_NAME)) { return(TRUE); } /*=============================================*/ /* If an instance name is specified, determine */ /* whether the instance exists. */ /*=============================================*/ if (type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) vPtr; } else { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) vPtr); } if (ins == NULL) { return(FALSE); } /*======================================================*/ /* Search through the class list to see if the instance */ /* belongs to one of the allowed classes in the list. */ /*======================================================*/ insClass = (DEFCLASS *) EnvGetInstanceClass(theEnv,ins); for (tmpPtr = constraints->classList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg) { cmpClass = (DEFCLASS *) EnvFindDefclass(theEnv,ValueToString(tmpPtr->value)); if (cmpClass == NULL) continue; if (cmpClass == insClass) return(TRUE); if (EnvSubclassP(theEnv,insClass,cmpClass)) return(TRUE); } /*=========================================================*/ /* If a parent class wasn't found in the list, then return */ /* FALSE because the constraint has been violated. */ /*=========================================================*/ return(FALSE); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(type) #pragma unused(vPtr) #pragma unused(constraints) #endif return(TRUE); #endif } /*************************************************************/ /* CheckRangeConstraint: Determines if a primitive data type */ /* satisfies the range constraint of a constraint record. */ /*************************************************************/ static intBool CheckRangeConstraint( void *theEnv, int type, void *vPtr, CONSTRAINT_RECORD *constraints) { struct expr *minList, *maxList; /*===================================*/ /* If the constraint record is NULL, */ /* there are no range restrictions. */ /*===================================*/ if (constraints == NULL) return(TRUE); /*============================================*/ /* If the value being checked isn't a number, */ /* then the range restrictions don't apply. */ /*============================================*/ if ((type != INTEGER) && (type != FLOAT)) return(TRUE); /*=====================================================*/ /* Check each of the range restrictions to see if the */ /* number falls within at least one of the allowed */ /* ranges. If it falls within one of the ranges, then */ /* return TRUE since the constraint is satisifed. */ /*=====================================================*/ minList = constraints->minValue; maxList = constraints->maxValue; while (minList != NULL) { if (CompareNumbers(theEnv,type,vPtr,minList->type,minList->value) == LESS_THAN) { minList = minList->nextArg; maxList = maxList->nextArg; } else if (CompareNumbers(theEnv,type,vPtr,maxList->type,maxList->value) == GREATER_THAN) { minList = minList->nextArg; maxList = maxList->nextArg; } else { return(TRUE); } } /*===========================================*/ /* Return FALSE since the number didn't fall */ /* within one of the allowed numeric ranges. */ /*===========================================*/ return(FALSE); } /************************************************/ /* ConstraintViolationErrorMessage: Generalized */ /* error message for constraint violations. */ /************************************************/ globle void ConstraintViolationErrorMessage( void *theEnv, char *theWhat, char *thePlace, int command, int thePattern, struct symbolHashNode *theSlot, int theField, int violationType, CONSTRAINT_RECORD *theConstraint, int printPrelude) { /*======================================================*/ /* Don't print anything other than the tail explanation */ /* of the error unless asked to do so. */ /*======================================================*/ if (printPrelude) { /*===================================*/ /* Print the name of the thing which */ /* caused the constraint violation. */ /*===================================*/ if (violationType == FUNCTION_RETURN_TYPE_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The function return value "); } else if (theWhat != NULL) { PrintErrorID(theEnv,"CSTRNCHK",1,TRUE); EnvPrintRouter(theEnv,WERROR,theWhat); EnvPrintRouter(theEnv,WERROR," "); } /*=======================================*/ /* Print the location of the thing which */ /* caused the constraint violation. */ /*=======================================*/ if (thePlace != NULL) { EnvPrintRouter(theEnv,WERROR,"found in "); if (command) EnvPrintRouter(theEnv,WERROR,"the "); EnvPrintRouter(theEnv,WERROR,thePlace); if (command) EnvPrintRouter(theEnv,WERROR," command"); } /*================================================*/ /* If the violation occured in the LHS of a rule, */ /* indicate which pattern was at fault. */ /*================================================*/ if (thePattern > 0) { EnvPrintRouter(theEnv,WERROR,"found in CE #"); PrintLongInteger(theEnv,WERROR,(long int) thePattern); } } /*===============================================================*/ /* Indicate the type of constraint violation (type, range, etc). */ /*===============================================================*/ if ((violationType == TYPE_VIOLATION) || (violationType == FUNCTION_RETURN_TYPE_VIOLATION)) { EnvPrintRouter(theEnv,WERROR,"\ndoes not match the allowed types"); } else if (violationType == RANGE_VIOLATION) { EnvPrintRouter(theEnv,WERROR,"\ndoes not fall in the allowed range "); PrintRange(theEnv,WERROR,theConstraint); } else if (violationType == ALLOWED_VALUES_VIOLATION) { EnvPrintRouter(theEnv,WERROR,"\ndoes not match the allowed values"); } else if (violationType == CARDINALITY_VIOLATION) { EnvPrintRouter(theEnv,WERROR,"\ndoes not satisfy the cardinality restrictions"); } else if (violationType == ALLOWED_CLASSES_VIOLATION) { EnvPrintRouter(theEnv,WERROR,"\ndoes not match the allowed classes"); } /*==============================================*/ /* Print either the slot name or field position */ /* where the constraint violation occured. */ /*==============================================*/ if (theSlot != NULL) { EnvPrintRouter(theEnv,WERROR," for slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(theSlot)); } else if (theField > 0) { EnvPrintRouter(theEnv,WERROR," for field #"); PrintLongInteger(theEnv,WERROR,(long) theField); } EnvPrintRouter(theEnv,WERROR,".\n"); } /********************************************************************/ /* PrintRange: Prints the range restriction of a constraint record. */ /* For example, 8 to +00 (eight to positive infinity). */ /********************************************************************/ static void PrintRange( void *theEnv, char *logicalName, CONSTRAINT_RECORD *theConstraint) { if (theConstraint->minValue->value == SymbolData(theEnv)->NegativeInfinity) { EnvPrintRouter(theEnv,logicalName,ValueToString(SymbolData(theEnv)->NegativeInfinity)); } else PrintExpression(theEnv,logicalName,theConstraint->minValue); EnvPrintRouter(theEnv,logicalName," to "); if (theConstraint->maxValue->value == SymbolData(theEnv)->PositiveInfinity) { EnvPrintRouter(theEnv,logicalName,ValueToString(SymbolData(theEnv)->PositiveInfinity)); } else PrintExpression(theEnv,logicalName,theConstraint->maxValue); } /*************************************************************/ /* ConstraintCheckDataObject: Given a value stored in a data */ /* object structure and a constraint record, determines if */ /* the data object satisfies the constraint record. */ /*************************************************************/ globle int ConstraintCheckDataObject( void *theEnv, DATA_OBJECT *theData, CONSTRAINT_RECORD *theConstraints) { long i; /* 6.04 Bug Fix */ int rv; struct field *theMultifield; if (theConstraints == NULL) return(NO_VIOLATION); if (theData->type == MULTIFIELD) { if (CheckCardinalityConstraint(theEnv,(theData->end - theData->begin) + 1, theConstraints) == FALSE) { return(CARDINALITY_VIOLATION); } theMultifield = ((struct multifield *) theData->value)->theFields; for (i = theData->begin; i <= theData->end; i++) { if ((rv = ConstraintCheckValue(theEnv,theMultifield[i].type, theMultifield[i].value, theConstraints)) != NO_VIOLATION) { return(rv); } } return(NO_VIOLATION); } if (CheckCardinalityConstraint(theEnv,1L,theConstraints) == FALSE) { return(CARDINALITY_VIOLATION); } return(ConstraintCheckValue(theEnv,theData->type,theData->value,theConstraints)); } /****************************************************************/ /* ConstraintCheckValue: Given a value and a constraint record, */ /* determines if the value satisfies the constraint record. */ /****************************************************************/ globle int ConstraintCheckValue( void *theEnv, int theType, void *theValue, CONSTRAINT_RECORD *theConstraints) { if (CheckTypeConstraint(theType,theConstraints) == FALSE) { return(TYPE_VIOLATION); } else if (CheckAllowedValuesConstraint(theType,theValue,theConstraints) == FALSE) { return(ALLOWED_VALUES_VIOLATION); } else if (CheckAllowedClassesConstraint(theEnv,theType,theValue,theConstraints) == FALSE) { return(ALLOWED_CLASSES_VIOLATION); } else if (CheckRangeConstraint(theEnv,theType,theValue,theConstraints) == FALSE) { return(RANGE_VIOLATION); } else if (theType == FCALL) { if (CheckFunctionReturnType((int) ValueFunctionType(theValue),theConstraints) == FALSE) { return(FUNCTION_RETURN_TYPE_VIOLATION); } } return(NO_VIOLATION); } /********************************************************************/ /* ConstraintCheckExpressionChain: Checks an expression and nextArg */ /* links for constraint conflicts (argList is not followed). */ /********************************************************************/ globle int ConstraintCheckExpressionChain( void *theEnv, struct expr *theExpression, CONSTRAINT_RECORD *theConstraints) { struct expr *theExp; int min = 0, max = 0, vCode; /*===========================================================*/ /* Determine the minimum and maximum number of value which */ /* can be derived from the expression chain (max of -1 means */ /* positive infinity). */ /*===========================================================*/ for (theExp = theExpression ; theExp != NULL ; theExp = theExp->nextArg) { if (ConstantType(theExp->type)) min++; else if (theExp->type == FCALL) { if ((ExpressionFunctionType(theExp) != 'm') && (ExpressionFunctionType(theExp) != 'u')) min++; else max = -1; } else max = -1; } /*====================================*/ /* Check for a cardinality violation. */ /*====================================*/ if (max == 0) max = min; if (CheckRangeAgainstCardinalityConstraint(theEnv,min,max,theConstraints) == FALSE) { return(CARDINALITY_VIOLATION); } /*========================================*/ /* Check for other constraint violations. */ /*========================================*/ for (theExp = theExpression ; theExp != NULL ; theExp = theExp->nextArg) { vCode = ConstraintCheckValue(theEnv,theExp->type,theExp->value,theConstraints); if (vCode != NO_VIOLATION) return(vCode); } return(NO_VIOLATION); } #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************************/ /* ConstraintCheckExpression: Checks an expression */ /* for constraint conflicts. Returns TRUE if */ /* conflicts are found, otherwise FALSE. */ /***************************************************/ globle int ConstraintCheckExpression( void *theEnv, struct expr *theExpression, CONSTRAINT_RECORD *theConstraints) { int rv = NO_VIOLATION; if (theConstraints == NULL) return(rv); while (theExpression != NULL) { rv = ConstraintCheckValue(theEnv,theExpression->type, theExpression->value, theConstraints); if (rv != NO_VIOLATION) return(rv); rv = ConstraintCheckExpression(theEnv,theExpression->argList,theConstraints); if (rv != NO_VIOLATION) return(rv); theExpression = theExpression->nextArg; } return(rv); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #if (! RUN_TIME) /*****************************************************/ /* UnmatchableConstraint: Determines if a constraint */ /* record can still be satisfied by some value. */ /*****************************************************/ globle intBool UnmatchableConstraint( CONSTRAINT_RECORD *theConstraint) { if (theConstraint == NULL) return(FALSE); if ((! theConstraint->anyAllowed) && (! theConstraint->symbolsAllowed) && (! theConstraint->stringsAllowed) && (! theConstraint->floatsAllowed) && (! theConstraint->integersAllowed) && (! theConstraint->instanceNamesAllowed) && (! theConstraint->instanceAddressesAllowed) && (! theConstraint->multifieldsAllowed) && (! theConstraint->externalAddressesAllowed) && (! theConstraint->voidAllowed) && (! theConstraint->factAddressesAllowed)) { return(TRUE); } return(FALSE); } #endif /* (! RUN_TIME) */ clips-6.24/clipssrc/dffctpsr.h0000755000175000017500000000262607422634575014542 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFFACTS PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_dffctpsr #define _H_dffctpsr #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDeffacts(void *,char *); #endif clips-6.24/clipssrc/._factcom.c0000400000175000017500000000075410441164424014520 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoHv*Hv*SD W ` =TTFLeFMWBBMPSRclips-6.24/clipssrc/dffnxfun.h0000755000175000017500000001414610441111752014523 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFFUNCTION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_dffnxfun #define _H_dffnxfun #define EnvGetDeffunctionName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define EnvGetDeffunctionPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetDeffunctionNamePointer(x) GetConstructNamePointer((struct constructHeader *) x) #define SetDeffunctionPPForm(d,ppf) SetConstructPPForm(theEnv,(struct constructHeader *) d,ppf) #define EnvDeffunctionModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) typedef struct deffunctionStruct DEFFUNCTION; typedef struct deffunctionModule DEFFUNCTION_MODULE; #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct deffunctionModule { struct defmoduleItemHeader header; }; struct deffunctionStruct { struct constructHeader header; unsigned busy, executing; unsigned short trace; EXPRESSION *code; int minNumberOfParameters, maxNumberOfParameters, numberOfLocalVars; }; #define DEFFUNCTION_DATA 23 struct deffunctionData { struct construct *DeffunctionConstruct; int DeffunctionModuleIndex; ENTITY_RECORD DeffunctionEntityRecord; #if DEBUGGING_FUNCTIONS unsigned WatchDeffunctions; #endif struct CodeGeneratorItem *DeffunctionCodeItem; DEFFUNCTION *ExecutingDeffunction; #if (! BLOAD_ONLY) && (! RUN_TIME) struct token DFInputToken; #endif }; #define DeffunctionData(theEnv) ((struct deffunctionData *) GetEnvironmentData(theEnv,DEFFUNCTION_DATA)) #if ENVIRONMENT_API_ONLY #define DeffunctionModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define FindDeffunction(theEnv,a) EnvFindDeffunction(theEnv,a) #define GetDeffunctionList(theEnv,a,b) EnvGetDeffunctionList(theEnv,a,b) #define GetDeffunctionName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define GetDeffunctionPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetDeffunctionWatch(theEnv,a) EnvGetDeffunctionWatch(theEnv,a) #define GetNextDeffunction(theEnv,a) EnvGetNextDeffunction(theEnv,a) #define IsDeffunctionDeletable(theEnv,a) EnvIsDeffunctionDeletable(theEnv,a) #define ListDeffunctions(theEnv,a,b) EnvListDeffunctions(theEnv,a,b) #define SetDeffunctionWatch(theEnv,a,b) EnvSetDeffunctionWatch(theEnv,a,b) #define Undeffunction(theEnv,a) EnvUndeffunction(theEnv,a) #else #define DeffunctionModule(x) GetConstructModuleName((struct constructHeader *) x) #define FindDeffunction(a) EnvFindDeffunction(GetCurrentEnvironment(),a) #define GetDeffunctionList(a,b) EnvGetDeffunctionList(GetCurrentEnvironment(),a,b) #define GetDeffunctionName(x) GetConstructNameString((struct constructHeader *) x) #define GetDeffunctionPPForm(x) GetConstructPPForm(GetCurrentEnvironment(),(struct constructHeader *) x) #define GetDeffunctionWatch(a) EnvGetDeffunctionWatch(GetCurrentEnvironment(),a) #define GetNextDeffunction(a) EnvGetNextDeffunction(GetCurrentEnvironment(),a) #define IsDeffunctionDeletable(a) EnvIsDeffunctionDeletable(GetCurrentEnvironment(),a) #define ListDeffunctions(a,b) EnvListDeffunctions(GetCurrentEnvironment(),a,b) #define SetDeffunctionWatch(a,b) EnvSetDeffunctionWatch(GetCurrentEnvironment(),a,b) #define Undeffunction(a) EnvUndeffunction(GetCurrentEnvironment(),a) #endif LOCALE void SetupDeffunctions(void *); LOCALE void *EnvFindDeffunction(void *,char *); LOCALE DEFFUNCTION *LookupDeffunctionByMdlOrScope(void *,char *); LOCALE DEFFUNCTION *LookupDeffunctionInScope(void *,char *); LOCALE intBool EnvUndeffunction(void *,void *); LOCALE void *EnvGetNextDeffunction(void *,void *); LOCALE int EnvIsDeffunctionDeletable(void *,void *); LOCALE void UndeffunctionCommand(void *); LOCALE void *GetDeffunctionModuleCommand(void *); LOCALE void DeffunctionGetBind(DATA_OBJECT *); LOCALE void DFRtnUnknown(DATA_OBJECT *); LOCALE void DFWildargs(DATA_OBJECT *); LOCALE int CheckDeffunctionCall(void *,void *,int); #if DEBUGGING_FUNCTIONS LOCALE void PPDeffunctionCommand(void *); LOCALE void ListDeffunctionsCommand(void *); LOCALE void EnvListDeffunctions(void *,char *,struct defmodule *); LOCALE void EnvSetDeffunctionWatch(void *,unsigned,void *); LOCALE unsigned EnvGetDeffunctionWatch(void *,void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE void RemoveDeffunction(void *,void *); #endif LOCALE void GetDeffunctionListFunction(void *,DATA_OBJECT *); globle void EnvGetDeffunctionList(void *,DATA_OBJECT *,struct defmodule *); #endif clips-6.24/clipssrc/bmathfun.c0000755000175000017500000006631410441127746014522 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* BASIC MATH FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for numerous basic math */ /* functions including +, *, -, /, integer, float, div, */ /* abs,set-auto-float-dividend, get-auto-float-dividend, */ /* min, and max. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _BMATHFUN_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "argacces.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "router.h" #include "bmathfun.h" #define BMATHFUN_DATA 6 struct basicMathFunctionData { intBool AutoFloatDividend; }; #define BasicMathFunctionData(theEnv) ((struct basicMathFunctionData *) GetEnvironmentData(theEnv,BMATHFUN_DATA)) /***************************************************************/ /* BasicMathFunctionDefinitions: Defines basic math functions. */ /***************************************************************/ globle void BasicMathFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,BMATHFUN_DATA,sizeof(struct basicMathFunctionData),NULL); BasicMathFunctionData(theEnv)->AutoFloatDividend = TRUE; #if ! RUN_TIME EnvDefineFunction2(theEnv,"+", 'n',PTIEF AdditionFunction, "AdditionFunction", "2*n"); EnvDefineFunction2(theEnv,"*", 'n', PTIEF MultiplicationFunction, "MultiplicationFunction", "2*n"); EnvDefineFunction2(theEnv,"-", 'n', PTIEF SubtractionFunction, "SubtractionFunction", "2*n"); EnvDefineFunction2(theEnv,"/", 'n', PTIEF DivisionFunction, "DivisionFunction", "2*n"); EnvDefineFunction2(theEnv,"div", 'l', PTIEF DivFunction, "DivFunction", "2*n"); EnvDefineFunction2(theEnv,"set-auto-float-dividend", 'b', SetAutoFloatDividendCommand, "SetAutoFloatDividendCommand", "11"); EnvDefineFunction2(theEnv,"get-auto-float-dividend", 'b', GetAutoFloatDividendCommand, "GetAutoFloatDividendCommand", "00"); EnvDefineFunction2(theEnv,"integer", 'l', PTIEF IntegerFunction, "IntegerFunction", "11n"); EnvDefineFunction2(theEnv,"float", 'd', PTIEF FloatFunction, "FloatFunction", "11n"); EnvDefineFunction2(theEnv,"abs", 'n', PTIEF AbsFunction, "AbsFunction", "11n"); EnvDefineFunction2(theEnv,"min", 'n', PTIEF MinFunction, "MinFunction", "2*n"); EnvDefineFunction2(theEnv,"max", 'n', PTIEF MaxFunction, "MaxFunction", "2*n"); #endif } /**********************************/ /* AdditionFunction: H/L access */ /* routine for the + function. */ /**********************************/ globle void AdditionFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 0.0; long ltotal = 0L; intBool useFloatTotal = FALSE; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; /*=================================================*/ /* Loop through each of the arguments adding it to */ /* a running total. If a floating point number is */ /* encountered, then do all subsequent operations */ /* using floating point values. */ /*=================================================*/ theExpression = GetFirstArgument(); while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"+",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (useFloatTotal) { ftotal += ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal += ValueToLong(theArgument.value); } else { ftotal = (double) ltotal + ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } } /****************************************/ /* MultiplicationFunction: CLIPS access */ /* routine for the * function. */ /****************************************/ globle void MultiplicationFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 1.0; long ltotal = 1L; intBool useFloatTotal = FALSE; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; /*===================================================*/ /* Loop through each of the arguments multiplying it */ /* by a running product. If a floating point number */ /* is encountered, then do all subsequent operations */ /* using floating point values. */ /*===================================================*/ theExpression = GetFirstArgument(); while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"*",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (useFloatTotal) { ftotal *= ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal *= ValueToLong(theArgument.value); } else { ftotal = (double) ltotal * ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } } /*************************************/ /* SubtractionFunction: CLIPS access */ /* routine for the - function. */ /*************************************/ globle void SubtractionFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 0.0; long ltotal = 0L; intBool useFloatTotal = FALSE; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; /*=================================================*/ /* Get the first argument. This number which will */ /* be the starting total from which all subsequent */ /* arguments will subtracted. */ /*=================================================*/ theExpression = GetFirstArgument(); if (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"-",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) { ltotal = ValueToLong(theArgument.value); } else { ftotal = ValueToDouble(theArgument.value); useFloatTotal = TRUE; } pos++; } /*===================================================*/ /* Loop through each of the arguments subtracting it */ /* from a running total. If a floating point number */ /* is encountered, then do all subsequent operations */ /* using floating point values. */ /*===================================================*/ while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"-",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (useFloatTotal) { ftotal -= ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal -= ValueToLong(theArgument.value); } else { ftotal = (double) ltotal - ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } } /***********************************/ /* DivisionFunction: CLIPS access */ /* routine for the / function. */ /***********************************/ globle void DivisionFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 1.0; long ltotal = 1L; intBool useFloatTotal; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; useFloatTotal = BasicMathFunctionData(theEnv)->AutoFloatDividend; /*===================================================*/ /* Get the first argument. This number which will be */ /* the starting product from which all subsequent */ /* arguments will divide. If the auto float dividend */ /* feature is enable, then this number is converted */ /* to a float if it is an integer. */ /*===================================================*/ theExpression = GetFirstArgument(); if (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"/",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) { ltotal = ValueToLong(theArgument.value); } else { ftotal = ValueToDouble(theArgument.value); useFloatTotal = TRUE; } pos++; } /*====================================================*/ /* Loop through each of the arguments dividing it */ /* into a running product. If a floating point number */ /* is encountered, then do all subsequent operations */ /* using floating point values. Each argument is */ /* checked to prevent a divide by zero error. */ /*====================================================*/ while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"/",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if ((theArgument.type == INTEGER) ? (ValueToLong(theArgument.value) == 0L) : ((theArgument.type == FLOAT) ? ValueToDouble(theArgument.value) == 0.0 : FALSE)) { DivideByZeroErrorMessage(theEnv,"/"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,1.0); return; } if (useFloatTotal) { ftotal /= ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal /= ValueToLong(theArgument.value); } else { ftotal = (double) ltotal / ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } } /*************************************/ /* DivFunction: H/L access routine */ /* for the div function. */ /*************************************/ globle long DivFunction( void *theEnv) { long total = 1L; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; long theNumber; /*===================================================*/ /* Get the first argument. This number which will be */ /* the starting product from which all subsequent */ /* arguments will divide. */ /*===================================================*/ theExpression = GetFirstArgument(); if (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"div",&theArgument,FALSE,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) { total = ValueToLong(theArgument.value); } else { total = (long) ValueToDouble(theArgument.value); } pos++; } /*=====================================================*/ /* Loop through each of the arguments dividing it into */ /* a running product. Floats are converted to integers */ /* and each argument is checked to prevent a divide by */ /* zero error. */ /*=====================================================*/ while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"div",&theArgument,FALSE,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) theNumber = ValueToLong(theArgument.value); else if (theArgument.type == FLOAT) theNumber = (long) ValueToDouble(theArgument.value); else theNumber = 1; if (theNumber == 0L) { DivideByZeroErrorMessage(theEnv,"div"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } if (theArgument.type == INTEGER) { total /= ValueToLong(theArgument.value); } else { total = total / (long) ValueToDouble(theArgument.value); } pos++; } /*======================================================*/ /* The result of the div function is always an integer. */ /*======================================================*/ return(total); } /*****************************************************/ /* SetAutoFloatDividendCommand: H/L access routine */ /* for the set-auto-float-dividend command. */ /*****************************************************/ globle int SetAutoFloatDividendCommand( void *theEnv) { int oldValue; DATA_OBJECT theArgument; /*===============================*/ /* Remember the present setting. */ /*===============================*/ oldValue = BasicMathFunctionData(theEnv)->AutoFloatDividend; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-auto-float-dividend",EXACTLY,1) == -1) { return(oldValue); } EnvRtnUnknown(theEnv,1,&theArgument); /*============================================================*/ /* The symbol FALSE disables the auto float dividend feature. */ /*============================================================*/ if ((theArgument.value == EnvFalseSymbol(theEnv)) && (theArgument.type == SYMBOL)) { BasicMathFunctionData(theEnv)->AutoFloatDividend = FALSE; } else { BasicMathFunctionData(theEnv)->AutoFloatDividend = TRUE; } /*======================================*/ /* Return the old value of the feature. */ /*======================================*/ return(oldValue); } /*****************************************************/ /* GetAutoFloatDividendCommand: H/L access routine */ /* for the get-auto-float-dividend command. */ /*****************************************************/ globle int GetAutoFloatDividendCommand( void *theEnv) { /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ EnvArgCountCheck(theEnv,"get-auto-float-dividend",EXACTLY,0); /*=============================*/ /* Return the current setting. */ /*=============================*/ return(BasicMathFunctionData(theEnv)->AutoFloatDividend); } /*************************************************/ /* EnvGetAutoFloatDividend: C access routine for */ /* the get-auto-float-dividend command. */ /*************************************************/ globle intBool EnvGetAutoFloatDividend( void *theEnv) { return(BasicMathFunctionData(theEnv)->AutoFloatDividend); } /*************************************************/ /* EnvSetAutoFloatDividend: C access routine for */ /* the set-auto-float-dividend command. */ /*************************************************/ globle intBool EnvSetAutoFloatDividend( void *theEnv, int value) { int ov; ov = BasicMathFunctionData(theEnv)->AutoFloatDividend; BasicMathFunctionData(theEnv)->AutoFloatDividend = value; return(ov); } /*****************************************/ /* IntegerFunction: H/L access routine */ /* for the integer function. */ /*****************************************/ globle long int IntegerFunction( void *theEnv) { DATA_OBJECT valstruct; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"integer",EXACTLY,1) == -1) return(0L); /*================================================================*/ /* Check for the correct type of argument. Note that ArgTypeCheck */ /* will convert floats to integers when an integer is requested */ /* (which is the purpose of the integer function). */ /*================================================================*/ if (EnvArgTypeCheck(theEnv,"integer",1,INTEGER,&valstruct) == FALSE) return(0L); /*===================================================*/ /* Return the numeric value converted to an integer. */ /*===================================================*/ return(ValueToLong(valstruct.value)); } /***************************************/ /* FloatFunction: H/L access routine */ /* for the float function. */ /***************************************/ globle double FloatFunction( void *theEnv) { DATA_OBJECT valstruct; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"float",EXACTLY,1) == -1) return(0.0); /*================================================================*/ /* Check for the correct type of argument. Note that ArgTypeCheck */ /* will convert integers to floats when a float is requested */ /* (which is the purpose of the float function). */ /*================================================================*/ if (EnvArgTypeCheck(theEnv,"float",1,FLOAT,&valstruct) == FALSE) return(0.0); /*================================================*/ /* Return the numeric value converted to a float. */ /*================================================*/ return(ValueToDouble(valstruct.value)); } /*************************************/ /* AbsFunction: H/L access routine */ /* for the abs function. */ /*************************************/ globle void AbsFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"abs",EXACTLY,1) == -1) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*======================================*/ /* Check that the argument is a number. */ /*======================================*/ if (EnvArgTypeCheck(theEnv,"abs",1,INTEGER_OR_FLOAT,returnValue) == FALSE) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*==========================================*/ /* Return the absolute value of the number. */ /*==========================================*/ if (returnValue->type == INTEGER) { if (ValueToLong(returnValue->value) < 0L) { returnValue->value = (void *) EnvAddLong(theEnv,- ValueToLong(returnValue->value)); } } else if (ValueToDouble(returnValue->value) < 0.0) { returnValue->value = (void *) EnvAddDouble(theEnv,- ValueToDouble(returnValue->value)); } } /*************************************/ /* MinFunction: H/L access routine */ /* for the min function. */ /*************************************/ globle void MinFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT argValue; int numberOfArguments, i; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"min",AT_LEAST,1)) == -1) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*============================================*/ /* Check that the first argument is a number. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"min",1,INTEGER_OR_FLOAT,returnValue) == FALSE) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*===========================================================*/ /* Loop through the remaining arguments, first checking each */ /* argument to see that it is a number, and then determining */ /* if the argument is less than the previous arguments and */ /* is thus the minimum value. */ /*===========================================================*/ for (i = 2 ; i <= numberOfArguments ; i++) { if (EnvArgTypeCheck(theEnv,"min",i,INTEGER_OR_FLOAT,&argValue) == FALSE) return; if (returnValue->type == INTEGER) { if (argValue.type == INTEGER) { if (ValueToLong(returnValue->value) > ValueToLong(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } else { if ((double) ValueToLong(returnValue->value) > ValueToDouble(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } } else { if (argValue.type == INTEGER) { if (ValueToDouble(returnValue->value) > (double) ValueToLong(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } else { if (ValueToDouble(returnValue->value) > ValueToDouble(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } } } return; } /*************************************/ /* MaxFunction: H/L access routine */ /* for the max function. */ /*************************************/ globle void MaxFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT argValue; int numberOfArguments, i; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"max",AT_LEAST,1)) == -1) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*============================================*/ /* Check that the first argument is a number. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"max",1,INTEGER_OR_FLOAT,returnValue) == FALSE) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,0L); return; } /*===========================================================*/ /* Loop through the remaining arguments, first checking each */ /* argument to see that it is a number, and then determining */ /* if the argument is greater than the previous arguments */ /* and is thus the maximum value. */ /*===========================================================*/ for (i = 2 ; i <= numberOfArguments ; i++) { if (EnvArgTypeCheck(theEnv,"max",i,INTEGER_OR_FLOAT,&argValue) == FALSE) return; if (returnValue->type == INTEGER) { if (argValue.type == INTEGER) { if (ValueToLong(returnValue->value) < ValueToLong(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } else { if ((double) ValueToLong(returnValue->value) < ValueToDouble(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } } else { if (argValue.type == INTEGER) { if (ValueToDouble(returnValue->value) < (double) ValueToLong(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } else { if (ValueToDouble(returnValue->value) < ValueToDouble(argValue.value)) { returnValue->type = argValue.type; returnValue->value = argValue.value; } } } } return; } clips-6.24/clipssrc/setup.h0000755000175000017500000004071510444326264014057 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/12/06 */ /* */ /* SETUP HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: This file is the general header file included by */ /* all of the .c source files. It contains global */ /* definitions and the compiler flags which must be edited */ /* to create a version for a specific machine, operating */ /* system, or feature set. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Default locale modification. */ /* */ /* Removed CONFLICT_RESOLUTION_STRATEGIES, */ /* DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* LOGICAL_DEPENDENCIES, IMPERATIVE_METHODS, */ /* INSTANCE_PATTERN_MATCHING, and */ /* IMPERATIVE_MESSAGE_HANDLERS, and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Removed the SHORT_LINK_NAMES compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_setup #define _H_setup /****************************************************************/ /* -------------------- COMPILER FLAGS ------------------------ */ /****************************************************************/ /*********************************************************************/ /* Flag denoting the environment in which the executable is to run. */ /* Only one of these flags should be turned on (set to 1) at a time. */ /*********************************************************************/ #define GENERIC 1 /* Generic (any machine) */ #define UNIX_V 0 /* UNIX System V, 4.2bsd, HP Unix, Darwin */ #define UNIX_7 0 /* UNIX System III Version 7 or Sun Unix */ #define MAC_MCW 0 /* Apple Macintosh, with CodeWarrior 9.6 */ #define MAC_XCD 0 /* Apple Macintosh, with Xcode 2.3 */ #define IBM_MCW 0 /* IBM PC, with CodeWarrior 9.4 */ #define IBM_MSC 0 /* IBM PC, with Microsoft VC++ .NET 2003 */ #define IBM_TBC 0 /* IBM PC, with Borland C++ 5.0 */ #define IBM_GCC 0 /* IBM PC, with DJGPP 3.21 */ /* The following are unsupported: */ #define IBM_ZTC 0 /* IBM PC, with Zortech C++ 3.1 */ #define IBM_ICB 0 /* IBM PC, with Intel C Code Builder 1.0 */ #define IBM_SC 0 /* IBM PC, with Symantec C++ 6.1 */ #define VAX_VMS 0 /* VAX VMS */ #if IBM_ZTC || IBM_MSC || IBM_TBC || IBM_ICB || IBM_SC || IBM_MCW #define IBM 1 #else #define IBM 0 #endif #if MAC_MCW || MAC_XCD #define MAC 1 #else #define MAC 0 #endif /***********************************************/ /* Some definitions for use with declarations. */ /***********************************************/ #define VOID void #define VOID_ARG void #define STD_SIZE size_t #define intBool int #define globle /*******************************************/ /* RUN_TIME: Specifies whether a run-time */ /* module is being created. */ /*******************************************/ #ifndef RUN_TIME #define RUN_TIME 0 #endif /*************************************************/ /* DEFRULE_CONSTRUCT: Determines whether defrule */ /* construct is included. */ /*************************************************/ #define DEFRULE_CONSTRUCT 1 /************************************************/ /* DEFMODULE_CONSTRUCT: Determines whether the */ /* defmodule construct is included. */ /************************************************/ #define DEFMODULE_CONSTRUCT 1 /****************************************************/ /* DEFTEMPLATE_CONSTRUCT: Determines whether facts */ /* and the deftemplate construct are included. */ /****************************************************/ #define DEFTEMPLATE_CONSTRUCT 1 #if ! DEFRULE_CONSTRUCT #undef DEFTEMPLATE_CONSTRUCT #define DEFTEMPLATE_CONSTRUCT 0 #endif /************************************************************/ /* FACT_SET_QUERIES: Determines if fact-set query functions */ /* such as any-factp and do-for-all-facts are included. */ /************************************************************/ #define FACT_SET_QUERIES 1 #if ! DEFTEMPLATE_CONSTRUCT #undef FACT_SET_QUERIES #define FACT_SET_QUERIES 0 #endif /****************************************************/ /* DEFFACTS_CONSTRUCT: Determines whether deffacts */ /* construct is included. */ /****************************************************/ #define DEFFACTS_CONSTRUCT 1 #if ! DEFTEMPLATE_CONSTRUCT #undef DEFFACTS_CONSTRUCT #define DEFFACTS_CONSTRUCT 0 #endif /************************************************/ /* DEFGLOBAL_CONSTRUCT: Determines whether the */ /* defglobal construct is included. */ /************************************************/ #define DEFGLOBAL_CONSTRUCT 1 /**********************************************/ /* DEFFUNCTION_CONSTRUCT: Determines whether */ /* deffunction construct is included. */ /**********************************************/ #define DEFFUNCTION_CONSTRUCT 1 /*********************************************/ /* DEFGENERIC_CONSTRUCT: Determines whether */ /* generic functions are included. */ /*********************************************/ #define DEFGENERIC_CONSTRUCT 1 /*****************************************************************/ /* OBJECT_SYSTEM: Determines whether object system is included. */ /* The MULTIFIELD_FUNCTIONS flag should also be on if you want */ /* to be able to manipulate multi-field slots. */ /*****************************************************************/ #define OBJECT_SYSTEM 1 /*****************************************************************/ /* DEFINSTANCES_CONSTRUCT: Determines whether the definstances */ /* construct is enabled. */ /*****************************************************************/ #define DEFINSTANCES_CONSTRUCT 1 #if ! OBJECT_SYSTEM #undef DEFINSTANCES_CONSTRUCT #define DEFINSTANCES_CONSTRUCT 0 #endif /********************************************************************/ /* INSTANCE_SET_QUERIES: Determines if instance-set query functions */ /* such as any-instancep and do-for-all-instances are included. */ /********************************************************************/ #define INSTANCE_SET_QUERIES 1 #if ! OBJECT_SYSTEM #undef INSTANCE_SET_QUERIES #define INSTANCE_SET_QUERIES 0 #endif /******************************************************************/ /* Check for consistencies associated with the defrule construct. */ /******************************************************************/ #if (! DEFTEMPLATE_CONSTRUCT) && (! OBJECT_SYSTEM) #undef DEFRULE_CONSTRUCT #define DEFRULE_CONSTRUCT 0 #endif /*******************************************************************/ /* BLOAD/BSAVE_INSTANCES: Determines if the save/restore-instances */ /* functions can be enhanced to perform more quickly by using */ /* binary files */ /*******************************************************************/ #define BLOAD_INSTANCES 1 #define BSAVE_INSTANCES 1 #if ! OBJECT_SYSTEM #undef BLOAD_INSTANCES #undef BSAVE_INSTANCES #define BLOAD_INSTANCES 0 #define BSAVE_INSTANCES 0 #endif /****************************************************************/ /* EXTENDED MATH PACKAGE FLAG: If this is on, then the extended */ /* math package functions will be available for use, (normal */ /* default). If this flag is off, then the extended math */ /* functions will not be available, and the 30K or so of space */ /* they require will be free. Usually a concern only on PC type */ /* machines. */ /****************************************************************/ #define EX_MATH 1 /****************************************************************/ /* TEXT PROCESSING : Turn on this flag for support of the */ /* hierarchical lookup system. */ /****************************************************************/ #define TEXTPRO_FUNCTIONS 1 /****************************************************************/ /* HELP: To implement the help facility, set the flag below and */ /* specify the path and name of the help data file your system. */ /****************************************************************/ #define HELP_FUNCTIONS 1 #if HELP_FUNCTIONS #define HELP_DEFAULT "clips.hlp" #endif /*************************************************************************/ /* BLOAD_ONLY: Enables bload command and disables the load command. */ /* BLOAD: Enables bload command. */ /* BLOAD_AND_BSAVE: Enables bload, and bsave commands. */ /*************************************************************************/ #define BLOAD_ONLY 0 #define BLOAD 0 #define BLOAD_AND_BSAVE 1 #if RUN_TIME #undef BLOAD_ONLY #define BLOAD_ONLY 0 #undef BLOAD #define BLOAD 0 #undef BLOAD_AND_BSAVE #define BLOAD_AND_BSAVE 0 #endif /****************************************************************/ /* EMACS_EDITOR: If this flag is turned on, an integrated EMACS */ /* style editor can be utilized on supported machines. */ /****************************************************************/ #define EMACS_EDITOR 1 #if GENERIC || MAC #undef EMACS_EDITOR /* Editor can't be used */ #define EMACS_EDITOR 0 /* with Generic or Mac */ #endif /********************************************************************/ /* CONSTRUCT COMPILER: If this flag is turned on, you can generate */ /* C code representing the constructs in the current environment. */ /* With the RUN_TIME flag set, this code can be compiled and */ /* linked to create a stand-alone run-time executable. */ /********************************************************************/ #define CONSTRUCT_COMPILER 1 #if CONSTRUCT_COMPILER #define API_HEADER "clips.h" #endif /*******************************************/ /* BASIC_IO: Includes printout, fprintout, */ /* read, open, and close functions. */ /*******************************************/ #define BASIC_IO 1 /***************************************************/ /* EXT_IO: Includes format and readline functions. */ /***************************************************/ #define EXT_IO 1 /************************************************/ /* STRING_FUNCTIONS: Includes string functions: */ /* str-length, str-compare, upcase, lowcase, */ /* sub-string, str-index, and eval. */ /************************************************/ #define STRING_FUNCTIONS 1 /*********************************************/ /* MULTIFIELD_FUNCTIONS: Includes multifield */ /* functions: mv-subseq, mv-delete, */ /* mv-append, str-explode, str-implode. */ /*********************************************/ #define MULTIFIELD_FUNCTIONS 1 /****************************************************/ /* DEBUGGING_FUNCTIONS: Includes functions such as */ /* rules, facts, matches, ppdefrule, etc. */ /****************************************************/ #define DEBUGGING_FUNCTIONS 1 /***************************************************/ /* PROFILING_FUNCTIONS: Enables code for profiling */ /* constructs and user functions. */ /***************************************************/ #define PROFILING_FUNCTIONS 1 /************************************************************************/ /* BLOCK_MEMORY: Causes memory to be allocated in large blocks. */ /* INITBUFFERSIZE and BLOCKSIZE should both be set to less than the */ /* maximum size of a signed integer. On a 16-bit machine, they should */ /* be less than 32768. */ /************************************************************************/ #define BLOCK_MEMORY 0 #if BLOCK_MEMORY #define INITBLOCKSIZE 32000 #define BLOCKSIZE 32000 #endif /*****************************************************************/ /* WINDOW_INTERFACE : Set this flag if you are recompiling the */ /* IBM-PC MS-DOS Window Interface or the Macintosh LSC Window */ /* Interface. Currently, when enabled, this flag disables the */ /* more processing used by the help system. */ /* This flag also prevents any input or output being directly */ /* sent to stdin or stdout. */ /*****************************************************************/ #ifndef WINDOW_INTERFACE #define WINDOW_INTERFACE 1 #endif #if WINDOW_INTERFACE #undef EMACS_EDITOR /* Editor can't be used with */ #define EMACS_EDITOR 0 /* windowed interface */ #endif /*********************************************************/ /* ENVIRONMENT_API_ONLY: If enabled, only the enviroment */ /* API may be used to interface with CLIPS. */ /*********************************************************/ #define ENVIRONMENT_API_ONLY 0 /*************************************************************/ /* ALLOW_ENVIRONMENT_GLOBALS: If enabled, tracks the current */ /* environment and allows environments to be referred to */ /* by index. If disabled, CLIPS makes no use of global */ /* variables. */ /*************************************************************/ #define ALLOW_ENVIRONMENT_GLOBALS 1 #if ! ALLOW_ENVIRONMENT_GLOBALS #undef ENVIRONMENT_API_ONLY /* Environment API must be used */ #define ENVIRONMENT_API_ONLY 1 /* if no environment globals */ #undef EMACS_EDITOR /* Editor can't be used without */ #define EMACS_EDITOR 0 /* environment globals */ #endif /********************************************/ /* DEVELOPER: Enables code for debugging a */ /* development version of the executable. */ /********************************************/ #ifndef DEVELOPER #define DEVELOPER 0 #endif #if DEVELOPER #include #define Bogus(x) assert(! (x)) #else #define Bogus(x) #endif /***************************/ /* Environment Definitions */ /***************************/ #include "envrnmnt.h" /******************************/ /* Compatibilty Redefinitions */ /******************************/ #define PrintCLIPS(x,y) EnvPrintRouter(GetCurrentEnvironment(),x,y) #define GetcCLIPS(x,y) EnvGetcRouter(GetCurrentEnvironment(),x) #define UngetcCLIPS(x,y) EnvUngetcRouter(GetCurrentEnvironment(),x,y) #define ExitCLIPS(x) EnvExitRouter(GetCurrentEnvironment(),x) #define CLIPSSystemError(x,y) SystemError(x,y) #define CLIPSFunctionCall(x,y,z) FunctionCall(x,y,z) #define InitializeCLIPS() InitializeEnvironment() #define WCLIPS WPROMPT #define CLIPSTrueSymbol SymbolData(GetCurrentEnvironment())->TrueSymbol #define CLIPSFalseSymbol SymbolData(GetCurrentEnvironment())->FalseSymbol #define EnvCLIPSTrueSymbol(theEnv) SymbolData(theEnv)->TrueSymbol #define EnvCLIPSFalseSymbol(theEnv) SymbolData(theEnv)->FalseSymbol #define CLIPS_FALSE 0 #define CLIPS_TRUE 1 /*************************************************/ /* Any user defined global setup information can */ /* be included in the file usrsetup.h which is */ /* an empty file in the baseline version. */ /*************************************************/ #include "usrsetup.h" #endif /* _H_setup */ clips-6.24/clipssrc/._emathfun.c0000400000175000017500000000075410177533435014723 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoBuBu۾$=W0W;X7TTFDFMWBBMPSRclips-6.24/clipssrc/._dffctpsr.h0000400000175000017500000000012207422634575014727 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/modulpsr.h0000755000175000017500000000415207422634765014571 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFMODULE PARSER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_modulpsr #define _H_modulpsr struct portConstructItem { char *constructName; int typeExpected; struct portConstructItem *next; }; #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE long GetNumberOfDefmodules(void *); LOCALE void SetNumberOfDefmodules(void *,long); LOCALE void AddAfterModuleDefinedFunction(void *,char *,void (*)(void *),int); LOCALE int ParseDefmodule(void *,char *); LOCALE void AddPortConstructItem(void *,char *,int); LOCALE struct portConstructItem *ValidPortConstructItem(void *,char *); LOCALE int FindImportExportConflict(void *,char *,struct defmodule *,char *); #endif clips-6.24/clipssrc/symblcmp.c0000755000175000017500000006507410441602332014533 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* SYMBOL CONSTRUCT COMPILER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for */ /* atomic data values: symbols, integers, floats, and */ /* bit maps. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Barry Cameron */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /*************************************************************/ #define _SYMBLCMP_SOURCE_ #include "setup.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "symbol.h" #include "memalloc.h" #include "constant.h" #include "exprnpsr.h" #include "cstrccom.h" #include "constrct.h" #include "argacces.h" #include "cstrncmp.h" #include "router.h" #include "conscomp.h" #include "sysdep.h" #include "utility.h" #include "symblcmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int SymbolHashNodesToCode(void *,char *,int); static int BitMapHashNodesToCode(void *,char *,int); static int BitMapValuesToCode(void *,char *,int); static int FloatHashNodesToCode(void *,char *,int); static int IntegerHashNodesToCode(void *,char *,int); static int HashTablesToCode(void *,char *); static void PrintCString(FILE *,char *); /**************************************************************/ /* AtomicValuesToCode: Driver routine for generating the code */ /* used by the symbol, integer, float, and bit map tables. */ /**************************************************************/ globle void AtomicValuesToCode( void *theEnv, char *fileName) { int version; SetAtomicValueIndices(theEnv,TRUE); HashTablesToCode(theEnv,fileName); version = SymbolHashNodesToCode(theEnv,fileName,5); version = FloatHashNodesToCode(theEnv,fileName,version); version = IntegerHashNodesToCode(theEnv,fileName,version); version = BitMapHashNodesToCode(theEnv,fileName,version); BitMapValuesToCode(theEnv,fileName,version); } /*****************************************************/ /* SymbolHashNodesToCode: Produces the code for the */ /* symbol hash table entries for a run-time module */ /* created using the constructs-to-c function. */ /*****************************************************/ static int SymbolHashNodesToCode( void *theEnv, char *fileName, int version) { unsigned long i, j; struct symbolHashNode *hashPtr; int count; int numberOfEntries; struct symbolHashNode **symbolTable; int newHeader = TRUE; int arrayVersion = 1; FILE *fp; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ symbolTable = GetSymbolTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (hashPtr = symbolTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries++; } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (unsigned long) (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct symbolHashNode S%d_%ld[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < SYMBOL_HASH_SIZE; i++) { for (hashPtr = symbolTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"struct symbolHashNode S%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } if (hashPtr->next == NULL) { fprintf(fp,"{NULL,"); } else { if ((j + 1) >= (unsigned long) ConstructCompilerData(theEnv)->MaxIndices) { fprintf(fp,"{&S%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion + 1,0); } else { fprintf(fp,"{&S%d_%d[%ld],",ConstructCompilerData(theEnv)->ImageID,arrayVersion,j + 1); } } fprintf(fp,"%ld,0,1,0,0,%ld,",hashPtr->count + 1,i); PrintCString(fp,hashPtr->contents); count++; j++; if ((count == numberOfEntries) || (j >= (unsigned) ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; arrayVersion++; version++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /******************************************************/ /* BitMapHashNodesToCode: Produces the code for the */ /* bit map hash table entries for a run-time module */ /* created using the constructs-to-c function. */ /******************************************************/ static int BitMapHashNodesToCode( void *theEnv, char *fileName, int version) { int i, j; struct bitMapHashNode *hashPtr; int count; int numberOfEntries; struct bitMapHashNode **bitMapTable; int newHeader = TRUE; int arrayVersion = 1; FILE *fp; int longsReqdPartition = 1,longsReqdPartitionCount = 0; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ bitMapTable = GetBitMapTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (hashPtr = bitMapTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries++; } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct bitMapHashNode B%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (hashPtr = bitMapTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"struct bitMapHashNode B%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } if (hashPtr->next == NULL) { fprintf(fp,"{NULL,"); } else { if ((j + 1) >= ConstructCompilerData(theEnv)->MaxIndices) { fprintf(fp,"{&B%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion + 1,0); } else { fprintf(fp,"{&B%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion,j + 1); } } fprintf(fp,"%ld,0,1,0,0,%d,(char *) &L%d_%d[%d],%d", hashPtr->count + 1,i, ConstructCompilerData(theEnv)->ImageID,longsReqdPartition,longsReqdPartitionCount, hashPtr->size); longsReqdPartitionCount += (int) (hashPtr->size / sizeof(unsigned long)); if ((hashPtr->size % sizeof(unsigned long)) != 0) longsReqdPartitionCount++; if (longsReqdPartitionCount >= ConstructCompilerData(theEnv)->MaxIndices) { longsReqdPartitionCount = 0; longsReqdPartition++; } count++; j++; if ((count == numberOfEntries) || (j >= ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; arrayVersion++; version++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /*****************************************************/ /* BitMapValuesToCode: Produces the code for the bit */ /* map strings for a run-time module created using */ /* the constructs-to-c function. */ /*****************************************************/ static int BitMapValuesToCode( void *theEnv, char *fileName, int version) { int i, j, k; unsigned l; struct bitMapHashNode *hashPtr; int count; int numberOfEntries; struct bitMapHashNode **bitMapTable; int newHeader = TRUE; int arrayVersion = 1; FILE *fp; unsigned long tmpLong; int longsReqd; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ bitMapTable = GetBitMapTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (hashPtr = bitMapTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries += (int) (hashPtr->size / sizeof(unsigned long)); if ((hashPtr->size % sizeof(unsigned long)) != 0) { numberOfEntries++; } } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern unsigned long L%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < BITMAP_HASH_SIZE; i++) { for (hashPtr = bitMapTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"unsigned long L%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } longsReqd = (int) (hashPtr->size / sizeof(unsigned long)); if ((hashPtr->size % sizeof(unsigned long)) != 0) longsReqd++; for (k = 0 ; k < longsReqd ; k++) { if (k > 0) fprintf(fp,","); tmpLong = 0L; for (l = 0 ; ((l < sizeof(unsigned long)) && (((k * sizeof(unsigned long)) + l) < hashPtr->size)) ; l++) ((char *) &tmpLong)[l] = hashPtr->contents[(k * sizeof(unsigned long)) + l]; fprintf(fp,"0x%lxL",tmpLong); } count += longsReqd; j += longsReqd; if ((count == numberOfEntries) || (j >= ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"};\n"); GenClose(theEnv,fp); j = 0; arrayVersion++; version++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,",\n"); } } } return(version); } /****************************************************/ /* FloatHashNodesToCode: Produces the code for the */ /* float hash table entries for a run-time module */ /* created using the constructs-to-c function. */ /****************************************************/ static int FloatHashNodesToCode( void *theEnv, char *fileName, int version) { int i, j; struct floatHashNode *hashPtr; int count; int numberOfEntries; struct floatHashNode **floatTable; int newHeader = TRUE; FILE *fp; int arrayVersion = 1; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ floatTable = GetFloatTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (hashPtr = floatTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries++; } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct floatHashNode F%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < FLOAT_HASH_SIZE; i++) { for (hashPtr = floatTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"struct floatHashNode F%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } if (hashPtr->next == NULL) { fprintf(fp,"{NULL,"); } else { if ((j + 1) >= ConstructCompilerData(theEnv)->MaxIndices) { fprintf(fp,"{&F%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion + 1,0); } else { fprintf(fp,"{&F%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion,j + 1); } } fprintf(fp,"%ld,0,1,0,0,%d,",hashPtr->count + 1,i); fprintf(fp,"%s",FloatToString(theEnv,hashPtr->contents)); count++; j++; if ((count == numberOfEntries) || (j >= ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; version++; arrayVersion++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /******************************************************/ /* IntegerHashNodesToCode: Produces the code for the */ /* integer hash table entries for a run-time module */ /* created using the constructs-to-c function. */ /******************************************************/ static int IntegerHashNodesToCode( void *theEnv, char *fileName, int version) { int i, j; struct integerHashNode *hashPtr; int count; int numberOfEntries; struct integerHashNode **integerTable; int newHeader = TRUE; FILE *fp; int arrayVersion = 1; /*====================================*/ /* Count the total number of entries. */ /*====================================*/ integerTable = GetIntegerTable(theEnv); count = numberOfEntries = 0; for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (hashPtr = integerTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { numberOfEntries++; } } if (numberOfEntries == 0) return(version); for (i = 1; i <= (numberOfEntries / ConstructCompilerData(theEnv)->MaxIndices) + 1 ; i++) { fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct integerHashNode I%d_%d[];\n",ConstructCompilerData(theEnv)->ImageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; for (i = 0; i < INTEGER_HASH_SIZE; i++) { for (hashPtr = integerTable[i]; hashPtr != NULL; hashPtr = hashPtr->next) { if (newHeader) { fprintf(fp,"struct integerHashNode I%d_%d[] = {\n",ConstructCompilerData(theEnv)->ImageID,arrayVersion); newHeader = FALSE; } if (hashPtr->next == NULL) { fprintf(fp,"{NULL,"); } else { if ((j + 1) >= ConstructCompilerData(theEnv)->MaxIndices) { fprintf(fp,"{&I%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion + 1,0); } else { fprintf(fp,"{&I%d_%d[%d],",ConstructCompilerData(theEnv)->ImageID,arrayVersion,j + 1); } } fprintf(fp,"%ld,0,1,0,0,%d,",hashPtr->count + 1,i); fprintf(fp,"%ld",hashPtr->contents); count++; j++; if ((count == numberOfEntries) || (j >= ConstructCompilerData(theEnv)->MaxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; version++; arrayVersion++; if (count < numberOfEntries) { if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /****************************************************************/ /* HashTablesToCode: Produces the code for the symbol, integer, */ /* float, and bitmap hash tables for a run-time module */ /* created using the constructs-to-c function. */ /****************************************************************/ static int HashTablesToCode( void *theEnv, char *fileName) { unsigned long i; FILE *fp; struct symbolHashNode **symbolTable; struct floatHashNode **floatTable; struct integerHashNode **integerTable; struct bitMapHashNode **bitMapTable; /*======================================*/ /* Write the code for the symbol table. */ /*======================================*/ symbolTable = GetSymbolTable(theEnv); if ((fp = NewCFile(theEnv,fileName,1,1,FALSE)) == NULL) return(0); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct symbolHashNode *sht%d[];\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp,"struct symbolHashNode *sht%d[%ld] = {\n",ConstructCompilerData(theEnv)->ImageID,SYMBOL_HASH_SIZE); for (i = 0; i < SYMBOL_HASH_SIZE; i++) { PrintSymbolReference(theEnv,fp,symbolTable[i]); if (i + 1 != SYMBOL_HASH_SIZE) fprintf(fp,",\n"); } fprintf(fp,"};\n"); GenClose(theEnv,fp); /*=====================================*/ /* Write the code for the float table. */ /*=====================================*/ floatTable = GetFloatTable(theEnv); if ((fp = NewCFile(theEnv,fileName,1,2,FALSE)) == NULL) return(0); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct floatHashNode *fht%d[];\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp,"struct floatHashNode *fht%d[%d] = {\n",ConstructCompilerData(theEnv)->ImageID,FLOAT_HASH_SIZE); for (i = 0; i < FLOAT_HASH_SIZE; i++) { if (floatTable[i] == NULL) { fprintf(fp,"NULL"); } else PrintFloatReference(theEnv,fp,floatTable[i]); if (i + 1 != FLOAT_HASH_SIZE) fprintf(fp,",\n"); } fprintf(fp,"};\n"); GenClose(theEnv,fp); /*=======================================*/ /* Write the code for the integer table. */ /*=======================================*/ integerTable = GetIntegerTable(theEnv); if ((fp = NewCFile(theEnv,fileName,1,3,FALSE)) == NULL) return(0); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct integerHashNode *iht%d[];\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp,"struct integerHashNode *iht%d[%d] = {\n",ConstructCompilerData(theEnv)->ImageID,INTEGER_HASH_SIZE); for (i = 0; i < INTEGER_HASH_SIZE; i++) { if (integerTable[i] == NULL) { fprintf(fp,"NULL"); } else PrintIntegerReference(theEnv,fp,integerTable[i]); if (i + 1 != INTEGER_HASH_SIZE) fprintf(fp,",\n"); } fprintf(fp,"};\n"); GenClose(theEnv,fp); /*======================================*/ /* Write the code for the bitmap table. */ /*======================================*/ bitMapTable = GetBitMapTable(theEnv); if ((fp = NewCFile(theEnv,fileName,1,4,FALSE)) == NULL) return(0); fprintf(ConstructCompilerData(theEnv)->HeaderFP,"extern struct bitMapHashNode *bmht%d[];\n",ConstructCompilerData(theEnv)->ImageID); fprintf(fp,"struct bitMapHashNode *bmht%d[%d] = {\n",ConstructCompilerData(theEnv)->ImageID,BITMAP_HASH_SIZE); for (i = 0; i < BITMAP_HASH_SIZE; i++) { PrintBitMapReference(theEnv,fp,bitMapTable[i]); if (i + 1 != BITMAP_HASH_SIZE) fprintf(fp,",\n"); } fprintf(fp,"};\n"); GenClose(theEnv,fp); return(1); } /*****************************************************/ /* PrintSymbolReference: Prints the C code reference */ /* address to the specified symbol (also used for */ /* strings and instance names). */ /*****************************************************/ globle void PrintSymbolReference( void *theEnv, FILE *theFile, struct symbolHashNode *theSymbol) { if (theSymbol == NULL) fprintf(theFile,"NULL"); else fprintf(theFile,"&S%d_%d[%d]", ConstructCompilerData(theEnv)->ImageID, (int) (theSymbol->bucket / ConstructCompilerData(theEnv)->MaxIndices) + 1, (int) theSymbol->bucket % ConstructCompilerData(theEnv)->MaxIndices); } /****************************************************/ /* PrintFloatReference: Prints the C code reference */ /* address to the specified float. */ /****************************************************/ globle void PrintFloatReference( void *theEnv, FILE *theFile, struct floatHashNode *theFloat) { fprintf(theFile,"&F%d_%d[%d]", ConstructCompilerData(theEnv)->ImageID, (int) (theFloat->bucket / ConstructCompilerData(theEnv)->MaxIndices) + 1, (int) theFloat->bucket % ConstructCompilerData(theEnv)->MaxIndices); } /******************************************************/ /* PrintIntegerReference: Prints the C code reference */ /* address to the specified integer. */ /******************************************************/ globle void PrintIntegerReference( void *theEnv, FILE *theFile, struct integerHashNode *theInteger) { fprintf(theFile,"&I%d_%d[%d]", ConstructCompilerData(theEnv)->ImageID, (int) (theInteger->bucket / ConstructCompilerData(theEnv)->MaxIndices) + 1, (int) theInteger->bucket % ConstructCompilerData(theEnv)->MaxIndices); } /*****************************************************/ /* PrintBitMapReference: Prints the C code reference */ /* address to the specified bit map. */ /*****************************************************/ globle void PrintBitMapReference( void *theEnv, FILE *theFile, struct bitMapHashNode *theBitMap) { if (theBitMap == NULL) fprintf(theFile,"NULL"); else fprintf(theFile,"&B%d_%d[%d]", ConstructCompilerData(theEnv)->ImageID, (int) (theBitMap->bucket / ConstructCompilerData(theEnv)->MaxIndices) + 1, (int) theBitMap->bucket % ConstructCompilerData(theEnv)->MaxIndices); } /*********************************************************/ /* PrintCString: Prints KB strings in the appropriate */ /* format for C (the " and \ characters are preceeded */ /* by a \ and carriage returns are replaced with \n). */ /*********************************************************/ static void PrintCString( FILE *theFile, char *str) { unsigned i; size_t slen; /*============================================*/ /* Print the string's opening quotation mark. */ /*============================================*/ fprintf(theFile,"\""); /*===============================================*/ /* Convert and write each character to the file. */ /*===============================================*/ slen = strlen(str); for (i = 0 ; i < slen ; i++) { /*====================================*/ /* Preceed " and \ with the \ escape. */ /*====================================*/ if ((str[i] == '"') || (str[i] == '\\')) { fputc('\\',theFile); fputc(str[i],theFile); } /*====================================*/ /* Replace a carriage return with \n. */ /*====================================*/ else if (str[i] == '\n') { fputc('\\',theFile); fputc('n',theFile); } /*===============================*/ /* All other characters can be */ /* printed without modification. */ /*===============================*/ else { fputc(str[i],theFile); } } /*============================================*/ /* Print the string's closing quotation mark. */ /*============================================*/ fprintf(theFile,"\""); } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ clips-6.24/clipssrc/generate.c0000755000175000017500000010520107422634654014503 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* GENERATE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for converting field */ /* constraints to expressions which can be used */ /* in the pattern and join networks. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _GENERATE_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "symbol.h" #include "exprnpsr.h" #include "argacces.h" #include "extnfunc.h" #include "router.h" #include "ruledef.h" #include "pattern.h" #include "generate.h" #if DEFGLOBAL_CONSTRUCT #include "globlpsr.h" #endif /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ExtractAnds(void *,struct lhsParseNode *,int, struct expr **,struct expr **); static void ExtractFieldTest(void *,struct lhsParseNode *,int, struct expr **,struct expr **); static struct expr *GetfieldReplace(void *,struct lhsParseNode *); static struct expr *GenPNConstant(void *,struct lhsParseNode *); static struct expr *GenJNConstant(void *,struct lhsParseNode *); static struct expr *GenJNColon(void *,struct lhsParseNode *); static struct expr *GenPNColon(void *,struct lhsParseNode *); static struct expr *GenJNEq(void *,struct lhsParseNode *); static struct expr *GenPNEq(void *,struct lhsParseNode *); static struct expr *GenJNVariableComparison(void *,struct lhsParseNode *, struct lhsParseNode *); static struct expr *GenPNVariableComparison(void *,struct lhsParseNode *, struct lhsParseNode *); static int AllVariablesInPattern(struct lhsParseNode *, int); static int AllVariablesInExpression(struct lhsParseNode *, int); /*******************************************************/ /* FieldConversion: Generates join and pattern network */ /* expressions for a field constraint. */ /*******************************************************/ globle void FieldConversion( void *theEnv, struct lhsParseNode *theField, struct lhsParseNode *thePattern) { int testInPatternNetwork = TRUE; struct lhsParseNode *patternPtr; struct expr *headOfPNExpression, *headOfJNExpression; struct expr *lastPNExpression, *lastJNExpression; struct expr *tempExpression; struct expr *patternNetTest = NULL; struct expr *joinNetTest = NULL; /*==================================================*/ /* Consider a NULL pointer to be an internal error. */ /*==================================================*/ if (theField == NULL) { SystemError(theEnv,"ANALYSIS",3); EnvExitRouter(theEnv,EXIT_FAILURE); } /*========================================================*/ /* Determine if constant testing must be performed in the */ /* join network. Only possible when a field contains an */ /* or ('|') and references are made to variables outside */ /* the pattern. */ /*========================================================*/ if (theField->bottom != NULL) { if (theField->bottom->bottom != NULL) { testInPatternNetwork = AllVariablesInPattern(theField->bottom,theField->pattern); } } /*=============================================================*/ /* Extract pattern and join network expressions. Loop through */ /* the or'ed constraints of the field, extracting pattern and */ /* join network expressions and adding them to a running list. */ /*=============================================================*/ headOfPNExpression = lastPNExpression = NULL; headOfJNExpression = lastJNExpression = NULL; for (patternPtr = theField->bottom; patternPtr != NULL; patternPtr = patternPtr->bottom) { /*=============================================*/ /* Extract pattern and join network tests from */ /* the or'ed constraint being examined. */ /*=============================================*/ ExtractAnds(theEnv,patternPtr,testInPatternNetwork,&patternNetTest,&joinNetTest); /*=====================================================*/ /* Add the new pattern network expressions to the list */ /* of pattern network expressions being constructed. */ /*=====================================================*/ if (patternNetTest != NULL) { if (lastPNExpression == NULL) { headOfPNExpression = patternNetTest; } else { lastPNExpression->nextArg = patternNetTest; } lastPNExpression = patternNetTest; } /*==================================================*/ /* Add the new join network expressions to the list */ /* of join network expressions being constructed. */ /*==================================================*/ if (joinNetTest != NULL) { if (lastJNExpression == NULL) { headOfJNExpression = joinNetTest; } else { lastJNExpression->nextArg = joinNetTest; } lastJNExpression = joinNetTest; } } /*==========================================================*/ /* If there was more than one expression generated from the */ /* or'ed field constraints for the pattern network, then */ /* enclose the expressions within an "or" function call. */ /*==========================================================*/ if ((headOfPNExpression != NULL) ? (headOfPNExpression->nextArg != NULL) : FALSE) { tempExpression = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_OR); tempExpression->argList = headOfPNExpression; headOfPNExpression = tempExpression; } /*==========================================================*/ /* If there was more than one expression generated from the */ /* or'ed field constraints for the join network, then */ /* enclose the expressions within an "or" function call. */ /*==========================================================*/ if ((headOfJNExpression != NULL) ? (headOfJNExpression->nextArg != NULL) : FALSE) { tempExpression = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_OR); tempExpression->argList = headOfJNExpression; headOfJNExpression = tempExpression; } /*===============================================================*/ /* If the field constraint binds a variable that was previously */ /* bound somewhere in the LHS of the rule, then generate an */ /* expression to compare this binding occurrence of the variable */ /* to the previous binding occurrence. */ /*===============================================================*/ if (((theField->type == MF_VARIABLE) || (theField->type == SF_VARIABLE)) && (theField->referringNode != NULL)) { /*================================================================*/ /* If the previous variable reference is within the same pattern, */ /* then the variable comparison can occur in the pattern network. */ /*================================================================*/ if (theField->referringNode->pattern == theField->pattern) { tempExpression = GenPNVariableComparison(theEnv,theField,theField->referringNode); headOfPNExpression = CombineExpressions(theEnv,tempExpression,headOfPNExpression); } /*====================================*/ /* Otherwise, the variable comparison */ /* must occur in the join network. */ /*====================================*/ else if (theField->referringNode->pattern > 0) { tempExpression = GenJNVariableComparison(theEnv,theField,theField->referringNode); headOfJNExpression = CombineExpressions(theEnv,tempExpression,headOfJNExpression); } } /*======================================================*/ /* Attach the pattern network expressions to the field. */ /*======================================================*/ theField->networkTest = headOfPNExpression; /*=====================================================*/ /* Attach the join network expressions to the pattern. */ /*=====================================================*/ thePattern->networkTest = CombineExpressions(theEnv,thePattern->networkTest,headOfJNExpression); } /****************************************************************************/ /* ExtractAnds: Loops through a single set of subfields bound together by */ /* an & connective constraint in a field and generates expressions needed */ /* for testing conditions in the pattern and join network. */ /****************************************************************************/ static void ExtractAnds( void *theEnv, struct lhsParseNode *andField, int testInPatternNetwork, struct expr **patternNetTest, struct expr **joinNetTest) { struct expr *newPNTest, *newJNTest; /*=================================================*/ /* Before starting, the subfield has no pattern or */ /* join network expressions associated with it. */ /*=================================================*/ *patternNetTest = NULL; *joinNetTest = NULL; /*=========================================*/ /* Loop through each of the subfields tied */ /* together by the & constraint. */ /*=========================================*/ for (; andField != NULL; andField = andField->right) { /*======================================*/ /* Extract the pattern and join network */ /* expressions from the subfield. */ /*======================================*/ ExtractFieldTest(theEnv,andField,testInPatternNetwork,&newPNTest,&newJNTest); /*=================================================*/ /* Add the new expressions to the list of pattern */ /* and join network expressions being constructed. */ /*=================================================*/ *patternNetTest = CombineExpressions(theEnv,*patternNetTest,newPNTest); *joinNetTest = CombineExpressions(theEnv,*joinNetTest,newJNTest); } } /************************************************************************/ /* ExtractFieldTest: Generates the pattern or join network expression */ /* associated with the basic field constraints: constants, predicate, */ /* return value, and variable constraints. Based on the context in */ /* which a constraint is used, some constraints may be tested in the */ /* pattern network while other constraints must be tested in the join */ /* network. Constraints which refer to variables in other patterns */ /* must be tested in the join network. The predicate constraint */ /* associated with a test CE is tested in the join network (even if */ /* all the variables it refers to are contained in the previous */ /* pattern CE). If one of the or'ed constraints in a field refers to */ /* a binding occurrence of a variable in another pattern, then the */ /* other constraints in the field must be tested in the join network */ /* (this is how some constant constraint tests must occasionally be */ /* performed in the join network). */ /************************************************************************/ static void ExtractFieldTest( void *theEnv, struct lhsParseNode *theField, int testInPatternNetwork, struct expr **patternNetTest, struct expr **joinNetTest) { *patternNetTest = NULL; *joinNetTest = NULL; /*==========================================================*/ /* Generate a network expression for a constant constraint. */ /*==========================================================*/ if ((theField->type == STRING) || (theField->type == SYMBOL) || #if OBJECT_SYSTEM (theField->type == INSTANCE_NAME) || #endif (theField->type == FLOAT) || (theField->type == INTEGER)) { if (testInPatternNetwork == TRUE) { *patternNetTest = GenPNConstant(theEnv,theField); } else { *joinNetTest = GenJNConstant(theEnv,theField); } } /*===========================================================*/ /* Generate a network expression for a predicate constraint. */ /*===========================================================*/ else if (theField->type == PREDICATE_CONSTRAINT) { if ((testInPatternNetwork == TRUE) && (AllVariablesInExpression(theField->expression,theField->pattern) == TRUE)) { *patternNetTest = GenPNColon(theEnv,theField); } else { *joinNetTest = GenJNColon(theEnv,theField); } } /*==============================================================*/ /* Generate a network expression for a return value constraint. */ /*==============================================================*/ else if (theField->type == RETURN_VALUE_CONSTRAINT) { if ((testInPatternNetwork == TRUE) && (AllVariablesInExpression(theField->expression,theField->pattern) == TRUE)) { *patternNetTest = GenPNEq(theEnv,theField); } else { *joinNetTest = GenJNEq(theEnv,theField); } } /*=====================================================================*/ /* Generate a network expression for a variable comparison constraint. */ /*=====================================================================*/ else if ((theField->type == SF_VARIABLE) || (theField->type == MF_VARIABLE)) { if ((testInPatternNetwork == TRUE) && ((theField->referringNode != NULL) ? (theField->referringNode->pattern == theField->pattern) : FALSE)) { *patternNetTest = GenPNVariableComparison(theEnv,theField,theField->referringNode); } else { *joinNetTest = GenJNVariableComparison(theEnv,theField,theField->referringNode); } } } /*********************************************************/ /* GenPNConstant: Generates an expression for use in the */ /* pattern network of a data entity (such as a fact or */ /* instance). The expression generated is for comparing */ /* a constant value against a specified slot/field in */ /* the data entity for equality or inequality. */ /*********************************************************/ static struct expr *GenPNConstant( void *theEnv, struct lhsParseNode *theField) { struct expr *top; /*===============================================*/ /* If the pattern parser is capable of creating */ /* a specialized test, then call the function to */ /* generate the pattern network test and return */ /* the expression generated. */ /*===============================================*/ if (theField->patternType->genPNConstantFunction != NULL) { return (*theField->patternType->genPNConstantFunction)(theEnv,theField); } /*===================================================*/ /* Otherwise, generate a test which uses the eq/neq */ /* function to compare the pattern field/slot to the */ /* constant and then return the expression. */ /*===================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } top->argList = (*theField->patternType->genGetPNValueFunction)(theEnv,theField); top->argList->nextArg = GenConstant(theEnv,theField->type,theField->value); return(top); } /************************************************************/ /* GenJNConstant: Generates an expression for use in the */ /* join network. The expression generated is for comparing */ /* a constant value against a specified slot/field in the */ /* data entity for equality or inequality. */ /************************************************************/ static struct expr *GenJNConstant( void *theEnv, struct lhsParseNode *theField) { struct expr *top; /*===============================================*/ /* If the pattern parser is capable of creating */ /* a specialized test, then call the function to */ /* generate the join network test and return the */ /* expression generated. */ /*===============================================*/ if (theField->patternType->genJNConstantFunction != NULL) { return (*theField->patternType->genJNConstantFunction)(theEnv,theField); } /*===================================================*/ /* Otherwise, generate a test which uses the eq/neq */ /* function to compare the pattern field/slot to the */ /* constant and then return the expression. */ /*===================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,theField); top->argList->nextArg = GenConstant(theEnv,theField->type,theField->value); return(top); } /******************************************************/ /* GenJNColon: Generates an expression for use in the */ /* join network. The expression generated is for a */ /* predicate field constraint (the : constraint). */ /******************************************************/ static struct expr *GenJNColon( void *theEnv, struct lhsParseNode *theField) { struct expr *top, *conversion; /*==================================================*/ /* Replace variables with function calls to extract */ /* the appropriate value from the data entity. */ /*==================================================*/ conversion = GetvarReplace(theEnv,theField->expression); /*================================================*/ /* If the predicate constraint is negated by a ~, */ /* then wrap a "not" function call around the */ /* expression before returning it. Otherwise, */ /* just return the expression. */ /*================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NOT); top->argList = conversion; } else { top = conversion; } return(top); } /******************************************************/ /* GenPNColon: Generates an expression for use in the */ /* pattern network. The expression generated is for */ /* a predicate field constraint (the : constraint). */ /******************************************************/ static struct expr *GenPNColon( void *theEnv, struct lhsParseNode *theField) { struct expr *top, *conversion; /*==================================================*/ /* Replace variables with function calls to extract */ /* the appropriate value from the data entity. */ /*==================================================*/ conversion = GetfieldReplace(theEnv,theField->expression); /*================================================*/ /* If the predicate constraint is negated by a ~, */ /* then wrap a "not" function call around the */ /* expression before returning it. Otherwise, */ /* just return the expression. */ /*================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NOT); top->argList = conversion; } else { top = conversion; } return(top); } /******************************************************/ /* GenJNEq: Generates an expression for use in the */ /* join network. The expression generated is for a */ /* return value field constraint (the = constraint). */ /******************************************************/ static struct expr *GenJNEq( void *theEnv, struct lhsParseNode *theField) { struct expr *top, *conversion; /*==================================================*/ /* Replace variables with function calls to extract */ /* the appropriate value from the data entity. */ /*==================================================*/ conversion = GetvarReplace(theEnv,theField->expression); /*============================================================*/ /* If the return value constraint is negated by a ~, then use */ /* the neq function to compare the value of the field to the */ /* value returned by the function call. Otherwise, use eq to */ /* compare the two values. */ /*============================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,theField); top->argList->nextArg = conversion; return(top); } /*******************************************************/ /* GenPNEq: Generates an expression for use in the */ /* pattern network. The expression generated is for a */ /* return value field constraint (the = constraint). */ /*******************************************************/ static struct expr *GenPNEq( void *theEnv, struct lhsParseNode *theField) { struct expr *top, *conversion; /*==================================================*/ /* Replace variables with function calls to extract */ /* the appropriate value from the data entity. */ /*==================================================*/ conversion = GetfieldReplace(theEnv,theField->expression); /*============================================================*/ /* If the return value constraint is negated by a ~, then use */ /* the neq function to compare the value of the field to the */ /* value returned by the function call. Otherwise, use eq to */ /* compare the two values. */ /*============================================================*/ if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } top->argList = (*theField->patternType->genGetPNValueFunction)(theEnv,theField); top->argList->nextArg = conversion; return(top); } /******************************************************************/ /* GetvarReplace: Replaces occurences of variables in expressions */ /* with function calls that will extract the variable's value */ /* from a partial match (i.e. from information stored in the */ /* join network or the activation of the rule). */ /******************************************************************/ globle struct expr *GetvarReplace( void *theEnv, struct lhsParseNode *nodeList) { struct expr *newList; /*====================================*/ /* Return NULL for a NULL pointer */ /* (i.e. nothing has to be replaced). */ /*====================================*/ if (nodeList == NULL) return(NULL); /*=====================================================*/ /* Create an expression data structure and recursively */ /* replace variables in its argument list and next */ /* argument links. */ /*=====================================================*/ newList = get_struct(theEnv,expr); newList->type = nodeList->type; newList->value = nodeList->value; newList->nextArg = GetvarReplace(theEnv,nodeList->right); newList->argList = GetvarReplace(theEnv,nodeList->bottom); /*=========================================================*/ /* If the present node being examined is either a local or */ /* global variable, then replace it with a function call */ /* that will return the variable's value. */ /*=========================================================*/ if ((nodeList->type == SF_VARIABLE) || (nodeList->type == MF_VARIABLE)) { (*nodeList->referringNode->patternType->replaceGetJNValueFunction) (theEnv,newList,nodeList->referringNode); } #if DEFGLOBAL_CONSTRUCT else if (newList->type == GBL_VARIABLE) { ReplaceGlobalVariable(theEnv,newList); } #endif /*====================================================*/ /* Return the expression with its variables replaced. */ /*====================================================*/ return(newList); } /**********************************************************************/ /* GetfieldReplace: Replaces occurences of variables in expressions */ /* with function calls that will extract the variable's value */ /* given a pointer to the data entity that contains the value (i.e. */ /* from information stored in the pattern network). */ /**********************************************************************/ static struct expr *GetfieldReplace( void *theEnv, struct lhsParseNode *nodeList) { struct expr *newList; /*====================================*/ /* Return NULL for a NULL pointer */ /* (i.e. nothing has to be replaced). */ /*====================================*/ if (nodeList == NULL) return(NULL); /*=====================================================*/ /* Create an expression data structure and recursively */ /* replace variables in its argument list and next */ /* argument links. */ /*=====================================================*/ newList = get_struct(theEnv,expr); newList->type = nodeList->type; newList->value = nodeList->value; newList->nextArg = GetfieldReplace(theEnv,nodeList->right); newList->argList = GetfieldReplace(theEnv,nodeList->bottom); /*=========================================================*/ /* If the present node being examined is either a local or */ /* global variable, then replace it with a function call */ /* that will return the variable's value. */ /*=========================================================*/ if ((nodeList->type == SF_VARIABLE) || (nodeList->type == MF_VARIABLE)) { (*nodeList->referringNode->patternType->replaceGetPNValueFunction) (theEnv,newList,nodeList->referringNode); } #if DEFGLOBAL_CONSTRUCT else if (newList->type == GBL_VARIABLE) { ReplaceGlobalVariable(theEnv,newList); } #endif /*====================================================*/ /* Return the expression with its variables replaced. */ /*====================================================*/ return(newList); } /**************************************************************/ /* GenJNVariableComparison: Generates a join network test for */ /* comparing two variables found in different patterns. */ /**************************************************************/ static struct expr *GenJNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { struct expr *top; /*========================================================*/ /* If either pattern is missing a function for generating */ /* the appropriate test, then no test is generated. */ /*========================================================*/ if ((selfNode->patternType->genCompareJNValuesFunction == NULL) || (referringNode->patternType->genCompareJNValuesFunction == NULL)) { return(NULL); } /*=====================================================*/ /* If both patterns are of the same type, then use the */ /* special function for generating the join test. */ /*=====================================================*/ if (selfNode->patternType->genCompareJNValuesFunction == referringNode->patternType->genCompareJNValuesFunction) { return (*selfNode->patternType->genCompareJNValuesFunction)(theEnv,selfNode, referringNode); } /*===========================================================*/ /* If the patterns are of different types, then generate a */ /* join test by using the eq/neq function with its arguments */ /* being function calls to retrieve the appropriate values */ /* from the patterns. */ /*===========================================================*/ if (selfNode->negated) top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); else top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); top->argList = (*selfNode->patternType->genGetJNValueFunction)(theEnv,selfNode); top->argList->nextArg = (*referringNode->patternType->genGetJNValueFunction)(theEnv,referringNode); return(top); } /*************************************************************/ /* GenPNVariableComparison: Generates a pattern network test */ /* for comparing two variables found in the same pattern. */ /*************************************************************/ static struct expr *GenPNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { if (selfNode->patternType->genComparePNValuesFunction != NULL) { return (*selfNode->patternType->genComparePNValuesFunction)(theEnv,selfNode,referringNode); } return(NULL); } /************************************************************/ /* AllVariablesInPattern: Determines if all of the variable */ /* references in a field constraint can be referenced */ /* within thepattern in which the field is contained. */ /************************************************************/ static int AllVariablesInPattern( struct lhsParseNode *orField, int pattern) { struct lhsParseNode *andField; /*=========================================*/ /* Loop through each of the | constraints. */ /*=========================================*/ for (; orField != NULL; orField = orField->bottom) { /*=========================================*/ /* Loop through each of the & constraints. */ /*=========================================*/ for (andField = orField; andField != NULL; andField = andField->right) { /*========================================================*/ /* If a variable is found, make sure the pattern in which */ /* the variable was previously bound is the same as the */ /* pattern being checked. */ /*========================================================*/ if ((andField->type == SF_VARIABLE) || (andField->type == MF_VARIABLE)) { if (andField->referringNode->pattern != pattern) return(FALSE); } /*========================================================*/ /* Check predicate and return value constraints to see */ /* that all variables can be referenced from the pattern. */ /*========================================================*/ else if ((andField->type == PREDICATE_CONSTRAINT) || (andField->type == RETURN_VALUE_CONSTRAINT)) { if (AllVariablesInExpression(andField->expression,pattern) == FALSE) { return(FALSE); } } } } /*=====================================*/ /* All variables in the field can be */ /* referenced from within the pattern. */ /*=====================================*/ return(TRUE); } /**************************************************************************/ /* AllVariablesInExpression: Determines if all of the variable references */ /* in an expression can be referenced within the pattern in which the */ /* expression is contained. */ /**************************************************************************/ static int AllVariablesInExpression( struct lhsParseNode *theExpression, int pattern) { /*==========================================*/ /* Check all expressions in the right link. */ /*==========================================*/ for (; theExpression != NULL; theExpression = theExpression->right) { /*========================================================*/ /* If a variable is found, make sure the pattern in which */ /* the variable is bound is the same as the pattern being */ /* checked. */ /*========================================================*/ if ((theExpression->type == SF_VARIABLE) || (theExpression->type == MF_VARIABLE)) { if (theExpression->referringNode->pattern != pattern) return(FALSE); } /*=======================================================*/ /* Recursively check all expressions in the bottom link. */ /*=======================================================*/ if (AllVariablesInExpression(theExpression->bottom,pattern) == FALSE) { return(FALSE); } } /*========================================*/ /* All variables in the expression can be */ /* referenced from within the pattern. */ /*========================================*/ return(TRUE); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/rulecom.h0000755000175000017500000000426510441163734014363 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFRULE COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the matches command. Also provides the */ /* the developer commands show-joins and rule-complexity. */ /* Also provides the initialization routine which */ /* registers rule commands found in other modules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_rulecom #define _H_rulecom #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RULECOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define Matches(theEnv,a) EnvMatches(theEnv,a) #else #define Matches(a) EnvMatches(GetCurrentEnvironment(),a) #endif LOCALE intBool EnvMatches(void *,void *); LOCALE void DefruleCommands(void *); LOCALE void MatchesCommand(void *); #if DEVELOPER LOCALE void ShowJoinsCommand(void *); LOCALE long RuleComplexityCommand(void *); #endif #endif clips-6.24/clipssrc/._moduldef.h0000400000175000017500000000075410441150024014677 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z:DTTFS FMWBBMPSRclips-6.24/clipssrc/factfun.h0000755000175000017500000000657510443575363014360 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FACT FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Added ppfact command. */ /* */ /*************************************************************/ #ifndef _H_factfun #define _H_factfun #ifndef _H_factmngr #include "factmngr.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define FactDeftemplate(theEnv,a) EnvFactDeftemplate(theEnv,a) #define FactExistp(theEnv,a) EnvFactExistp(theEnv,a) #define FactSlotNames(theEnv,a,b) EnvFactSlotNames(theEnv,a,b) #define GetFactList(theEnv,a,b) EnvGetFactList(theEnv,a,b) #define PPFact(theEnv,a,b,c) EnvPPFact(theEnv,a,b,c) #else #define FactDeftemplate(a) EnvFactDeftemplate(GetCurrentEnvironment(),a) #define FactExistp(a) EnvFactExistp(GetCurrentEnvironment(),a) #define FactSlotNames(a,b) EnvFactSlotNames(GetCurrentEnvironment(),a,b) #define GetFactList(a,b) EnvGetFactList(GetCurrentEnvironment(),a,b) #define PPFact(a,b,c) EnvPPFact(GetCurrentEnvironment(),a,b,c) #endif LOCALE void FactFunctionDefinitions(void *); LOCALE void *FactRelationFunction(void *); LOCALE void *FactRelation(void *); LOCALE void *EnvFactDeftemplate(void *,void *); LOCALE int FactExistpFunction(void *); LOCALE int EnvFactExistp(void *,void *); LOCALE void FactSlotValueFunction(void *,DATA_OBJECT *); LOCALE void FactSlotValue(void *,void *,char *,DATA_OBJECT *); LOCALE void FactSlotNamesFunction(void *,DATA_OBJECT *); LOCALE void EnvFactSlotNames(void *,void *,DATA_OBJECT *); LOCALE void GetFactListFunction(void *,DATA_OBJECT *); LOCALE void EnvGetFactList(void *,DATA_OBJECT *,void *); LOCALE void PPFactFunction(void *); LOCALE void EnvPPFact(void *,void *,char *,int); LOCALE struct fact *GetFactAddressOrIndexArgument(void *,char *,int,int); #endif clips-6.24/clipssrc/._modulutl.c0000400000175000017500000000075407422634564014765 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zp$<$Q"TTFtFMWBBMPSRclips-6.24/clipssrc/._dfinscmp.h0000400000175000017500000000012207422634756014720 0ustar jfsjfsMac OS X  2 RTEXT???? clips-6.24/clipssrc/._conscomp.c0000400000175000017500000000075410441602076014725 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0p0pS+TTFL(FMPSRMWBBLclips-6.24/clipssrc/prdctfun.h0000755000175000017500000000553210441150621014527 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* PREDICATE FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_prdctfun #define _H_prdctfun #ifdef LOCALE #undef LOCALE #endif #ifdef _PRDCTFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void PredicateFunctionDefinitions(void *); LOCALE intBool EqFunction(void *); LOCALE intBool NeqFunction(void *); LOCALE intBool StringpFunction(void *); LOCALE intBool SymbolpFunction(void *); LOCALE intBool LexemepFunction(void *); LOCALE intBool NumberpFunction(void *); LOCALE intBool FloatpFunction(void *); LOCALE intBool IntegerpFunction(void *); LOCALE intBool MultifieldpFunction(void *); LOCALE intBool PointerpFunction(void *); LOCALE intBool NotFunction(void *); LOCALE intBool AndFunction(void *); LOCALE intBool OrFunction(void *); LOCALE intBool LessThanOrEqualFunction(void *); LOCALE intBool GreaterThanOrEqualFunction(void *); LOCALE intBool LessThanFunction(void *); LOCALE intBool GreaterThanFunction(void *); LOCALE intBool NumericEqualFunction(void *); LOCALE intBool NumericNotEqualFunction(void *); LOCALE intBool OddpFunction(void *); LOCALE intBool EvenpFunction(void *); #endif clips-6.24/clipssrc/._tmpltbin.c0000400000175000017500000000075410171403615014733 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoFdFd cU5U=RTTF|AD?FMWBBMPSRclips-6.24/clipssrc/._reteutil.c0000400000175000017500000000075410441162421014734 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco,9=,9=Q! TTF/BjFMPSRMWBBLclips-6.24/clipssrc/constrnt.h0000755000175000017500000001176310441131400014551 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for creating and removing */ /* constraint records, adding them to the contraint hash */ /* table, and enabling and disabling static and dynamic */ /* constraint checking. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_constrnt #define _H_constrnt struct constraintRecord; #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CONSTRNT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct constraintRecord { unsigned int anyAllowed : 1; unsigned int symbolsAllowed : 1; unsigned int stringsAllowed : 1; unsigned int floatsAllowed : 1; unsigned int integersAllowed : 1; unsigned int instanceNamesAllowed : 1; unsigned int instanceAddressesAllowed : 1; unsigned int externalAddressesAllowed : 1; unsigned int factAddressesAllowed : 1; unsigned int voidAllowed : 1; unsigned int anyRestriction : 1; unsigned int symbolRestriction : 1; unsigned int stringRestriction : 1; unsigned int floatRestriction : 1; unsigned int integerRestriction : 1; unsigned int classRestriction : 1; unsigned int instanceNameRestriction : 1; unsigned int multifieldsAllowed : 1; unsigned int singlefieldsAllowed : 1; unsigned short bsaveIndex; struct expr *classList; struct expr *restrictionList; struct expr *minValue; struct expr *maxValue; struct expr *minFields; struct expr *maxFields; struct constraintRecord *multifield; struct constraintRecord *next; int bucket; int count; }; typedef struct constraintRecord CONSTRAINT_RECORD; #define SIZE_CONSTRAINT_HASH 167 #define CONSTRAINT_DATA 43 struct constraintData { struct constraintRecord **ConstraintHashtable; intBool StaticConstraintChecking; intBool DynamicConstraintChecking; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) struct constraintRecord *ConstraintArray; long int NumberOfConstraints; #endif }; #define ConstraintData(theEnv) ((struct constraintData *) GetEnvironmentData(theEnv,CONSTRAINT_DATA)) #if ENVIRONMENT_API_ONLY #define GetDynamicConstraintChecking(theEnv) EnvGetDynamicConstraintChecking(theEnv) #define GetStaticConstraintChecking(theEnv) EnvGetStaticConstraintChecking(theEnv) #define SetDynamicConstraintChecking(theEnv,a) EnvSetDynamicConstraintChecking(theEnv,a) #define SetStaticConstraintChecking(theEnv,a) EnvSetStaticConstraintChecking(theEnv,a) #else #define GetDynamicConstraintChecking() EnvGetDynamicConstraintChecking(GetCurrentEnvironment()) #define GetStaticConstraintChecking() EnvGetStaticConstraintChecking(GetCurrentEnvironment()) #define SetDynamicConstraintChecking(a) EnvSetDynamicConstraintChecking(GetCurrentEnvironment(),a) #define SetStaticConstraintChecking(a) EnvSetStaticConstraintChecking(GetCurrentEnvironment(),a) #endif LOCALE void InitializeConstraints(void *); LOCALE int GDCCommand(void *); LOCALE int SDCCommand(void *d); LOCALE int GSCCommand(void *); LOCALE int SSCCommand(void *); LOCALE intBool EnvSetDynamicConstraintChecking(void *,int); LOCALE intBool EnvGetDynamicConstraintChecking(void *); LOCALE intBool EnvSetStaticConstraintChecking(void *,int); LOCALE intBool EnvGetStaticConstraintChecking(void *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int HashConstraint(struct constraintRecord *); LOCALE struct constraintRecord *AddConstraint(void *,struct constraintRecord *); #endif #if (! RUN_TIME) LOCALE void RemoveConstraint(void *,struct constraintRecord *); #endif #endif clips-6.24/clipssrc/._tmpltbin.h0000400000175000017500000000012207422634610014733 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._dffnxpsr.c0000400000175000017500000000075410441602133014730 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0mc0mc,TTFL(FMPSRMWBBLclips-6.24/clipssrc/._envrnmnt.c0000400000175000017500000000075410441602147014752 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0f0fn8TTFHFMWBBMPSRclips-6.24/clipssrc/._globldef.c0000400000175000017500000000075410441602221014652 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacolnln1llTTFL,FMPSRMWBBLclips-6.24/clipssrc/._factbin.c0000400000175000017500000000075407422634570014523 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoH!H!pmTTF{DKFMWBBMPSRclips-6.24/clipssrc/inherpsr.h0000755000175000017500000000320407422634770014547 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_inherpsr #define _H_inherpsr #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #ifndef _H_object #include "object.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INHERPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE PACKED_CLASS_LINKS *ParseSuperclasses(void *,char *,SYMBOL_HN *); LOCALE PACKED_CLASS_LINKS *FindPrecedenceList(void *,DEFCLASS *,PACKED_CLASS_LINKS *); LOCALE void PackClassLinks(void *,PACKED_CLASS_LINKS *,CLASS_LINK *); #ifndef _INHERPSR_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/factqury.c0000644000175000017500000012522310441602207014532 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Query Functions for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.23: Added fact-set queries. */ /* */ /* 6.24: Corrected errors when compiling as a C++ file. */ /* DR0868 */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if FACT_SET_QUERIES #include "argacces.h" #include "envrnmnt.h" #include "memalloc.h" #include "exprnpsr.h" #include "modulutl.h" #include "tmpltutl.h" #include "insfun.h" #include "factqpsr.h" #include "prcdrfun.h" #include "router.h" #include "utility.h" #define _FACTQURY_SOURCE_ #include "factqury.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PushQueryCore(void *); static void PopQueryCore(void *); static QUERY_CORE *FindQueryCore(void *,int); static QUERY_TEMPLATE *DetermineQueryTemplates(void *,EXPRESSION *,char *,unsigned *); static QUERY_TEMPLATE *FormChain(void *,char *,DATA_OBJECT *); static void DeleteQueryTemplates(void *,QUERY_TEMPLATE *); static int TestForFirstInChain(void *,QUERY_TEMPLATE *,int); static int TestForFirstFactInTemplate(void *,struct deftemplate *,QUERY_TEMPLATE *,int); static void TestEntireChain(void *,QUERY_TEMPLATE *,int); static void TestEntireTemplate(void *,struct deftemplate *,QUERY_TEMPLATE *,int); static void AddSolution(void *); static void PopQuerySoln(void *); /**************************************************** NAME : SetupFactQuery DESCRIPTION : Initializes fact query H/L functions and parsers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Sets up kernel functions and parsers NOTES : None ****************************************************/ globle void SetupFactQuery( void *theEnv) { AllocateEnvironmentData(theEnv,FACT_QUERY_DATA,sizeof(struct factQueryData),NULL); #if ! RUN_TIME FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,QUERY_DELIMETER_STRING); IncrementSymbolCount(FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); EnvDefineFunction2(theEnv,"(query-fact)",'u', PTIEF GetQueryFact,"GetQueryFact",NULL); EnvDefineFunction2(theEnv,"(query-fact-slot)",'u', PTIEF GetQueryFactSlot,"GetQueryFactSlot",NULL); EnvDefineFunction2(theEnv,"any-factp",'b',PTIEF AnyFacts,"AnyFacts",NULL); AddFunctionParser(theEnv,"any-factp",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"find-fact",'m', PTIEF QueryFindFact,"QueryFindFact",NULL); AddFunctionParser(theEnv,"find-fact",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"find-all-facts",'m', PTIEF QueryFindAllFacts,"QueryFindAllFacts",NULL); AddFunctionParser(theEnv,"find-all-facts",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"do-for-fact",'u', PTIEF QueryDoForFact,"QueryDoForFact",NULL); AddFunctionParser(theEnv,"do-for-fact",FactParseQueryAction); EnvDefineFunction2(theEnv,"do-for-all-facts",'u', PTIEF QueryDoForAllFacts,"QueryDoForAllFacts",NULL); AddFunctionParser(theEnv,"do-for-all-facts",FactParseQueryAction); EnvDefineFunction2(theEnv,"delayed-do-for-all-facts",'u', PTIEF DelayedQueryDoForAllFacts, "DelayedQueryDoForAllFacts",NULL); AddFunctionParser(theEnv,"delayed-do-for-all-facts",FactParseQueryAction); #endif } /************************************************************* NAME : GetQueryFact DESCRIPTION : Internal function for referring to fact array on fact-queries INPUTS : None RETURNS : The name of the specified fact-set member SIDE EFFECTS : None NOTES : H/L Syntax : ((query-fact) ) *************************************************************/ globle void GetQueryFact( void *theEnv, DATA_OBJECT *result) { register QUERY_CORE *core; core = FindQueryCore(theEnv,DOPToInteger(GetFirstArgument())); result->type = FACT_ADDRESS; result->value = core->solns[DOPToInteger(GetFirstArgument()->nextArg)]; /* return(GetFullInstanceName(theEnv,core->solns[DOPToInteger(GetFirstArgument()->nextArg)])); */ } /*************************************************************************** NAME : GetQueryFactSlot DESCRIPTION : Internal function for referring to slots of fact in fact array on fact-queries INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set appropriately NOTES : H/L Syntax : ((query-fact-slot) ) **************************************************************************/ globle void GetQueryFactSlot( void *theEnv, DATA_OBJECT *result) { struct fact *theFact; DATA_OBJECT temp; QUERY_CORE *core; short position; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); core = FindQueryCore(theEnv,DOPToInteger(GetFirstArgument())); theFact = core->solns[DOPToInteger(GetFirstArgument()->nextArg)]; EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"get",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theFact->whichDeftemplate->implied) { if (strcmp(ValueToString(temp.value),"implied") != 0) /* TBD - no str compare */ { SlotExistError(theEnv,ValueToString(temp.value),"fact-set query"); return; } position = 1; } else if (FindSlot((struct deftemplate *) theFact->whichDeftemplate, (struct symbolHashNode *) temp.value,&position) == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"fact-set query"); return; } result->type = theFact->theProposition.theFields[position-1].type; result->value = theFact->theProposition.theFields[position-1].value; if (result->type == MULTIFIELD) { SetpDOBegin(result,1); SetpDOEnd(result,((struct multifield *) result->value)->multifieldLength); } } /* ============================================================================= ============================================================================= Following are the instance query functions : any-factp : Determines if any facts satisfy the query find-fact : Finds first (set of) fact(s) which satisfies the query and stores it in a multi-field find-all-facts : Finds all (sets of) facts which satisfy the the query and stores them in a multi-field do-for-fact : Executes a given action for the first (set of) fact(s) which satisfy the query do-for-all-facts : Executes an action for all facts which satisfy the query as they are found delayed-do-for-all-facts : Same as above - except that the list of facts which satisfy the query is formed before any actions are executed Fact candidate search algorithm : All permutations of first restriction template facts with other restriction template facts (Rightmost are varied first) For any one template, fact are examined in the order they were defined Example : (deftemplate a (slot v)) (deftemplate b (slot v)) (deftemplate c (slot v)) (assert (a (v a1))) (assert (a (v a2))) (assert (b (v b1))) (assert (b (v b2))) (assert (c (v c1))) (assert (c (v c2))) (assert (d (v d1))) (assert (d (v d2))) (any-factp ((?a a b) (?b c)) ) The permutations (?a ?b) would be examined in the following order : (a1 c1),(a1 c2),(a2 c1),(a2 c2), (b1 c1),(b1 c2),(b2 c1),(b2 c2) ============================================================================= ============================================================================= */ /****************************************************************************** NAME : AnyFacts DESCRIPTION : Determines if there any existing facts which satisfy the query INPUTS : None RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on fact restrictions and how early the expression evaluates to TRUE - if at all). NOTES : H/L Syntax : See FactParseQueryNoAction() ******************************************************************************/ globle intBool AnyFacts( void *theEnv) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; int TestResult; qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg, "any-factp",&rcnt); if (qtemplates == NULL) return(FALSE); PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); TestResult = TestForFirstInChain(theEnv,qtemplates,0); FactQueryData(theEnv)->AbortQuery = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); return(TestResult); } /****************************************************************************** NAME : QueryFindFact DESCRIPTION : Finds the first set of facts which satisfy the query and stores their addresses in the user's multi-field variable INPUTS : Caller's result buffer RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on fact restrictions and how early the expression evaulates to TRUE - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindFact( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt,i; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg, "find-fact",&rcnt); if (qtemplates == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE) { result->value = (void *) EnvCreateMultifield(theEnv,rcnt); SetpDOEnd(result,rcnt); for (i = 1 ; i <= rcnt ; i++) { SetMFType(result->value,i,FACT_ADDRESS); SetMFValue(result->value,i,FactQueryData(theEnv)->QueryCore->solns[i - 1]); } } else result->value = (void *) EnvCreateMultifield(theEnv,0L); FactQueryData(theEnv)->AbortQuery = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /****************************************************************************** NAME : QueryFindAllFacts DESCRIPTION : Finds all sets of facts which satisfy the query and stores their names in the user's multi-field variable The sets are stored sequentially : Number of sets = (Multi-field length) / (Set length) The first set is if the first (set length) atoms of the multi-field variable, and so on. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated once for every fact set. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindAllFacts( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; register unsigned i,j; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg, "find-all-facts",&rcnt); if (qtemplates == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = NULL; FactQueryData(theEnv)->QueryCore->soln_set = NULL; FactQueryData(theEnv)->QueryCore->soln_size = rcnt; FactQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qtemplates,0); FactQueryData(theEnv)->AbortQuery = FALSE; result->value = (void *) EnvCreateMultifield(theEnv,FactQueryData(theEnv)->QueryCore->soln_cnt * rcnt); while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 , j = (unsigned) (result->end + 2) ; i < rcnt ; i++ , j++) { SetMFType(result->value,j,FACT_ADDRESS); SetMFValue(result->value,j,FactQueryData(theEnv)->QueryCore->soln_set->soln[i]); } result->end = (long) j-2; PopQuerySoln(theEnv); } rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /****************************************************************************** NAME : QueryDoForFact DESCRIPTION : Finds the first set of facts which satisfy the query and executes a user-action with that set INPUTS : None RETURNS : Caller's result buffer SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on fact restrictions and how early the expression evaulates to TRUE - if at all). Also the action expression is executed zero or once. Caller's result buffer holds result of user-action NOTES : H/L Syntax : See ParseQueryAction() ******************************************************************************/ globle void QueryDoForFact( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-fact",&rcnt); if (qtemplates == NULL) return; PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE) EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result); FactQueryData(theEnv)->AbortQuery = FALSE; ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /****************************************************************************** NAME : QueryDoForAllFacts DESCRIPTION : Finds all sets of facts which satisfy the query and executes a user-function for each set as it is found INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated once for every fact set. Also, the action is executed for every fact set. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See FactParseQueryAction() ******************************************************************************/ globle void QueryDoForAllFacts( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-all-facts",&rcnt); if (qtemplates == NULL) return; PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; FactQueryData(theEnv)->QueryCore->result = result; ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result); TestEntireChain(theEnv,qtemplates,0); ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result); PropagateReturnValue(theEnv,FactQueryData(theEnv)->QueryCore->result); FactQueryData(theEnv)->AbortQuery = FALSE; ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /****************************************************************************** NAME : DelayedQueryDoForAllFacts DESCRIPTION : Finds all sets of facts which satisfy the query and and exceutes a user-action for each set This function differs from QueryDoForAllFacts() in that it forms the complete list of query satisfactions BEFORE executing any actions. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated once for every fact set. The action is executed for evry query satisfaction. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See FactParseQueryNoAction() ******************************************************************************/ globle void DelayedQueryDoForAllFacts( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; register unsigned i; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg, "delayed-do-for-all-facts",&rcnt); if (qtemplates == NULL) return; PushQueryCore(theEnv); FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt)); FactQueryData(theEnv)->QueryCore->query = GetFirstArgument(); FactQueryData(theEnv)->QueryCore->action = NULL; FactQueryData(theEnv)->QueryCore->soln_set = NULL; FactQueryData(theEnv)->QueryCore->soln_size = rcnt; FactQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qtemplates,0); FactQueryData(theEnv)->AbortQuery = FALSE; FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 ; i < rcnt ; i++) FactQueryData(theEnv)->QueryCore->solns[i] = FactQueryData(theEnv)->QueryCore->soln_set->soln[i]; PopQuerySoln(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result); EvaluationData(theEnv)->CurrentEvaluationDepth--; if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { PropagateReturnValue(theEnv,result); } PeriodicCleanup(theEnv,FALSE,TRUE); if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) PopQuerySoln(theEnv); break; } } ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt)); rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryTemplates(theEnv,qtemplates); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : PushQueryCore DESCRIPTION : Pushes the current QueryCore onto stack INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Allocates new stack node and changes QueryCoreStack NOTES : None *******************************************************/ static void PushQueryCore( void *theEnv) { QUERY_STACK *qptr; qptr = get_struct(theEnv,query_stack); qptr->core = FactQueryData(theEnv)->QueryCore; qptr->nxt = FactQueryData(theEnv)->QueryCoreStack; FactQueryData(theEnv)->QueryCoreStack = qptr; } /****************************************************** NAME : PopQueryCore DESCRIPTION : Pops top of QueryCore stack and restores QueryCore to this core INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Stack node deallocated, QueryCoreStack changed and QueryCore reset NOTES : Assumes stack is not empty ******************************************************/ static void PopQueryCore( void *theEnv) { QUERY_STACK *qptr; FactQueryData(theEnv)->QueryCore = FactQueryData(theEnv)->QueryCoreStack->core; qptr = FactQueryData(theEnv)->QueryCoreStack; FactQueryData(theEnv)->QueryCoreStack = FactQueryData(theEnv)->QueryCoreStack->nxt; rtn_struct(theEnv,query_stack,qptr); } /*************************************************** NAME : FindQueryCore DESCRIPTION : Looks up a QueryCore Stack Frame Depth 0 is current frame 1 is next deepest, etc. INPUTS : Depth RETURNS : Address of query core stack frame SIDE EFFECTS : None NOTES : None ***************************************************/ static QUERY_CORE *FindQueryCore( void *theEnv, int depth) { QUERY_STACK *qptr; if (depth == 0) return(FactQueryData(theEnv)->QueryCore); qptr = FactQueryData(theEnv)->QueryCoreStack; while (depth > 1) { qptr = qptr->nxt; depth--; } return(qptr->core); } /********************************************************** NAME : DetermineQueryTemplates DESCRIPTION : Builds a list of templates to be used in fact queries - uses parse form. INPUTS : 1) The parse template expression chain 2) The name of the function being executed 3) Caller's buffer for restriction count (# of separate lists) RETURNS : The query list, or NULL on errors SIDE EFFECTS : Memory allocated for list Busy count incremented for all templates NOTES : Each restriction is linked by nxt pointer, multiple templates in a restriction are linked by the chain pointer. Rcnt caller's buffer is set to reflect the total number of chains Assumes classExp is not NULL and that each restriction chain is terminated with the QUERY_DELIMITER_SYMBOL "(QDS)" **********************************************************/ static QUERY_TEMPLATE *DetermineQueryTemplates( void *theEnv, EXPRESSION *templateExp, char *func, unsigned *rcnt) { QUERY_TEMPLATE *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp; int new_list = FALSE; DATA_OBJECT temp; *rcnt = 0; while (templateExp != NULL) { if (EvaluateExpression(theEnv,templateExp,&temp)) { DeleteQueryTemplates(theEnv,clist); return(NULL); } if ((temp.type == SYMBOL) && (temp.value == (void *) FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL)) { new_list = TRUE; (*rcnt)++; } else if ((tmp = FormChain(theEnv,func,&temp)) != NULL) { if (clist == NULL) clist = cnxt = cchain = tmp; else if (new_list == TRUE) { new_list = FALSE; cnxt->nxt = tmp; cnxt = cchain = tmp; } else cchain->chain = tmp; while (cchain->chain != NULL) cchain = cchain->chain; } else { SyntaxErrorMessage(theEnv,"fact-set query class restrictions"); DeleteQueryTemplates(theEnv,clist); SetEvaluationError(theEnv,TRUE); return(NULL); } templateExp = templateExp->nextArg; } return(clist); } /************************************************************* 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); } /****************************************************** NAME : DeleteQueryTemplates DESCRIPTION : Deletes a query class-list INPUTS : The query list address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated Busy count decremented for all templates NOTES : None ******************************************************/ static void DeleteQueryTemplates( void *theEnv, QUERY_TEMPLATE *qlist) { QUERY_TEMPLATE *tmp; while (qlist != NULL) { while (qlist->chain != NULL) { tmp = qlist->chain; qlist->chain = qlist->chain->chain; DecrementDeftemplateBusyCount(theEnv,(void *) tmp->templatePtr); rtn_struct(theEnv,query_template,tmp); } tmp = qlist; qlist = qlist->nxt; DecrementDeftemplateBusyCount(theEnv,(void *) tmp->templatePtr); rtn_struct(theEnv,query_template,tmp); } } /************************************************************ NAME : TestForFirstInChain DESCRIPTION : Processes all templates in a restriction chain until success or done INPUTS : 1) The current chain 2) The index of the chain restriction (e.g. the 4th query-variable) RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Sets current restriction class Fact variable values set NOTES : None ************************************************************/ static int TestForFirstInChain( void *theEnv, QUERY_TEMPLATE *qchain, int indx) { QUERY_TEMPLATE *qptr; FactQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { FactQueryData(theEnv)->AbortQuery = FALSE; if (TestForFirstFactInTemplate(theEnv,qptr->templatePtr,qchain,indx)) { return(TRUE); } if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) return(FALSE); } return(FALSE); } /***************************************************************** NAME : TestForFirstFactInTemplate DESCRIPTION : Processes all facts in a template INPUTS : 1) Visitation traversal id 2) The template 3) The current template restriction chain 4) The index of the current restriction RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Fact variable values set NOTES : None *****************************************************************/ static int TestForFirstFactInTemplate( void *theEnv, struct deftemplate *templatePtr, QUERY_TEMPLATE *qchain, int indx) { struct fact *theFact; DATA_OBJECT temp; theFact = templatePtr->factList; while (theFact != NULL) { FactQueryData(theEnv)->QueryCore->solns[indx] = theFact; if (qchain->nxt != NULL) { theFact->factHeader.busyCount++; if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE) { theFact->factHeader.busyCount--; break; } theFact->factHeader.busyCount--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) break; } else { theFact->factHeader.busyCount++; EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); theFact->factHeader.busyCount--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) break; } theFact = theFact->nextTemplateFact; while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE) theFact = theFact->nextTemplateFact; } if (theFact != NULL) return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) ? FALSE : TRUE); return(FALSE); } /************************************************************ NAME : TestEntireChain DESCRIPTION : Processes all templates in a restriction chain until done INPUTS : 1) The current chain 2) The index of the chain restriction (i.e. the 4th query-variable) RETURNS : Nothing useful SIDE EFFECTS : Sets current restriction template Query fact variables set Solution sets stored in global list NOTES : None ************************************************************/ static void TestEntireChain( void *theEnv, QUERY_TEMPLATE *qchain, int indx) { QUERY_TEMPLATE *qptr; FactQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { FactQueryData(theEnv)->AbortQuery = FALSE; TestEntireTemplate(theEnv,qptr->templatePtr,qchain,indx); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) return; } } /***************************************************************** NAME : TestEntireTemplate DESCRIPTION : Processes all facts in a template INPUTS : 1) The module for which templates tested must be in scope 3) The template 4) The current template restriction chain 5) The index of the current restriction RETURNS : Nothing useful SIDE EFFECTS : Instance variable values set Solution sets stored in global list NOTES : None *****************************************************************/ static void TestEntireTemplate( void *theEnv, struct deftemplate *templatePtr, QUERY_TEMPLATE *qchain, int indx) { struct fact *theFact; DATA_OBJECT temp; theFact = templatePtr->factList; while (theFact != NULL) { FactQueryData(theEnv)->QueryCore->solns[indx] = theFact; if (qchain->nxt != NULL) { theFact->factHeader.busyCount++; TestEntireChain(theEnv,qchain->nxt,indx+1); theFact->factHeader.busyCount--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE)) break; } else { theFact->factHeader.busyCount++; EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); theFact->factHeader.busyCount--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) { if (FactQueryData(theEnv)->QueryCore->action != NULL) { theFact->factHeader.busyCount++; EvaluationData(theEnv)->CurrentEvaluationDepth++; ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result); EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,FactQueryData(theEnv)->QueryCore->result); ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); theFact->factHeader.busyCount--; if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { FactQueryData(theEnv)->AbortQuery = TRUE; break; } if (EvaluationData(theEnv)->HaltExecution == TRUE) break; } else AddSolution(theEnv); } } theFact = theFact->nextTemplateFact; while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE) theFact = theFact->nextTemplateFact; } } /*************************************************************************** NAME : AddSolution DESCRIPTION : Adds the current fact set to a global list of solutions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Global list and count updated NOTES : Solutions are stored as sequential arrays of struct fact * ***************************************************************************/ static void AddSolution( void *theEnv) { QUERY_SOLN *new_soln; register unsigned i; new_soln = (QUERY_SOLN *) gm2(theEnv,(int) sizeof(QUERY_SOLN)); new_soln->soln = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * (FactQueryData(theEnv)->QueryCore->soln_size))); for (i = 0 ; i < FactQueryData(theEnv)->QueryCore->soln_size ; i++) new_soln->soln[i] = FactQueryData(theEnv)->QueryCore->solns[i]; new_soln->nxt = NULL; if (FactQueryData(theEnv)->QueryCore->soln_set == NULL) FactQueryData(theEnv)->QueryCore->soln_set = new_soln; else FactQueryData(theEnv)->QueryCore->soln_bottom->nxt = new_soln; FactQueryData(theEnv)->QueryCore->soln_bottom = new_soln; FactQueryData(theEnv)->QueryCore->soln_cnt++; } /*************************************************** NAME : PopQuerySoln DESCRIPTION : Deallocates the topmost solution set for an fact-set query INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Solution set deallocated NOTES : Assumes QueryCore->soln_set != 0 ***************************************************/ static void PopQuerySoln( void *theEnv) { FactQueryData(theEnv)->QueryCore->soln_bottom = FactQueryData(theEnv)->QueryCore->soln_set; FactQueryData(theEnv)->QueryCore->soln_set = FactQueryData(theEnv)->QueryCore->soln_set->nxt; rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->soln_bottom->soln, (sizeof(struct fact *) * FactQueryData(theEnv)->QueryCore->soln_size)); rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->soln_bottom,sizeof(QUERY_SOLN)); } #endif clips-6.24/clipssrc/._rulecmp.c0000400000175000017500000000075410441071206014546 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0z0z$M&W&W$TTFSFMPSRMWBBLclips-6.24/clipssrc/tmpltutl.c0000755000175000017500000004323110441602346014566 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFTEMPLATE UTILITIES MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides utility routines for deftemplates. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added additional arguments to */ /* InvalidDeftemplateSlotMessage function. */ /* */ /* Added additional arguments to */ /* PrintTemplateFact function. */ /* */ /*************************************************************/ #define _TMPLTUTL_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "extnfunc.h" #include "memalloc.h" #include "constrct.h" #include "router.h" #include "argacces.h" #include "cstrnchk.h" #include "envrnmnt.h" #include "tmpltfun.h" #include "tmpltpsr.h" #include "modulutl.h" #include "watch.h" #include "tmpltbsc.h" #include "tmpltdef.h" #include "tmpltutl.h" /********************************************************/ /* InvalidDeftemplateSlotMessage: Generic error message */ /* for use when a specified slot name isn't defined */ /* in its corresponding deftemplate. */ /********************************************************/ globle void InvalidDeftemplateSlotMessage( void *theEnv, char *slotName, char *deftemplateName, int printCR) { PrintErrorID(theEnv,"TMPLTDEF",1,printCR); EnvPrintRouter(theEnv,WERROR,"Invalid slot "); EnvPrintRouter(theEnv,WERROR,slotName); EnvPrintRouter(theEnv,WERROR," not defined in corresponding deftemplate "); EnvPrintRouter(theEnv,WERROR,deftemplateName); EnvPrintRouter(theEnv,WERROR,".\n"); } /**********************************************************/ /* SingleFieldSlotCardinalityError: Generic error message */ /* used when an attempt is made to placed a multifield */ /* value into a single field slot. */ /**********************************************************/ globle void SingleFieldSlotCardinalityError( void *theEnv, char *slotName) { PrintErrorID(theEnv,"TMPLTDEF",2,TRUE); EnvPrintRouter(theEnv,WERROR,"The single field slot "); EnvPrintRouter(theEnv,WERROR,slotName); EnvPrintRouter(theEnv,WERROR," can only contain a single field value.\n"); } /**********************************************************************/ /* MultiIntoSingleFieldSlotError: Determines if a multifield value is */ /* being placed into a single field slot of a deftemplate fact. */ /**********************************************************************/ globle void MultiIntoSingleFieldSlotError( void *theEnv, struct templateSlot *theSlot, struct deftemplate *theDeftemplate) { PrintErrorID(theEnv,"TMPLTFUN",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Attempted to assert a multifield value \n"); EnvPrintRouter(theEnv,WERROR,"into the single field slot "); if (theSlot != NULL) EnvPrintRouter(theEnv,WERROR,theSlot->slotName->contents); else EnvPrintRouter(theEnv,WERROR,"<>"); EnvPrintRouter(theEnv,WERROR," of deftemplate "); if (theDeftemplate != NULL) EnvPrintRouter(theEnv,WERROR,theDeftemplate->header.name->contents); else EnvPrintRouter(theEnv,WERROR,"<>"); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } /**************************************************************/ /* CheckTemplateFact: Checks a fact to see if it violates any */ /* deftemplate type, allowed-..., or range specifications. */ /**************************************************************/ globle void CheckTemplateFact( void *theEnv, struct fact *theFact) { struct field *sublist; int i; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; DATA_OBJECT theData; char thePlace[20]; int rv; if (! EnvGetDynamicConstraintChecking(theEnv)) return; sublist = theFact->theProposition.theFields; /*========================================================*/ /* If the deftemplate corresponding to the first field of */ /* of the fact cannot be found, then the fact cannot be */ /* checked against the deftemplate format. */ /*========================================================*/ theDeftemplate = theFact->whichDeftemplate; if (theDeftemplate == NULL) return; if (theDeftemplate->implied) return; /*=============================================*/ /* Check each of the slots of the deftemplate. */ /*=============================================*/ i = 0; for (slotPtr = theDeftemplate->slotList; slotPtr != NULL; slotPtr = slotPtr->next) { /*================================================*/ /* Store the slot value in the appropriate format */ /* for a call to the constraint checking routine. */ /*================================================*/ if (slotPtr->multislot == FALSE) { theData.type = sublist[i].type; theData.value = sublist[i].value; i++; } else { theData.type = MULTIFIELD; theData.value = (void *) sublist[i].value; SetDOBegin(theData,1); SetDOEnd(theData,((struct multifield *) sublist[i].value)->multifieldLength); i++; } /*=============================================*/ /* Call the constraint checking routine to see */ /* if a constraint violation occurred. */ /*=============================================*/ rv = ConstraintCheckDataObject(theEnv,&theData,slotPtr->constraints); if (rv != NO_VIOLATION) { sprintf(thePlace,"fact f-%-5ld ",theFact->factIndex); PrintErrorID(theEnv,"CSTRNCHK",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Slot value "); PrintDataObject(theEnv,WERROR,&theData); EnvPrintRouter(theEnv,WERROR," "); ConstraintViolationErrorMessage(theEnv,NULL,thePlace,FALSE,0,slotPtr->slotName, 0,rv,slotPtr->constraints,TRUE); SetHaltExecution(theEnv,TRUE); return; } } return; } /***********************************************************************/ /* CheckRHSSlotTypes: Checks the validity of a change to a slot as the */ /* result of an assert, modify, or duplicate command. This checking */ /* is performed statically (i.e. when the command is being parsed). */ /***********************************************************************/ globle intBool CheckRHSSlotTypes( void *theEnv, struct expr *rhsSlots, struct templateSlot *slotPtr, char *thePlace) { int rv; char *theName; if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(TRUE); rv = ConstraintCheckExpressionChain(theEnv,rhsSlots,slotPtr->constraints); if (rv != NO_VIOLATION) { if (rv != CARDINALITY_VIOLATION) theName = "A literal slot value"; else theName = "Literal slot values"; ConstraintViolationErrorMessage(theEnv,theName,thePlace,TRUE,0, slotPtr->slotName,0,rv,slotPtr->constraints,TRUE); return(0); } return(1); } /*********************************************************/ /* GetNthSlot: Given a deftemplate and an integer index, */ /* returns the nth slot of a deftemplate. */ /*********************************************************/ globle struct templateSlot *GetNthSlot( struct deftemplate *theDeftemplate, int position) { struct templateSlot *slotPtr; int i = 0; slotPtr = theDeftemplate->slotList; while (slotPtr != NULL) { if (i == position) return(slotPtr); slotPtr = slotPtr->next; i++; } return(NULL); } /*******************************************************/ /* FindSlotPosition: Finds the position of a specified */ /* slot in a deftemplate structure. */ /*******************************************************/ globle int FindSlotPosition( struct deftemplate *theDeftemplate, SYMBOL_HN *name) { struct templateSlot *slotPtr; int position; for (slotPtr = theDeftemplate->slotList, position = 1; slotPtr != NULL; slotPtr = slotPtr->next, position++) { if (slotPtr->slotName == name) { return(position); } } return(0); } /*******************************************************************/ /* PrintTemplateFact: Prints a fact using the deftemplate format. */ /* Returns TRUE if the fact was printed using this format, */ /* otherwise FALSE. */ /*******************************************************************/ globle void PrintTemplateFact( void *theEnv, char *logicalName, struct fact *theFact, int seperateLines, int ignoreDefaults) { struct field *sublist; int i; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; DATA_OBJECT tempDO; int slotPrinted = FALSE; /*==============================*/ /* Initialize some information. */ /*==============================*/ theDeftemplate = theFact->whichDeftemplate; sublist = theFact->theProposition.theFields; /*=============================================*/ /* Print the relation name of the deftemplate. */ /*=============================================*/ EnvPrintRouter(theEnv,logicalName,"("); EnvPrintRouter(theEnv,logicalName,theDeftemplate->header.name->contents); /*===================================================*/ /* Print each of the field slots of the deftemplate. */ /*===================================================*/ slotPtr = theDeftemplate->slotList; i = 0; while (slotPtr != NULL) { /*=================================================*/ /* If we're ignoring slots with their original */ /* default value, check to see if the fact's slot */ /* value differs from the deftemplate default. */ /*=================================================*/ if (ignoreDefaults && (slotPtr->defaultDynamic == FALSE)) { DeftemplateSlotDefault(theEnv,theDeftemplate,slotPtr,&tempDO,TRUE); if (slotPtr->multislot == FALSE) { if ((GetType(tempDO) == sublist[i].type) && (GetValue(tempDO) == sublist[i].value)) { i++; slotPtr = slotPtr->next; continue; } } else if (MultifieldsEqual((struct multifield*) GetValue(tempDO), (struct multifield *) sublist[i].value)) { i++; slotPtr = slotPtr->next; continue; } } /*===========================================*/ /* Print the opening parenthesis of the slot */ /* and the slot name. */ /*===========================================*/ if (! slotPrinted) { slotPrinted = TRUE; EnvPrintRouter(theEnv,logicalName," "); } if (seperateLines) { EnvPrintRouter(theEnv,logicalName,"\n "); } EnvPrintRouter(theEnv,logicalName,"("); EnvPrintRouter(theEnv,logicalName,slotPtr->slotName->contents); /*======================================================*/ /* Print the value of the slot for a single field slot. */ /*======================================================*/ if (slotPtr->multislot == FALSE) { EnvPrintRouter(theEnv,logicalName," "); PrintAtom(theEnv,logicalName,sublist[i].type,sublist[i].value); } /*==========================================================*/ /* Else print the value of the slot for a multi field slot. */ /*==========================================================*/ else { struct multifield *theSegment; theSegment = (struct multifield *) sublist[i].value; if (theSegment->multifieldLength > 0) { EnvPrintRouter(theEnv,logicalName," "); PrintMultifield(theEnv,logicalName,(struct multifield *) sublist[i].value, 0,(long) theSegment->multifieldLength-1,FALSE); } } /*============================================*/ /* Print the closing parenthesis of the slot. */ /*============================================*/ i++; EnvPrintRouter(theEnv,logicalName,")"); slotPtr = slotPtr->next; if (slotPtr != NULL) EnvPrintRouter(theEnv,logicalName," "); } EnvPrintRouter(theEnv,logicalName,")"); } /***************************************************************************/ /* UpdateDeftemplateScope: Updates the scope flag of all the deftemplates. */ /***************************************************************************/ globle void UpdateDeftemplateScope( void *theEnv) { struct deftemplate *theDeftemplate; int moduleCount; struct defmodule *theModule; struct defmoduleItemHeader *theItem; /*==================================*/ /* Loop through all of the modules. */ /*==================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*======================================================*/ /* Loop through each of the deftemplates in the module. */ /*======================================================*/ theItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,DeftemplateData(theEnv)->DeftemplateModuleIndex); for (theDeftemplate = (struct deftemplate *) theItem->firstItem; theDeftemplate != NULL ; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { /*=======================================*/ /* If the deftemplate can be seen by the */ /* current module, then it is in scope. */ /*=======================================*/ if (FindImportedConstruct(theEnv,"deftemplate",theModule, ValueToString(theDeftemplate->header.name), &moduleCount,TRUE,NULL) != NULL) { theDeftemplate->inScope = TRUE; } else { theDeftemplate->inScope = FALSE; } } } } /****************************************************************/ /* FindSlot: Finds a specified slot in a deftemplate structure. */ /****************************************************************/ globle struct templateSlot *FindSlot( struct deftemplate *theDeftemplate, SYMBOL_HN *name, short *whichOne) { struct templateSlot *slotPtr; *whichOne = 1; slotPtr = theDeftemplate->slotList; while (slotPtr != NULL) { if (slotPtr->slotName == name) { return(slotPtr); } (*whichOne)++; slotPtr = slotPtr->next; } *whichOne = -1; return(NULL); } #if (! RUN_TIME) && (! BLOAD_ONLY) /************************************************************/ /* CreateImpliedDeftemplate: Creates an implied deftemplate */ /* and adds it to the list of deftemplates. */ /************************************************************/ globle struct deftemplate *CreateImpliedDeftemplate( void *theEnv, SYMBOL_HN *deftemplateName, int setFlag) { struct deftemplate *newDeftemplate; newDeftemplate = get_struct(theEnv,deftemplate); newDeftemplate->header.name = deftemplateName; newDeftemplate->header.ppForm = NULL; newDeftemplate->header.usrData = NULL; newDeftemplate->slotList = NULL; newDeftemplate->implied = setFlag; newDeftemplate->numberOfSlots = 0; newDeftemplate->inScope = 1; newDeftemplate->patternNetwork = NULL; newDeftemplate->factList = NULL; newDeftemplate->lastFact = NULL; newDeftemplate->busyCount = 0; newDeftemplate->watch = FALSE; newDeftemplate->header.next = NULL; #if DEBUGGING_FUNCTIONS if (EnvGetWatchItem(theEnv,"facts")) { EnvSetDeftemplateWatch(theEnv,ON,(void *) newDeftemplate); } #endif newDeftemplate->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex); AddConstructToModule(&newDeftemplate->header); InstallDeftemplate(theEnv,newDeftemplate); return(newDeftemplate); } #endif #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/classfun.c0000755000175000017500000012046110441602057014517 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* CLASS FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Internal class manipulation routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "classcom.h" #include "classini.h" #include "constant.h" #include "constrct.h" #include "cstrccom.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "evaluatn.h" #include "inscom.h" #include "insfun.h" #include "insmngr.h" #include "memalloc.h" #include "modulutl.h" #include "msgfun.h" #include "router.h" #include "scanner.h" #include "utility.h" #define _CLASSFUN_SOURCE_ #include "classfun.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define BIG_PRIME 11329 #define CLASS_ID_MAP_CHUNK 30 #define PUT_PREFIX "put-" #define PUT_PREFIX_LENGTH 4 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static unsigned HashSlotName(SYMBOL_HN *); #if (! RUN_TIME) static unsigned NewSlotNameID(void *); static void DeassignClassID(void *,unsigned); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : IncrementDefclassBusyCount DESCRIPTION : Increments use count of defclass INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Busy count incremented NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle void IncrementDefclassBusyCount( void *theEnv, void *theDefclass) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((DEFCLASS *) theDefclass)->busy++; } /*************************************************** NAME : DecrementDefclassBusyCount DESCRIPTION : Decrements use count of defclass INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Busy count decremented NOTES : Since use counts are ignored on a clear and defclasses might be deleted already anyway, this is a no-op on a clear ***************************************************/ globle void DecrementDefclassBusyCount( void *theEnv, void *theDefclass) { if (! ConstructData(theEnv)->ClearInProgress) ((DEFCLASS *) theDefclass)->busy--; } /**************************************************** NAME : InstancesPurge DESCRIPTION : Removes all instances INPUTS : None RETURNS : TRUE if all instances deleted, FALSE otherwise SIDE EFFECTS : The instance hash table is cleared NOTES : None ****************************************************/ globle intBool InstancesPurge( void *theEnv) { int svdepth; DestroyAllInstances(theEnv); svdepth = EvaluationData(theEnv)->CurrentEvaluationDepth; if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) EvaluationData(theEnv)->CurrentEvaluationDepth = -1; CleanupInstances(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth = svdepth; return((InstanceData(theEnv)->InstanceList != NULL) ? FALSE : TRUE); } #if ! RUN_TIME /*************************************************** NAME : InitializeClasses DESCRIPTION : Allocates class hash table Initializes class hash table to all NULL addresses Creates system classes INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Hash table initialized NOTES : None ***************************************************/ globle void InitializeClasses( void *theEnv) { register int i; DefclassData(theEnv)->ClassTable = (DEFCLASS **) gm2(theEnv,(int) (sizeof(DEFCLASS *) * CLASS_TABLE_HASH_SIZE)); for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++) DefclassData(theEnv)->ClassTable[i] = NULL; DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) gm2(theEnv,(int) (sizeof(SLOT_NAME *) * SLOT_NAME_TABLE_HASH_SIZE)); for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) DefclassData(theEnv)->SlotNameTable[i] = NULL; } #endif /******************************************************** NAME : FindClassSlot DESCRIPTION : Searches for a named slot in a class INPUTS : 1) The class address 2) The symbolic slot name RETURNS : Address of slot if found, NULL otherwise SIDE EFFECTS : None NOTES : Only looks in class defn, does not examine inheritance paths ********************************************************/ globle SLOT_DESC *FindClassSlot( DEFCLASS *cls, SYMBOL_HN *sname) { register unsigned i; for (i = 0 ; i < cls->slotCount ; i++) { if (cls->slots[i].slotName->name == sname) return(&cls->slots[i]); } return(NULL); } /*************************************************************** NAME : ClassExistError DESCRIPTION : Prints out error message for non-existent class INPUTS : 1) Name of function having the error 2) The name of the non-existent class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************************/ globle void ClassExistError( void *theEnv, char *func, char *cname) { PrintErrorID(theEnv,"CLASSFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find class "); EnvPrintRouter(theEnv,WERROR,cname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } /********************************************* NAME : DeleteClassLinks DESCRIPTION : Deallocates a class link list INPUTS : The address of the list RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *********************************************/ globle void DeleteClassLinks( void *theEnv, CLASS_LINK *clink) { CLASS_LINK *ctmp; for (ctmp = clink ; ctmp != NULL ; ctmp = clink) { clink = clink->nxt; rtn_struct(theEnv,classLink,ctmp); } } /****************************************************** NAME : PrintClassName DESCRIPTION : Displays a class's name INPUTS : 1) Logical name of output 2) The class 3) Flag indicating whether to print carriage-return at end RETURNS : Nothing useful SIDE EFFECTS : Class name printed (and module name too if class is not in current module) NOTES : None ******************************************************/ globle void PrintClassName( void *theEnv, char *logicalName, DEFCLASS *theDefclass, intBool linefeedFlag) { if ((theDefclass->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) && (theDefclass->system == 0)) { EnvPrintRouter(theEnv,logicalName, EnvGetDefmoduleName(theEnv,theDefclass->header.whichModule->theModule)); EnvPrintRouter(theEnv,logicalName,"::"); } EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name)); if (linefeedFlag) EnvPrintRouter(theEnv,logicalName,"\n"); } #if DEBUGGING_FUNCTIONS || ((! BLOAD_ONLY) && (! RUN_TIME)) /*************************************************** NAME : PrintPackedClassLinks DESCRIPTION : Displays the names of classes in a list with a title INPUTS : 1) The logical name of the output 2) Title string 3) List of class links RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void PrintPackedClassLinks( void *theEnv, char *logicalName, char *title, PACKED_CLASS_LINKS *plinks) { register unsigned i; EnvPrintRouter(theEnv,logicalName,title); for (i = 0 ; i < plinks->classCount ; i++) { EnvPrintRouter(theEnv,logicalName," "); PrintClassName(theEnv,logicalName,plinks->classArray[i],FALSE); } EnvPrintRouter(theEnv,logicalName,"\n"); } #endif #if ! RUN_TIME /******************************************************* NAME : PutClassInTable DESCRIPTION : Inserts a class in the class hash table INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Class inserted NOTES : None *******************************************************/ globle void PutClassInTable( void *theEnv, DEFCLASS *cls) { cls->hashTableIndex = HashClass(GetDefclassNamePointer((void *) cls)); cls->nxtHash = DefclassData(theEnv)->ClassTable[cls->hashTableIndex]; DefclassData(theEnv)->ClassTable[cls->hashTableIndex] = cls; } /********************************************************* NAME : RemoveClassFromTable DESCRIPTION : Removes a class from the class hash table INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Class removed NOTES : None *********************************************************/ globle void RemoveClassFromTable( void *theEnv, DEFCLASS *cls) { DEFCLASS *prvhsh,*hshptr; prvhsh = NULL; hshptr = DefclassData(theEnv)->ClassTable[cls->hashTableIndex]; while (hshptr != cls) { prvhsh = hshptr; hshptr = hshptr->nxtHash; } if (prvhsh == NULL) DefclassData(theEnv)->ClassTable[cls->hashTableIndex] = cls->nxtHash; else prvhsh->nxtHash = cls->nxtHash; } /*************************************************** NAME : AddClassLink DESCRIPTION : Adds a class link from one class to another INPUTS : 1) The packed links in which to insert the new class 2) The subclass pointer 3) Index of where to place the class (-1 to append) RETURNS : Nothing useful SIDE EFFECTS : Link created and attached NOTES : Assumes the pack structure belongs to a class and does not need to be deallocated ***************************************************/ globle void AddClassLink( void *theEnv, PACKED_CLASS_LINKS *src, DEFCLASS *cls, int posn) { PACKED_CLASS_LINKS dst; dst.classArray = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * (src->classCount + 1))); if (posn == -1) { GenCopyMemory(DEFCLASS *,src->classCount,dst.classArray,src->classArray); dst.classArray[src->classCount] = cls; } else { if (posn != 0) GenCopyMemory(DEFCLASS *,posn,dst.classArray,src->classArray); GenCopyMemory(DEFCLASS *,src->classCount - posn, dst.classArray + posn + 1,src->classArray + posn); dst.classArray[posn] = cls; } dst.classCount = (unsigned short) (src->classCount + 1); DeletePackedClassLinks(theEnv,src,FALSE); src->classCount = dst.classCount; src->classArray = dst.classArray; } /*************************************************** NAME : DeleteSubclassLink DESCRIPTION : Removes a class from another class's subclass list INPUTS : 1) The superclass whose subclass list is to be modified 2) The subclass to be removed RETURNS : Nothing useful SIDE EFFECTS : The subclass list is changed NOTES : None ***************************************************/ globle void DeleteSubclassLink( void *theEnv, DEFCLASS *sclass, DEFCLASS *cls) { register unsigned deletedIndex; PACKED_CLASS_LINKS *src,dst; src = &sclass->directSubclasses; for (deletedIndex = 0 ; deletedIndex < src->classCount ; deletedIndex++) if (src->classArray[deletedIndex] == cls) break; if (deletedIndex == src->classCount) return; if (src->classCount > 1) { dst.classArray = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * (src->classCount - 1))); if (deletedIndex != 0) GenCopyMemory(DEFCLASS *,deletedIndex,dst.classArray,src->classArray); GenCopyMemory(DEFCLASS *,src->classCount - deletedIndex - 1, dst.classArray + deletedIndex,src->classArray + deletedIndex + 1); } else dst.classArray = NULL; dst.classCount = (unsigned short) (src->classCount - 1); DeletePackedClassLinks(theEnv,src,FALSE); src->classCount = dst.classCount; src->classArray = dst.classArray; } /************************************************************** NAME : NewClass DESCRIPTION : Allocates and initalizes a new class structure INPUTS : The symbolic name of the new class RETURNS : The address of the new class SIDE EFFECTS : None NOTES : None **************************************************************/ globle DEFCLASS *NewClass( void *theEnv, SYMBOL_HN *className) { register DEFCLASS *cls; cls = get_struct(theEnv,defclass); InitializeConstructHeader(theEnv,"defclass",(struct constructHeader *) cls,className); cls->id = 0; cls->installed = 0; cls->busy = 0; cls->system = 0; cls->abstract = 0; cls->reactive = 1; #if DEBUGGING_FUNCTIONS cls->traceInstances = DefclassData(theEnv)->WatchInstances; cls->traceSlots = DefclassData(theEnv)->WatchSlots; #endif cls->hashTableIndex = 0; cls->directSuperclasses.classCount = 0; cls->directSuperclasses.classArray = NULL; cls->directSubclasses.classCount = 0; cls->directSubclasses.classArray = NULL; cls->allSuperclasses.classCount = 0; cls->allSuperclasses.classArray = NULL; cls->slots = NULL; cls->instanceTemplate = NULL; cls->slotNameMap = NULL; cls->instanceSlotCount = 0; cls->localInstanceSlotCount = 0; cls->slotCount = 0; cls->maxSlotNameID = 0; cls->handlers = NULL; cls->handlerOrderMap = NULL; cls->handlerCount = 0; cls->instanceList = NULL; cls->instanceListBottom = NULL; cls->nxtHash = NULL; cls->scopeMap = NULL; ClearBitString(cls->traversalRecord,TRAVERSAL_BYTES); return(cls); } /*************************************************** NAME : DeletePackedClassLinks DESCRIPTION : Dealloacates a contiguous array holding class links INPUTS : 1) The class link segment 2) A flag indicating whether to delete the top pack structure RETURNS : Nothing useful SIDE EFFECTS : Class links deallocated NOTES : None ***************************************************/ globle void DeletePackedClassLinks( void *theEnv, PACKED_CLASS_LINKS *plp, int deleteTop) { if (plp->classCount > 0) { rm(theEnv,(void *) plp->classArray,(sizeof(DEFCLASS *) * plp->classCount)); plp->classCount = 0; plp->classArray = NULL; } if (deleteTop) rtn_struct(theEnv,packedClassLinks,plp); } /*************************************************** NAME : AssignClassID DESCRIPTION : Assigns a unique id to a class and puts its address in the id map INPUTS : The class RETURNS : Nothing useful SIDE EFFECTS : Class id assigned and map set NOTES : None ***************************************************/ globle void AssignClassID( void *theEnv, DEFCLASS *cls) { register unsigned i; if ((DefclassData(theEnv)->MaxClassID % CLASS_ID_MAP_CHUNK) == 0) { DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) genrealloc(theEnv,(void *) DefclassData(theEnv)->ClassIDMap, (unsigned) (DefclassData(theEnv)->MaxClassID * sizeof(DEFCLASS *)), (unsigned) ((DefclassData(theEnv)->MaxClassID + CLASS_ID_MAP_CHUNK) * sizeof(DEFCLASS *))); DefclassData(theEnv)->AvailClassID += (unsigned short) CLASS_ID_MAP_CHUNK; for (i = DefclassData(theEnv)->MaxClassID ; i < (unsigned) (DefclassData(theEnv)->MaxClassID + CLASS_ID_MAP_CHUNK) ; i++) DefclassData(theEnv)->ClassIDMap[i] = NULL; } DefclassData(theEnv)->ClassIDMap[DefclassData(theEnv)->MaxClassID] = cls; cls->id = DefclassData(theEnv)->MaxClassID++; } /********************************************************* NAME : AddSlotName DESCRIPTION : Adds a new slot entry (or increments the use count of an existing node). INPUTS : 1) The slot name 2) The new canonical id for the slot name 3) A flag indicating whether the given id must be used or not RETURNS : The id of the (old) node SIDE EFFECTS : Slot name entry added or use count incremented NOTES : None *********************************************************/ globle SLOT_NAME *AddSlotName( void *theEnv, SYMBOL_HN *slotName, unsigned newid, int usenewid) { SLOT_NAME *snp; unsigned hashTableIndex; char *buf; unsigned bufsz; hashTableIndex = HashSlotName(slotName); snp = DefclassData(theEnv)->SlotNameTable[hashTableIndex]; while ((snp != NULL) ? (snp->name != slotName) : FALSE) snp = snp->nxt; if (snp != NULL) { if (usenewid && (newid != snp->id)) { SystemError(theEnv,"CLASSFUN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } snp->use++; } else { snp = get_struct(theEnv,slotName); snp->name = slotName; snp->hashTableIndex = hashTableIndex; snp->use = 1; snp->id = usenewid ? newid : NewSlotNameID(theEnv); snp->nxt = DefclassData(theEnv)->SlotNameTable[hashTableIndex]; DefclassData(theEnv)->SlotNameTable[hashTableIndex] = snp; IncrementSymbolCount(slotName); bufsz = (sizeof(char) * (PUT_PREFIX_LENGTH + strlen(ValueToString(slotName)) + 1)); buf = (char *) gm2(theEnv,bufsz); strcpy(buf,PUT_PREFIX); strcat(buf,ValueToString(slotName)); snp->putHandlerName = (SYMBOL_HN *) EnvAddSymbol(theEnv,buf); IncrementSymbolCount(snp->putHandlerName); rm(theEnv,(void *) buf,bufsz); snp->bsaveIndex = 0L; } return(snp); } /*************************************************** NAME : DeleteSlotName DESCRIPTION : Removes a slot name entry from the table of all slot names if no longer in use INPUTS : The slot name hash node RETURNS : Nothing useful SIDE EFFECTS : Slot name entry deleted or use count decremented NOTES : None ***************************************************/ globle void DeleteSlotName( void *theEnv, SLOT_NAME *slotName) { SLOT_NAME *snp,*prv; if (slotName == NULL) return; prv = NULL; snp = DefclassData(theEnv)->SlotNameTable[slotName->hashTableIndex]; while (snp != slotName) { prv = snp; snp = snp->nxt; } snp->use--; if (snp->use != 0) return; if (prv == NULL) DefclassData(theEnv)->SlotNameTable[snp->hashTableIndex] = snp->nxt; else prv->nxt = snp->nxt; DecrementSymbolCount(theEnv,snp->name); DecrementSymbolCount(theEnv,snp->putHandlerName); rtn_struct(theEnv,slotName,snp); } /******************************************************************* NAME : RemoveDefclass DESCRIPTION : Deallocates a class structure and all its fields - returns all symbols in use by the class back to the symbol manager for ephemeral removal INPUTS : The address of the class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Assumes class has no subclasses IMPORTANT WARNING!! : Assumes class busy count and all instances' busy counts are 0 and all handlers' busy counts are 0! *******************************************************************/ LOCALE void RemoveDefclass( void *theEnv, void *vcls) { DEFCLASS *cls = (DEFCLASS *) vcls; HANDLER *hnd; register unsigned i; /* ==================================================== Remove all of this class's superclasses' links to it ==================================================== */ for (i = 0 ; i < cls->directSuperclasses.classCount ; i++) DeleteSubclassLink(theEnv,cls->directSuperclasses.classArray[i],cls); RemoveClassFromTable(theEnv,cls); InstallClass(theEnv,cls,FALSE); DeletePackedClassLinks(theEnv,&cls->directSuperclasses,FALSE); DeletePackedClassLinks(theEnv,&cls->allSuperclasses,FALSE); DeletePackedClassLinks(theEnv,&cls->directSubclasses,FALSE); for (i = 0 ; i < cls->slotCount ; i++) { if (cls->slots[i].defaultValue != NULL) { if (cls->slots[i].dynamicDefault) ReturnPackedExpression(theEnv,(EXPRESSION *) cls->slots[i].defaultValue); else rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); } DeleteSlotName(theEnv,cls->slots[i].slotName); RemoveConstraint(theEnv,cls->slots[i].constraint); } if (cls->instanceSlotCount != 0) { rm(theEnv,(void *) cls->instanceTemplate, (sizeof(SLOT_DESC *) * cls->instanceSlotCount)); rm(theEnv,(void *) cls->slotNameMap, (sizeof(unsigned) * (cls->maxSlotNameID + 1))); } if (cls->slotCount != 0) rm(theEnv,(void *) cls->slots,(sizeof(SLOT_DESC) * cls->slotCount)); for (i = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; if (hnd->actions != NULL) ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm,(sizeof(char) * (strlen(hnd->ppForm)+1))); if (hnd->usrData != NULL) { ClearUserDataList(theEnv,hnd->usrData); } } if (cls->handlerCount != 0) { rm(theEnv,(void *) cls->handlers,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) cls->handlerOrderMap,(sizeof(unsigned) * cls->handlerCount)); } SetDefclassPPForm((void *) cls,NULL); DeassignClassID(theEnv,(unsigned) cls->id); rtn_struct(theEnv,defclass,cls); } #endif /******************************************************************* NAME : DestroyDefclass DESCRIPTION : Deallocates a class structure and all its fields. INPUTS : The address of the class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : *******************************************************************/ LOCALE void DestroyDefclass( void *theEnv, void *vcls) { DEFCLASS *cls = (DEFCLASS *) vcls; register unsigned i; #if ! RUN_TIME HANDLER *hnd; DeletePackedClassLinks(theEnv,&cls->directSuperclasses,FALSE); DeletePackedClassLinks(theEnv,&cls->allSuperclasses,FALSE); DeletePackedClassLinks(theEnv,&cls->directSubclasses,FALSE); #endif for (i = 0 ; i < cls->slotCount ; i++) { if (cls->slots[i].defaultValue != NULL) { #if ! RUN_TIME if (cls->slots[i].dynamicDefault) ReturnPackedExpression(theEnv,(EXPRESSION *) cls->slots[i].defaultValue); else rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); #else if (cls->slots[i].dynamicDefault == 0) rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue); #endif } } #if ! RUN_TIME if (cls->instanceSlotCount != 0) { rm(theEnv,(void *) cls->instanceTemplate, (sizeof(SLOT_DESC *) * cls->instanceSlotCount)); rm(theEnv,(void *) cls->slotNameMap, (sizeof(unsigned) * (cls->maxSlotNameID + 1))); } if (cls->slotCount != 0) rm(theEnv,(void *) cls->slots,(sizeof(SLOT_DESC) * cls->slotCount)); for (i = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; if (hnd->actions != NULL) ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm,(sizeof(char) * (strlen(hnd->ppForm)+1))); if (hnd->usrData != NULL) { ClearUserDataList(theEnv,hnd->usrData); } } if (cls->handlerCount != 0) { rm(theEnv,(void *) cls->handlers,(sizeof(HANDLER) * cls->handlerCount)); rm(theEnv,(void *) cls->handlerOrderMap,(sizeof(unsigned) * cls->handlerCount)); } DestroyConstructHeader(theEnv,&cls->header); rtn_struct(theEnv,defclass,cls); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(hnd) #endif #endif } #if ! RUN_TIME /*************************************************** NAME : InstallClass DESCRIPTION : In(De)crements all symbol counts for for symbols in use by class Disallows (allows) symbols to become ephemeral. INPUTS : 1) The class address 2) 1 - install, 0 - deinstall RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void InstallClass( void *theEnv, DEFCLASS *cls, int set) { SLOT_DESC *slot; HANDLER *hnd; register unsigned i; if ((set && cls->installed) || ((set == FALSE) && (cls->installed == 0))) return; /* ================================================================== Handler installation is handled when message-handlers are defined: see ParseDefmessageHandler() in MSGCOM.C Slot installation is handled by ParseSlot() in CLASSPSR.C Scope map installation is handled by CreateClassScopeMap() ================================================================== */ if (set == FALSE) { cls->installed = 0; DecrementSymbolCount(theEnv,cls->header.name); #if DEFMODULE_CONSTRUCT DecrementBitMapCount(theEnv,cls->scopeMap); #endif ClearUserDataList(theEnv,cls->header.usrData); for (i = 0 ; i < cls->slotCount ; i++) { slot = &cls->slots[i]; DecrementSymbolCount(theEnv,slot->overrideMessage); if (slot->defaultValue != NULL) { if (slot->dynamicDefault) ExpressionDeinstall(theEnv,(EXPRESSION *) slot->defaultValue); else ValueDeinstall(theEnv,(DATA_OBJECT *) slot->defaultValue); } } for (i = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; DecrementSymbolCount(theEnv,hnd->name); if (hnd->actions != NULL) ExpressionDeinstall(theEnv,hnd->actions); } } else { cls->installed = 1; IncrementSymbolCount(cls->header.name); } } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : IsClassBeingUsed DESCRIPTION : Checks the busy flag of a class and ALL classes that inherit from it to make sure that it is not in use before deletion INPUTS : The class RETURNS : TRUE if in use, FALSE otherwise SIDE EFFECTS : None NOTES : Recursively examines all subclasses ***************************************************/ globle int IsClassBeingUsed( DEFCLASS *cls) { register unsigned i; if (cls->busy > 0) return(TRUE); for (i = 0 ; i < cls->directSubclasses.classCount ; i++) if (IsClassBeingUsed(cls->directSubclasses.classArray[i])) return(TRUE); return(FALSE); } /*************************************************** NAME : RemoveAllUserClasses DESCRIPTION : Removes all classes INPUTS : None RETURNS : TRUE if succesful, FALSE otherwise SIDE EFFECTS : The class hash table is cleared NOTES : None ***************************************************/ globle int RemoveAllUserClasses( void *theEnv) { void *userClasses,*ctmp; int success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); #endif /* ==================================================== Don't delete built-in system classes at head of list ==================================================== */ userClasses = EnvGetNextDefclass(theEnv,NULL); while (userClasses != NULL) { if (((DEFCLASS *) userClasses)->system == 0) break; userClasses = EnvGetNextDefclass(theEnv,userClasses); } while (userClasses != NULL) { ctmp = userClasses; userClasses = EnvGetNextDefclass(theEnv,userClasses); if (EnvIsDefclassDeletable(theEnv,ctmp)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) ctmp); RemoveDefclass(theEnv,ctmp); } else { success = FALSE; CantDeleteItemErrorMessage(theEnv,"defclass",EnvGetDefclassName(theEnv,ctmp)); } } return(success); } /**************************************************** NAME : DeleteClassUAG DESCRIPTION : Deallocates a class and all its subclasses INPUTS : The address of the class RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Removes the class from each of its superclasses' subclass lists NOTES : None ****************************************************/ globle int DeleteClassUAG( void *theEnv, DEFCLASS *cls) { unsigned subCount; while (cls->directSubclasses.classCount != 0) { subCount = cls->directSubclasses.classCount; DeleteClassUAG(theEnv,cls->directSubclasses.classArray[0]); if (cls->directSubclasses.classCount == subCount) return(FALSE); } if (EnvIsDefclassDeletable(theEnv,(void *) cls)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) cls); RemoveDefclass(theEnv,(void *) cls); return(TRUE); } return(FALSE); } /********************************************************* NAME : MarkBitMapSubclasses DESCRIPTION : Recursively marks the ids of a class and all its subclasses in a bitmap INPUTS : 1) The bitmap 2) The class 3) A code indicating whether to set or clear the bits of the map corresponding to the class ids RETURNS : Nothing useful SIDE EFFECTS : BitMap marked NOTES : IMPORTANT!!!! Assumes the bitmap is large enough to hold all ids encountered! *********************************************************/ globle void MarkBitMapSubclasses( char *map, DEFCLASS *cls, int set) { register unsigned i; if (set) SetBitMap(map,cls->id); else ClearBitMap(map,cls->id); for (i = 0 ; i < cls->directSubclasses.classCount ; i++) MarkBitMapSubclasses(map,cls->directSubclasses.classArray[i],set); } #endif /*************************************************** NAME : FindSlotNameID DESCRIPTION : Finds the id of a slot name INPUTS : The slot name RETURNS : The slot name id (-1 if not found) SIDE EFFECTS : None NOTES : A slot name always has the same id regardless of what class uses it. In this way, a slot can be referred to by index independent of class. Each class stores a map showing which slot name indices go to which slot. This provides for immediate lookup of slots given the index (object pattern matching uses this). ***************************************************/ globle short FindSlotNameID( void *theEnv, SYMBOL_HN *slotName) { SLOT_NAME *snp; snp = DefclassData(theEnv)->SlotNameTable[HashSlotName(slotName)]; while ((snp != NULL) ? (snp->name != slotName) : FALSE) snp = snp->nxt; return((snp != NULL) ? (short) snp->id : (short) -1); } /*************************************************** NAME : FindIDSlotName DESCRIPTION : Finds the slot anme for an id INPUTS : The id RETURNS : The slot name (NULL if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle SYMBOL_HN *FindIDSlotName( void *theEnv, unsigned id) { SLOT_NAME *snp; snp = FindIDSlotNameHash(theEnv,id); return((snp != NULL) ? snp->name : NULL); } /*************************************************** NAME : FindIDSlotNameHash DESCRIPTION : Finds the slot anme for an id INPUTS : The id RETURNS : The slot name (NULL if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle SLOT_NAME *FindIDSlotNameHash( void *theEnv, unsigned id) { register int i; SLOT_NAME *snp; for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) { snp = DefclassData(theEnv)->SlotNameTable[i]; while (snp != NULL) { if (snp->id == id) return(snp); snp = snp->nxt; } } return(NULL); } /*************************************************** NAME : GetTraversalID DESCRIPTION : Returns a unique integer ID for a traversal into the class hierarchy INPUTS : None RETURNS : The id, or -1 if none available SIDE EFFECTS : EvaluationError set when no ids available NOTES : Used for recursive traversals of class hierarchy to assure that a class is only visited once ***************************************************/ globle int GetTraversalID( void *theEnv) { register unsigned i; register DEFCLASS *cls; if (DefclassData(theEnv)->CTID >= MAX_TRAVERSALS) { PrintErrorID(theEnv,"CLASSFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Maximum number of simultaneous class hierarchy\n traversals exceeded "); PrintLongInteger(theEnv,WERROR,(long) MAX_TRAVERSALS); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(-1); } for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++) for (cls = DefclassData(theEnv)->ClassTable[i] ; cls != NULL ; cls = cls->nxtHash) ClearTraversalID(cls->traversalRecord,DefclassData(theEnv)->CTID); return(DefclassData(theEnv)->CTID++); } /*************************************************** NAME : ReleaseTraversalID DESCRIPTION : Releases an ID for future use Also clears id from all classes INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Old ID released for later reuse NOTES : Releases ID returned by most recent call to GetTraversalID() ***************************************************/ globle void ReleaseTraversalID( void *theEnv) { DefclassData(theEnv)->CTID--; } /******************************************************* NAME : HashClass DESCRIPTION : Generates a hash index for a given class name INPUTS : The address of the class name SYMBOL_HN RETURNS : The hash index value SIDE EFFECTS : None NOTES : Counts on the fact that the symbol has already been hashed into the symbol table - uses that hash value multiplied by a prime for a new hash *******************************************************/ globle unsigned HashClass( SYMBOL_HN *cname) { unsigned long tally; tally = ((unsigned long) cname->bucket) * BIG_PRIME; return((unsigned) (tally % CLASS_TABLE_HASH_SIZE)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : HashSlotName DESCRIPTION : Generates a hash index for a given slot name INPUTS : The address of the slot name SYMBOL_HN RETURNS : The hash index value SIDE EFFECTS : None NOTES : Counts on the fact that the symbol has already been hashed into the symbol table - uses that hash value multiplied by a prime for a new hash *******************************************************/ static unsigned HashSlotName( SYMBOL_HN *sname) { unsigned long tally; tally = ((unsigned long) sname->bucket) * BIG_PRIME; return((unsigned) (tally % SLOT_NAME_TABLE_HASH_SIZE)); } #if (! RUN_TIME) /*********************************************** NAME : NewSlotNameID DESCRIPTION : Returns an unused slot name id as close to 1 as possible INPUTS : None RETURNS : The new unused id SIDE EFFECTS : None NOTES : None ***********************************************/ static unsigned NewSlotNameID( void *theEnv) { unsigned newid = 0; register unsigned i; SLOT_NAME *snp; while (TRUE) { for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) { snp = DefclassData(theEnv)->SlotNameTable[i]; while ((snp != NULL) ? (snp->id != newid) : FALSE) snp = snp->nxt; if (snp != NULL) break; } if (i < SLOT_NAME_TABLE_HASH_SIZE) newid++; else break; } return(newid); } /*************************************************** NAME : DeassignClassID DESCRIPTION : Reduces id map and MaxClassID if no ids in use above the one being released. INPUTS : The id RETURNS : Nothing useful SIDE EFFECTS : ID map and MaxClassID possibly reduced NOTES : None ***************************************************/ static void DeassignClassID( void *theEnv, unsigned id) { register unsigned i; int reallocReqd; unsigned short oldChunk = 0,newChunk = 0; DefclassData(theEnv)->ClassIDMap[id] = NULL; for (i = id + 1 ; i < DefclassData(theEnv)->MaxClassID ; i++) if (DefclassData(theEnv)->ClassIDMap[i] != NULL) return; reallocReqd = FALSE; while (DefclassData(theEnv)->ClassIDMap[id] == NULL) { DefclassData(theEnv)->MaxClassID = (unsigned short) id; if ((DefclassData(theEnv)->MaxClassID % CLASS_ID_MAP_CHUNK) == 0) { newChunk = DefclassData(theEnv)->MaxClassID; if (reallocReqd == FALSE) { oldChunk = (unsigned short) (DefclassData(theEnv)->MaxClassID + CLASS_ID_MAP_CHUNK); reallocReqd = TRUE; } } if (id == 0) break; id--; } if (reallocReqd) { DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) genrealloc(theEnv,(void *) DefclassData(theEnv)->ClassIDMap, (unsigned) (oldChunk * sizeof(DEFCLASS *)), (unsigned) (newChunk * sizeof(DEFCLASS *))); DefclassData(theEnv)->AvailClassID = newChunk; } } #endif #endif clips-6.24/clipssrc/._exprnpsr.c0000400000175000017500000000075410441132036014757 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zNTTFS FMWBBMPSRclips-6.24/clipssrc/objrtbin.c0000755000175000017500000004732110441602261014512 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions Defrule */ /* Object Pattern Network */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* ResetObjectMatchTimeTags did not pass in the */ /* environment argument when BLOAD_ONLY was set. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "memalloc.h" #include "insfun.h" #include "objrtmch.h" #include "reteutil.h" #include "rulebin.h" #define _OBJRTBIN_SOURCE_ #include "objrtbin.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef unsigned long UNLN; typedef struct bsaveObjectPatternNode { unsigned multifieldNode : 1; unsigned endSlot : 1; unsigned whichField : 8; unsigned leaveFields : 8; unsigned slotNameID; long networkTest, nextLevel, lastLevel, leftNode, rightNode, alphaNode; } BSAVE_OBJECT_PATTERN_NODE; typedef struct bsaveObjectAlphaNode { struct bsavePatternNodeHeader header; long classbmp, slotbmp, patternNode, nxtInGroup, nxtTerminal; } BSAVE_OBJECT_ALPHA_NODE; #define BsaveObjectPatternIndex(op) ((op != NULL) ? op->bsaveID : -1L) #define BsaveObjectAlphaIndex(ap) ((ap != NULL) ? ap->bsaveID : -1L) #define ObjectPatternPointer(i) ((i == -1L) ? NULL : (OBJECT_PATTERN_NODE *) &ObjectReteBinaryData(theEnv)->PatternArray[i]) #define ObjectAlphaPointer(i) ((i == -1L) ? NULL : (OBJECT_ALPHA_NODE *) &ObjectReteBinaryData(theEnv)->AlphaArray[i]) /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveObjectPatternsFind(void *); static void BsaveStorageObjectPatterns(void *,FILE *); static void BsaveObjectPatterns(void *,FILE *); #endif static void BloadStorageObjectPatterns(void *); static void BloadObjectPatterns(void *); static void UpdateAlpha(void *,void *,long); static void UpdatePattern(void *,void *,long); static void ClearBloadObjectPatterns(void *); static void DeallocateObjectReteBinaryData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupObjectsBload DESCRIPTION : Initializes data structures and routines for binary loads of generic function constructs INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupObjectPatternsBload( void *theEnv) { AllocateEnvironmentData(theEnv,OBJECTRETEBIN_DATA,sizeof(struct objectReteBinaryData),DeallocateObjectReteBinaryData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"object patterns",0,BsaveObjectPatternsFind,NULL, BsaveStorageObjectPatterns,BsaveObjectPatterns, BloadStorageObjectPatterns,BloadObjectPatterns, ClearBloadObjectPatterns); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"object patterns",0,NULL,NULL,NULL,NULL, BloadStorageObjectPatterns,BloadObjectPatterns, ClearBloadObjectPatterns); #endif } /***********************************************************/ /* DeallocateObjectReteBinaryData: Deallocates environment */ /* data for object rete binary functionality. */ /***********************************************************/ static void DeallocateObjectReteBinaryData( void *theEnv) { #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) unsigned long space; long i; for (i = 0; i < ObjectReteBinaryData(theEnv)->AlphaNodeCount; i++) { DestroyAlphaBetaMemory(theEnv,ObjectReteBinaryData(theEnv)->AlphaArray[i].header.alphaMemory); } space = ObjectReteBinaryData(theEnv)->AlphaNodeCount * sizeof(struct objectAlphaNode); if (space != 0) genlongfree(theEnv,(void *) ObjectReteBinaryData(theEnv)->AlphaArray,space); space = ObjectReteBinaryData(theEnv)->PatternNodeCount * sizeof(struct objectPatternNode); if (space != 0) genlongfree(theEnv,(void *) ObjectReteBinaryData(theEnv)->PatternArray,space); #endif } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************** NAME : BsaveObjectPatternsFind DESCRIPTION : Sets the Bsave IDs for the object pattern data structures and determines how much space (including padding) is necessary for the alpha node bitmPS INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Counts written NOTES : None ***************************************************/ static void BsaveObjectPatternsFind( void *theEnv) { OBJECT_ALPHA_NODE *alphaPtr; OBJECT_PATTERN_NODE *patternPtr; SaveBloadCount(theEnv,ObjectReteBinaryData(theEnv)->AlphaNodeCount); SaveBloadCount(theEnv,ObjectReteBinaryData(theEnv)->PatternNodeCount); ObjectReteBinaryData(theEnv)->AlphaNodeCount = 0L; alphaPtr = ObjectNetworkTerminalPointer(theEnv); while (alphaPtr != NULL) { alphaPtr->classbmp->neededBitMap = TRUE; if (alphaPtr->slotbmp != NULL) alphaPtr->slotbmp->neededBitMap = TRUE; alphaPtr->bsaveID = ObjectReteBinaryData(theEnv)->AlphaNodeCount++; alphaPtr = alphaPtr->nxtTerminal; } ObjectReteBinaryData(theEnv)->PatternNodeCount = 0L; patternPtr = ObjectNetworkPointer(theEnv); while (patternPtr != NULL) { patternPtr->bsaveID = ObjectReteBinaryData(theEnv)->PatternNodeCount++; if (patternPtr->nextLevel == NULL) { while (patternPtr->rightNode == NULL) { patternPtr = patternPtr->lastLevel; if (patternPtr == NULL) return; } patternPtr = patternPtr->rightNode; } else patternPtr = patternPtr->nextLevel; } } /**************************************************** NAME : BsaveStorageObjectPatterns DESCRIPTION : Writes out the number of bytes required for object pattern bitmaps, and the number of object pattern alpha an intermediate nodes INPUTS : Bsave file stream pointer RETURNS : Nothing useful SIDE EFFECTS : Counts written NOTES : None ****************************************************/ static void BsaveStorageObjectPatterns( void *theEnv, FILE *fp) { UNLN space; space = sizeof(long) * 2; GenWrite(&space,(UNLN) sizeof(UNLN),fp); GenWrite(&ObjectReteBinaryData(theEnv)->AlphaNodeCount,(UNLN) sizeof(long),fp); GenWrite(&ObjectReteBinaryData(theEnv)->PatternNodeCount,(UNLN) sizeof(long),fp); } /*************************************************** NAME : BsaveObjectPatterns DESCRIPTION : Writes ouyt object pattern data structures to binary save file INPUTS : Bsave file stream pointer RETURNS : Nothing useful SIDE EFFECTS : Data structures written NOTES : Extra padding written with alpha node bitmaps to ensure correct alignment of structues on bload ***************************************************/ static void BsaveObjectPatterns( void *theEnv, FILE *fp) { UNLN space; OBJECT_ALPHA_NODE *alphaPtr; OBJECT_PATTERN_NODE *patternPtr; BSAVE_OBJECT_ALPHA_NODE dummyAlpha; BSAVE_OBJECT_PATTERN_NODE dummyPattern; space = (sizeof(BSAVE_OBJECT_ALPHA_NODE) * ObjectReteBinaryData(theEnv)->AlphaNodeCount) + (sizeof(BSAVE_OBJECT_PATTERN_NODE) * ObjectReteBinaryData(theEnv)->PatternNodeCount); GenWrite(&space,(UNLN) sizeof(UNLN),fp); /* ========================================== Write out the alpha terminal pattern nodes ========================================== */ alphaPtr = ObjectNetworkTerminalPointer(theEnv); while (alphaPtr != NULL) { AssignBsavePatternHeaderValues(&dummyAlpha.header,&alphaPtr->header); dummyAlpha.classbmp = (long) alphaPtr->classbmp->bucket; if (alphaPtr->slotbmp != NULL) dummyAlpha.slotbmp = (long) alphaPtr->slotbmp->bucket; else dummyAlpha.slotbmp = -1L; dummyAlpha.patternNode = BsaveObjectPatternIndex(alphaPtr->patternNode); dummyAlpha.nxtInGroup = BsaveObjectAlphaIndex(alphaPtr->nxtInGroup); dummyAlpha.nxtTerminal = BsaveObjectAlphaIndex(alphaPtr->nxtTerminal); GenWrite(&dummyAlpha,(UNLN) sizeof(BSAVE_OBJECT_ALPHA_NODE),fp); alphaPtr = alphaPtr->nxtTerminal; } /* ======================================== Write out the intermediate pattern nodes ======================================== */ patternPtr = ObjectNetworkPointer(theEnv); while (patternPtr != NULL) { dummyPattern.multifieldNode = patternPtr->multifieldNode; dummyPattern.whichField = patternPtr->whichField; dummyPattern.leaveFields = patternPtr->leaveFields; dummyPattern.endSlot = patternPtr->endSlot; dummyPattern.slotNameID = patternPtr->slotNameID; dummyPattern.networkTest = HashedExpressionIndex(theEnv,patternPtr->networkTest); dummyPattern.nextLevel = BsaveObjectPatternIndex(patternPtr->nextLevel); dummyPattern.lastLevel = BsaveObjectPatternIndex(patternPtr->lastLevel); dummyPattern.leftNode = BsaveObjectPatternIndex(patternPtr->leftNode); dummyPattern.rightNode = BsaveObjectPatternIndex(patternPtr->rightNode); dummyPattern.alphaNode = BsaveObjectAlphaIndex(patternPtr->alphaNode); GenWrite(&dummyPattern,(UNLN) sizeof(BSAVE_OBJECT_PATTERN_NODE),fp); if (patternPtr->nextLevel == NULL) { while (patternPtr->rightNode == NULL) { patternPtr = patternPtr->lastLevel; if (patternPtr == NULL) { RestoreBloadCount(theEnv,&ObjectReteBinaryData(theEnv)->AlphaNodeCount); RestoreBloadCount(theEnv,&ObjectReteBinaryData(theEnv)->PatternNodeCount); return; } } patternPtr = patternPtr->rightNode; } else patternPtr = patternPtr->nextLevel; } RestoreBloadCount(theEnv,&ObjectReteBinaryData(theEnv)->AlphaNodeCount); RestoreBloadCount(theEnv,&ObjectReteBinaryData(theEnv)->PatternNodeCount); } #endif /*************************************************** NAME : BloadStorageObjectPatterns DESCRIPTION : Reads in the storage requirements for the object patterns in this bload image INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Counts read and arrays allocated NOTES : None ***************************************************/ static void BloadStorageObjectPatterns( void *theEnv) { UNLN space; long counts[2]; GenReadBinary(theEnv,(void *) &space,(UNLN) sizeof(UNLN)); GenReadBinary(theEnv,(void *) counts,space); ObjectReteBinaryData(theEnv)->AlphaNodeCount = counts[0]; ObjectReteBinaryData(theEnv)->PatternNodeCount = counts[1]; if (ObjectReteBinaryData(theEnv)->AlphaNodeCount == 0L) ObjectReteBinaryData(theEnv)->AlphaArray = NULL; else { space = (UNLN) (ObjectReteBinaryData(theEnv)->AlphaNodeCount * sizeof(OBJECT_ALPHA_NODE)); ObjectReteBinaryData(theEnv)->AlphaArray = (OBJECT_ALPHA_NODE *) genlongalloc(theEnv,space); } if (ObjectReteBinaryData(theEnv)->PatternNodeCount == 0L) ObjectReteBinaryData(theEnv)->PatternArray = NULL; else { space = (UNLN) (ObjectReteBinaryData(theEnv)->PatternNodeCount * sizeof(OBJECT_PATTERN_NODE)); ObjectReteBinaryData(theEnv)->PatternArray = (OBJECT_PATTERN_NODE *) genlongalloc(theEnv,space); } } /**************************************************** NAME : BloadObjectPatterns DESCRIPTION : Reads in all object pattern data structures from binary image and updates pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Binary data structures updated NOTES : Assumes storage allocated previously ****************************************************/ static void BloadObjectPatterns( void *theEnv) { UNLN space; GenReadBinary(theEnv,(void *) &space,(UNLN) sizeof(UNLN)); if (space == 0L) return; /* ================================================ Read in the alpha and intermediate pattern nodes ================================================ */ BloadandRefresh(theEnv,ObjectReteBinaryData(theEnv)->AlphaNodeCount,(unsigned) sizeof(BSAVE_OBJECT_ALPHA_NODE),UpdateAlpha); BloadandRefresh(theEnv,ObjectReteBinaryData(theEnv)->PatternNodeCount,(unsigned) sizeof(BSAVE_OBJECT_PATTERN_NODE),UpdatePattern); /* ======================= Set the global pointers ======================= */ SetObjectNetworkTerminalPointer(theEnv,(OBJECT_ALPHA_NODE *) &ObjectReteBinaryData(theEnv)->AlphaArray[0]); SetObjectNetworkPointer(theEnv,(OBJECT_PATTERN_NODE *) &ObjectReteBinaryData(theEnv)->PatternArray[0]); } /*************************************************** NAME : UpdateAlpha DESCRIPTION : Updates all the pointers for an alpha node based on the binary image indices INPUTS : 1) A pointer to the binary image alpha node buffer 2) The index of the actual alpha node in the array RETURNS : Nothing useful SIDE EFFECTS : Alpha node updated NOTES : None ***************************************************/ static void UpdateAlpha( void *theEnv, void *buf, long obji) { BSAVE_OBJECT_ALPHA_NODE *bap; OBJECT_ALPHA_NODE *ap; bap = (BSAVE_OBJECT_ALPHA_NODE *) buf; ap = (OBJECT_ALPHA_NODE *) &ObjectReteBinaryData(theEnv)->AlphaArray[obji]; UpdatePatternNodeHeader(theEnv,&ap->header,&bap->header); ap->matchTimeTag = 0L; ap->classbmp = BitMapPointer(bap->classbmp); if (bap->slotbmp != -1L) { ap->slotbmp = BitMapPointer(bap->slotbmp); IncrementBitMapCount(ap->slotbmp); } else ap->slotbmp = NULL; IncrementBitMapCount(ap->classbmp); ap->patternNode = ObjectPatternPointer(bap->patternNode); ap->nxtInGroup = ObjectAlphaPointer(bap->nxtInGroup); ap->nxtTerminal = ObjectAlphaPointer(bap->nxtTerminal); ap->bsaveID = 0L; } /*************************************************** NAME : UpdatePattern DESCRIPTION : Updates all the pointers for a pattern node based on the binary image indices INPUTS : 1) A pointer to the binary image pattern node buffer 2) The index of the actual pattern node in the array RETURNS : Nothing useful SIDE EFFECTS : Pattern node updated NOTES : None ***************************************************/ static void UpdatePattern( void *theEnv, void *buf, long obji) { BSAVE_OBJECT_PATTERN_NODE *bop; OBJECT_PATTERN_NODE *op; bop = (BSAVE_OBJECT_PATTERN_NODE *) buf; op = (OBJECT_PATTERN_NODE *) &ObjectReteBinaryData(theEnv)->PatternArray[obji]; op->blocked = FALSE; op->multifieldNode = bop->multifieldNode; op->whichField = bop->whichField; op->leaveFields = bop->leaveFields; op->endSlot = bop->endSlot; op->matchTimeTag = 0L; op->slotNameID = bop->slotNameID; op->networkTest = HashedExpressionPointer(bop->networkTest); op->nextLevel = ObjectPatternPointer(bop->nextLevel); op->lastLevel = ObjectPatternPointer(bop->lastLevel); op->leftNode = ObjectPatternPointer(bop->leftNode); op->rightNode = ObjectPatternPointer(bop->rightNode); op->alphaNode = ObjectAlphaPointer(bop->alphaNode); op->bsaveID = 0L; } /*************************************************** NAME : ClearBloadObjectPatterns DESCRIPTION : Releases all emmory associated with binary image object patterns INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory released and global network pointers set to NULL NOTES : None ***************************************************/ static void ClearBloadObjectPatterns( void *theEnv) { UNLN space; register long i; /* ================================================ All instances have been deleted by this point so we don't need to worry about clearing partial matches ================================================ */ for (i = 0L ; i < ObjectReteBinaryData(theEnv)->AlphaNodeCount ; i++) { DecrementBitMapCount(theEnv,ObjectReteBinaryData(theEnv)->AlphaArray[i].classbmp); if (ObjectReteBinaryData(theEnv)->AlphaArray[i].slotbmp != NULL) DecrementBitMapCount(theEnv,ObjectReteBinaryData(theEnv)->AlphaArray[i].slotbmp); } if (ObjectReteBinaryData(theEnv)->AlphaNodeCount != 0L) { space = (UNLN) (ObjectReteBinaryData(theEnv)->AlphaNodeCount * sizeof(OBJECT_ALPHA_NODE)); genlongfree(theEnv,(void *) ObjectReteBinaryData(theEnv)->AlphaArray,space); ObjectReteBinaryData(theEnv)->AlphaArray = NULL; ObjectReteBinaryData(theEnv)->AlphaNodeCount = 0; space = (UNLN) (ObjectReteBinaryData(theEnv)->PatternNodeCount * sizeof(OBJECT_PATTERN_NODE)); genlongfree(theEnv,(void *) ObjectReteBinaryData(theEnv)->PatternArray,space); ObjectReteBinaryData(theEnv)->PatternArray = NULL; ObjectReteBinaryData(theEnv)->PatternNodeCount = 0; } SetObjectNetworkTerminalPointer(theEnv,NULL); SetObjectNetworkPointer(theEnv,NULL); #if BLOAD_ONLY ResetObjectMatchTimeTags(theEnv); #endif } #endif clips-6.24/clipssrc/._tmpltdef.c0000400000175000017500000000075410441602342014717 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoNE=NE=<TTFL0^FMPSRMWBBLclips-6.24/clipssrc/._cstrcbin.c0000400000175000017500000000075407422634657014732 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zpTTF9FMWBBMPSRclips-6.24/clipssrc/._genrccom.c0000400000175000017500000000075410441602214014673 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacodd1TTFL+FMPSRMWBBLclips-6.24/clipssrc/objrtgen.h0000755000175000017500000000465310441072006014517 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /*************************************************************/ #ifndef _H_objrtgen #define _H_objrtgen #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && (! BLOAD_ONLY) #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTGEN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ReplaceGetJNObjectValue(void *,EXPRESSION *,struct lhsParseNode *); LOCALE EXPRESSION *GenGetJNObjectValue(void *,struct lhsParseNode *); LOCALE EXPRESSION *ObjectJNVariableComparison(void *,struct lhsParseNode *,struct lhsParseNode *); LOCALE EXPRESSION *GenObjectPNConstantCompare(void *,struct lhsParseNode *); LOCALE void ReplaceGetPNObjectValue(void *,EXPRESSION *,struct lhsParseNode *); LOCALE EXPRESSION *GenGetPNObjectValue(void *,struct lhsParseNode *); LOCALE EXPRESSION *ObjectPNVariableComparison(void *,struct lhsParseNode *,struct lhsParseNode *); LOCALE void GenObjectLengthTest(void *,struct lhsParseNode *); LOCALE void GenObjectZeroLengthTest(void *,struct lhsParseNode *); #endif #endif clips-6.24/clipssrc/sysdep.h0000755000175000017500000001025210443607651014220 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* SYSTEM DEPENDENT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Isolation of system dependent routines. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Support for run-time programs directly passing */ /* the hash tables for initialization. */ /* */ /* Added BeforeOpenFunction and AfterOpenFunction */ /* hooks. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /*************************************************************/ #ifndef _H_sysdep #define _H_sysdep #ifndef _H_symbol #include "symbol.h" #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #if IBM_TBC || IBM_MSC || IBM_ICB #include #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _SYSDEP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InitializeEnvironment(void); LOCALE void EnvInitializeEnvironment(void *,struct symbolHashNode **,struct floatHashNode **, struct integerHashNode **,struct bitMapHashNode **); LOCALE void SetRedrawFunction(void *,void (*)(void *)); LOCALE void SetPauseEnvFunction(void *,void (*)(void *)); LOCALE void SetContinueEnvFunction(void *,void (*)(void *,int)); LOCALE void (*GetRedrawFunction(void *))(void *); LOCALE void (*GetPauseEnvFunction(void *))(void *); LOCALE void (*GetContinueEnvFunction(void *))(void *,int); LOCALE void RerouteStdin(void *,int,char *[]); LOCALE double gentime(void); LOCALE void gensystem(void *theEnv); LOCALE void VMSSystem(char *); LOCALE int GenOpenReadBinary(void *,char *,char *); LOCALE void GetSeekCurBinary(void *,long); LOCALE void GetSeekSetBinary(void *,long); LOCALE void GenTellBinary(void *,long *); LOCALE void GenCloseBinary(void *); LOCALE void GenReadBinary(void *,void *,unsigned long); LOCALE FILE *GenOpen(void *,char *,char *); LOCALE int GenClose(void *,FILE *); LOCALE void genexit(int); LOCALE int genrand(void); LOCALE void genseed(int); LOCALE int genremove(char *); LOCALE int genrename(char *,char *); LOCALE char *gengetcwd(char *,int); LOCALE void GenWrite(void *,unsigned long,FILE *); LOCALE int (*EnvSetBeforeOpenFunction(void *,int (*)(void *)))(void *); LOCALE int (*EnvSetAfterOpenFunction(void *,int (*)(void *)))(void *); #endif clips-6.24/clipssrc/._router.h0000400000175000017500000000075410441602321014422 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco0z0zo TTFHFFMPSRMWBBLclips-6.24/clipssrc/._msgpsr.h0000400000175000017500000000012207422635010014410 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/genrcexe.h0000755000175000017500000000401610441602217014501 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed IMPERATIVE_METHODS compilation flag. */ /* */ /*************************************************************/ #ifndef _H_genrcexe #define _H_genrcexe #if DEFGENERIC_CONSTRUCT #include "genrcfun.h" #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCEXE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void GenericDispatch(void *,DEFGENERIC *,DEFMETHOD *,DEFMETHOD *,EXPRESSION *,DATA_OBJECT *); LOCALE void UnboundMethodErr(void *); LOCALE intBool IsMethodApplicable(void *,DEFMETHOD *); LOCALE int NextMethodP(void *); LOCALE void CallNextMethod(void *,DATA_OBJECT *); LOCALE void CallSpecificMethod(void *,DATA_OBJECT *); LOCALE void OverrideNextMethod(void *,DATA_OBJECT *); LOCALE void GetGenericCurrentArgument(void *,DATA_OBJECT *); #ifndef _GENRCEXE_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/insmngr.c0000755000175000017500000011566010441147544014370 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INSTANCE PRIMITIVE SUPPORT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Creation and Deletion of Instances Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #if DEFRULE_CONSTRUCT #include "network.h" #include "drive.h" #include "objrtmch.h" #include "lgcldpnd.h" #endif #include "classcom.h" #include "classfun.h" #include "engine.h" #include "envrnmnt.h" #include "memalloc.h" #include "extnfunc.h" #include "insfun.h" #include "modulutl.h" #include "msgcom.h" #include "msgfun.h" #include "prccode.h" #include "router.h" #include "utility.h" #define _INSMNGR_SOURCE_ #include "insmngr.h" #include "inscom.h" #include "watch.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MAKE_TRACE "==>" #define UNMAKE_TRACE "<==" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static INSTANCE_TYPE *NewInstance(void *); static INSTANCE_TYPE *InstanceLocationInfo(void *,DEFCLASS *,SYMBOL_HN *,INSTANCE_TYPE **, unsigned *); static void InstallInstance(void *,INSTANCE_TYPE *,int); static void BuildDefaultSlots(void *,intBool); static int CoreInitializeInstance(void *,INSTANCE_TYPE *,EXPRESSION *); static int InsertSlotOverrides(void *,INSTANCE_TYPE *,EXPRESSION *); static void EvaluateClassDefaults(void *,INSTANCE_TYPE *); #if DEBUGGING_FUNCTIONS static void PrintInstanceWatch(void *,char *,INSTANCE_TYPE *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : InitializeInstanceCommand DESCRIPTION : Initializes an instance of a class INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Instance intialized NOTES : H/L Syntax: (active-initialize-instance *) ***********************************************************/ globle void InitializeInstanceCommand( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); ins = CheckInstance(theEnv,"initialize-instance"); if (ins == NULL) return; if (CoreInitializeInstance(theEnv,ins,GetFirstArgument()->nextArg) == TRUE) { SetpType(result,INSTANCE_NAME); SetpValue(result,(void *) ins->name); } } /**************************************************************** NAME : MakeInstanceCommand DESCRIPTION : Creates and initializes an instance of a class INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Instance intialized NOTES : H/L Syntax: (active-make-instance of *) ****************************************************************/ globle void MakeInstanceCommand( void *theEnv, DATA_OBJECT *result) { SYMBOL_HN *iname; INSTANCE_TYPE *ins; DATA_OBJECT temp; DEFCLASS *cls; SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); EvaluateExpression(theEnv,GetFirstArgument(),&temp); if ((GetType(temp) != SYMBOL) && (GetType(temp) != INSTANCE_NAME)) { PrintErrorID(theEnv,"INSMNGR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid name for new instance.\n"); SetEvaluationError(theEnv,TRUE); return; } iname = (SYMBOL_HN *) GetValue(temp); if (GetFirstArgument()->nextArg->type == DEFCLASS_PTR) cls = (DEFCLASS *) GetFirstArgument()->nextArg->value; else { EvaluateExpression(theEnv,GetFirstArgument()->nextArg,&temp); if (GetType(temp) != SYMBOL) { PrintErrorID(theEnv,"INSMNGR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid class name for new instance.\n"); SetEvaluationError(theEnv,TRUE); return; } cls = LookupDefclassInScope(theEnv,DOToString(temp)); if (cls == NULL) { ClassExistError(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), DOToString(temp)); SetEvaluationError(theEnv,TRUE); return; } } ins = BuildInstance(theEnv,iname,cls,TRUE); if (ins == NULL) return; if (CoreInitializeInstance(theEnv,ins,GetFirstArgument()->nextArg->nextArg) == TRUE) { result->type = INSTANCE_NAME; result->value = (void *) GetFullInstanceName(theEnv,ins); } else QuashInstance(theEnv,ins); } /*************************************************** NAME : GetFullInstanceName DESCRIPTION : If this function is called while the current module is other than the one in which the instance resides, then the module name is prepended to the instance name. Otherwise - the base name only is returned. INPUTS : The instance RETURNS : The instance name symbol (with module name and :: prepended) SIDE EFFECTS : Temporary buffer allocated possibly and new symbol created NOTES : Used to differentiate between instances of the same name in different modules ***************************************************/ globle SYMBOL_HN *GetFullInstanceName( void *theEnv, INSTANCE_TYPE *ins) { char *moduleName,*buffer; unsigned bufsz; SYMBOL_HN *iname; if (ins == &InstanceData(theEnv)->DummyInstance) return((SYMBOL_HN *) EnvAddSymbol(theEnv,"Dummy Instance")); if (ins->garbage) return(ins->name); if (ins->cls->header.whichModule->theModule == ((struct defmodule *) EnvGetCurrentModule(theEnv))) return(ins->name); moduleName = EnvGetDefmoduleName(theEnv,(void *) ins->cls->header.whichModule->theModule); bufsz = (sizeof(char) * (strlen(moduleName) + strlen(ValueToString(ins->name)) + 3)); buffer = (char *) gm2(theEnv,bufsz); sprintf(buffer,"%s::%s",moduleName,ValueToString(ins->name)); iname = (SYMBOL_HN *) EnvAddSymbol(theEnv,buffer); rm(theEnv,(void *) buffer,bufsz); return(iname); } /*************************************************** NAME : BuildInstance DESCRIPTION : Creates an uninitialized instance INPUTS : 1) Name of the instance 2) Class pointer 3) Flag indicating whether init message will be called for this instance or not RETURNS : The address of the new instance, NULL on errors (or when a a logical basis in a rule was deleted int the same RHS in which the instance creation occurred) SIDE EFFECTS : Old definition (if any) is deleted NOTES : None ***************************************************/ globle INSTANCE_TYPE *BuildInstance( void *theEnv, SYMBOL_HN *iname, DEFCLASS *cls, intBool initMessage) { INSTANCE_TYPE *ins,*iprv; unsigned hashTableIndex; unsigned modulePosition; SYMBOL_HN *moduleName; DATA_OBJECT temp; #if DEFRULE_CONSTRUCT if (EngineData(theEnv)->JoinOperationInProgress && cls->reactive) { PrintErrorID(theEnv,"INSMNGR",10,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot create instances of reactive classes while\n"); EnvPrintRouter(theEnv,WERROR," pattern-matching is in process.\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } #endif if (cls->abstract) { PrintErrorID(theEnv,"INSMNGR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } modulePosition = FindModuleSeparator(ValueToString(iname)); if (modulePosition) { moduleName = ExtractModuleName(theEnv,modulePosition,ValueToString(iname)); if ((moduleName == NULL) || (moduleName != cls->header.whichModule->theModule->name)) { PrintErrorID(theEnv,"INSMNGR",11,TRUE); EnvPrintRouter(theEnv,WERROR,"Invalid module specifier in new instance name.\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } iname = ExtractConstructName(theEnv,modulePosition,ValueToString(iname)); } ins = InstanceLocationInfo(theEnv,cls,iname,&iprv,&hashTableIndex); if (ins != NULL) { if (ins->installed == 0) { PrintErrorID(theEnv,"INSMNGR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"The instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(iname)); EnvPrintRouter(theEnv,WERROR," has a slot-value which depends on the instance definition.\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } ins->busy++; IncrementSymbolCount(iname); if (ins->garbage == 0) { if (InstanceData(theEnv)->MkInsMsgPass) DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL); else QuashInstance(theEnv,ins); } ins->busy--; DecrementSymbolCount(theEnv,iname); if (ins->garbage == 0) { PrintErrorID(theEnv,"INSMNGR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete old instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(iname)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } } /* ============================================================= Create the base instance from the defaults of the inheritance precedence list ============================================================= */ InstanceData(theEnv)->CurrentInstance = NewInstance(theEnv); #if DEFRULE_CONSTRUCT /* ============================================== Add this new instance as a dependent to any currently active basis - if the partial match was deleted, abort the instance creation ============================================== */ if (AddLogicalDependencies(theEnv,(struct patternEntity *) InstanceData(theEnv)->CurrentInstance,FALSE) == FALSE) { rtn_struct(theEnv,instance,InstanceData(theEnv)->CurrentInstance); InstanceData(theEnv)->CurrentInstance = NULL; return(NULL); } #endif InstanceData(theEnv)->CurrentInstance->name = iname; InstanceData(theEnv)->CurrentInstance->cls = cls; BuildDefaultSlots(theEnv,initMessage); /* ============================================================ Put the instance in the instance hash table and put it on its class's instance list ============================================================ */ InstanceData(theEnv)->CurrentInstance->hashTableIndex = hashTableIndex; if (iprv == NULL) { InstanceData(theEnv)->CurrentInstance->nxtHash = InstanceData(theEnv)->InstanceTable[hashTableIndex]; if (InstanceData(theEnv)->InstanceTable[hashTableIndex] != NULL) InstanceData(theEnv)->InstanceTable[hashTableIndex]->prvHash = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->InstanceTable[hashTableIndex] = InstanceData(theEnv)->CurrentInstance; } else { InstanceData(theEnv)->CurrentInstance->nxtHash = iprv->nxtHash; if (iprv->nxtHash != NULL) iprv->nxtHash->prvHash = InstanceData(theEnv)->CurrentInstance; iprv->nxtHash = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->CurrentInstance->prvHash = iprv; } /* ====================================== Put instance in global and class lists ====================================== */ if (InstanceData(theEnv)->CurrentInstance->cls->instanceList == NULL) InstanceData(theEnv)->CurrentInstance->cls->instanceList = InstanceData(theEnv)->CurrentInstance; else InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom->nxtClass = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->CurrentInstance->prvClass = InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom; InstanceData(theEnv)->CurrentInstance->cls->instanceListBottom = InstanceData(theEnv)->CurrentInstance; if (InstanceData(theEnv)->InstanceList == NULL) InstanceData(theEnv)->InstanceList = InstanceData(theEnv)->CurrentInstance; else InstanceData(theEnv)->InstanceListBottom->nxtList = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->CurrentInstance->prvList = InstanceData(theEnv)->InstanceListBottom; InstanceData(theEnv)->InstanceListBottom = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->ChangesToInstances = TRUE; /* ============================================================================== Install the instance's name and slot-value symbols (prevent them from becoming ephemeral) - the class name and slot names are accounted for by the class ============================================================================== */ InstallInstance(theEnv,InstanceData(theEnv)->CurrentInstance,TRUE); ins = InstanceData(theEnv)->CurrentInstance; InstanceData(theEnv)->CurrentInstance = NULL; if (InstanceData(theEnv)->MkInsMsgPass) { DirectMessage(theEnv,MessageHandlerData(theEnv)->CREATE_SYMBOL,ins,&temp,NULL); } #if DEFRULE_CONSTRUCT if (ins->cls->reactive) ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) ins,-1); #endif return(ins); } /***************************************************************************** NAME : InitSlotsCommand DESCRIPTION : Calls Kernel Expression Evaluator EvaluateExpression for each expression-value of an instance expression Evaluates default slots only - slots that were specified by overrides (sp->override == 1) are ignored) INPUTS : 1) Instance address RETURNS : Nothing useful SIDE EFFECTS : Each DATA_OBJECT slot in the instance's slot array is replaced by the evaluation (by EvaluateExpression) of the expression in the slot list. The old expression-values are deleted. NOTES : H/L Syntax: (init-slots ) *****************************************************************************/ globle void InitSlotsCommand( void *theEnv, DATA_OBJECT *result) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); EvaluationData(theEnv)->EvaluationError = FALSE; if (CheckCurrentMessage(theEnv,"init-slots",TRUE) == FALSE) return; EvaluateClassDefaults(theEnv,GetActiveInstance(theEnv)); if (! EvaluationData(theEnv)->EvaluationError) { SetpType(result,INSTANCE_ADDRESS); SetpValue(result,(void *) GetActiveInstance(theEnv)); } } /****************************************************** NAME : QuashInstance DESCRIPTION : Deletes an instance if it is not in use, otherwise sticks it on the garbage list INPUTS : The instance RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Instance deleted or added to garbage NOTES : Even though the instance is removed from the class list, hash table and instance list, its links remain unchanged so that outside loops can still determine where the next node in the list is (assuming the instance was garbage collected). ******************************************************/ globle intBool QuashInstance( void *theEnv, INSTANCE_TYPE *ins) { register int iflag; IGARBAGE *gptr; #if DEFRULE_CONSTRUCT if (EngineData(theEnv)->JoinOperationInProgress && ins->cls->reactive) { PrintErrorID(theEnv,"INSMNGR",12,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot delete instances of reactive classes while\n"); EnvPrintRouter(theEnv,WERROR," pattern-matching is in process.\n"); SetEvaluationError(theEnv,TRUE); return(0); } #endif if (ins->garbage == 1) return(0); if (ins->installed == 0) { PrintErrorID(theEnv,"INSMNGR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot delete instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR," during initialization.\n"); SetEvaluationError(theEnv,TRUE); return(0); } #if DEBUGGING_FUNCTIONS if (ins->cls->traceInstances) PrintInstanceWatch(theEnv,UNMAKE_TRACE,ins); #endif #if DEFRULE_CONSTRUCT RemoveEntityDependencies(theEnv,(struct patternEntity *) ins); if (ins->cls->reactive) ObjectNetworkAction(theEnv,OBJECT_RETRACT,(INSTANCE_TYPE *) ins,-1); #endif if (ins->prvHash != NULL) ins->prvHash->nxtHash = ins->nxtHash; else InstanceData(theEnv)->InstanceTable[ins->hashTableIndex] = ins->nxtHash; if (ins->nxtHash != NULL) ins->nxtHash->prvHash = ins->prvHash; if (ins->prvClass != NULL) ins->prvClass->nxtClass = ins->nxtClass; else ins->cls->instanceList = ins->nxtClass; if (ins->nxtClass != NULL) ins->nxtClass->prvClass = ins->prvClass; else ins->cls->instanceListBottom = ins->prvClass; if (ins->prvList != NULL) ins->prvList->nxtList = ins->nxtList; else InstanceData(theEnv)->InstanceList = ins->nxtList; if (ins->nxtList != NULL) ins->nxtList->prvList = ins->prvList; else InstanceData(theEnv)->InstanceListBottom = ins->prvList; iflag = ins->installed; InstallInstance(theEnv,ins,FALSE); /* ============================================== If the instance is the basis for an executing rule, don't bother deleting its slots yet, for they may still be needed by pattern variables ============================================== */ if ((iflag == 1) #if DEFRULE_CONSTRUCT && (ins->header.busyCount == 0) #endif ) RemoveInstanceData(theEnv,ins); if ((ins->busy == 0) && (ins->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) && (InstanceData(theEnv)->MaintainGarbageInstances == FALSE) #if DEFRULE_CONSTRUCT && (ins->header.busyCount == 0) #endif ) { DecrementSymbolCount(theEnv,ins->name); rtn_struct(theEnv,instance,ins); } else { gptr = get_struct(theEnv,igarbage); ins->garbage = 1; gptr->ins = ins; gptr->nxt = InstanceData(theEnv)->InstanceGarbageList; InstanceData(theEnv)->InstanceGarbageList = gptr; UtilityData(theEnv)->EphemeralItemCount += 2; UtilityData(theEnv)->EphemeralItemSize += InstanceSizeHeuristic(ins) + sizeof(IGARBAGE); } InstanceData(theEnv)->ChangesToInstances = TRUE; return(1); } #if DEFRULE_CONSTRUCT /**************************************************** NAME : InactiveInitializeInstance DESCRIPTION : Initializes an instance of a class Pattern-matching is automatically delayed until the instance is completely initialized INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Instance intialized NOTES : H/L Syntax: (initialize-instance *) ****************************************************/ globle void InactiveInitializeInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); InitializeInstanceCommand(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } /************************************************************** NAME : InactiveMakeInstance DESCRIPTION : Creates and initializes an instance of a class Pattern-matching is automatically delayed until the instance is completely initialized INPUTS : The address of the result value RETURNS : Nothing useful SIDE EFFECTS : Instance intialized NOTES : H/L Syntax: (make-instance of *) **************************************************************/ globle void InactiveMakeInstance( void *theEnv, DATA_OBJECT *result) { int ov; ov = SetDelayObjectPatternMatching(theEnv,TRUE); MakeInstanceCommand(theEnv,result); SetDelayObjectPatternMatching(theEnv,ov); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************** NAME : NewInstance DESCRIPTION : Allocates and initializes a new instance INPUTS : None RETURNS : The address of the new instance SIDE EFFECTS : None NOTES : None ********************************************************/ static INSTANCE_TYPE *NewInstance( void *theEnv) { INSTANCE_TYPE *instance; instance = get_struct(theEnv,instance); #if DEFRULE_CONSTRUCT instance->header.theInfo = &InstanceData(theEnv)->InstanceInfo; instance->header.dependents = NULL; instance->header.busyCount = 0; instance->header.timeTag = 0L; instance->partialMatchList = NULL; instance->basisSlots = NULL; instance->reteSynchronized = FALSE; #endif instance->busy = 0; instance->installed = 0; instance->garbage = 0; instance->initSlotsCalled = 0; instance->initializeInProgress = 0; instance->depth = EvaluationData(theEnv)->CurrentEvaluationDepth; instance->name = NULL; instance->hashTableIndex = 0; instance->cls = NULL; instance->slots = NULL; instance->slotAddresses = NULL; instance->prvClass = NULL; instance->nxtClass = NULL; instance->prvHash = NULL; instance->nxtHash = NULL; instance->prvList = NULL; instance->nxtList = NULL; return(instance); } /***************************************************************** NAME : InstanceLocationInfo DESCRIPTION : Determines where a specified instance belongs in the instance hash table INPUTS : 1) The class of the new instance 2) The symbol for the name of the instance 3) Caller's buffer for previous node address 4) Caller's buffer for hash value RETURNS : The address of the found instance, NULL otherwise SIDE EFFECTS : None NOTES : Instance names only have to be unique within a module *****************************************************************/ static INSTANCE_TYPE *InstanceLocationInfo( void *theEnv, DEFCLASS *cls, SYMBOL_HN *iname, INSTANCE_TYPE **prv, unsigned *hashTableIndex) { INSTANCE_TYPE *ins; *hashTableIndex = HashInstance(iname); ins = InstanceData(theEnv)->InstanceTable[*hashTableIndex]; /* ======================================== Make sure all instances of the same name are grouped together regardless of what module their classes are in ======================================== */ *prv = NULL; while ((ins != NULL) ? (ins->name != iname) : FALSE) { *prv = ins; ins = ins->nxtHash; } while ((ins != NULL) ? (ins->name == iname) : FALSE) { if (ins->cls->header.whichModule->theModule == cls->header.whichModule->theModule) return(ins); *prv = ins; ins = ins->nxtHash; } return(NULL); } /******************************************************** NAME : InstallInstance DESCRIPTION : Prevent name and slot value symbols from being ephemeral (all others taken care of by class defn) INPUTS : 1) The address of the instance 2) A flag indicating whether to install or deinstall RETURNS : Nothing useful SIDE EFFECTS : Symbol counts incremented or decremented NOTES : Slot symbol installations are handled by PutSlotValue ********************************************************/ static void InstallInstance( void *theEnv, INSTANCE_TYPE *ins, int set) { if (set == TRUE) { if (ins->installed) return; #if DEBUGGING_FUNCTIONS if (ins->cls->traceInstances) PrintInstanceWatch(theEnv,MAKE_TRACE,ins); #endif ins->installed = 1; ins->depth = EvaluationData(theEnv)->CurrentEvaluationDepth; IncrementSymbolCount(ins->name); IncrementDefclassBusyCount(theEnv,(void *) ins->cls); InstanceData(theEnv)->GlobalNumberOfInstances++; } else { if (! ins->installed) return; ins->installed = 0; InstanceData(theEnv)->GlobalNumberOfInstances--; /* ======================================= Class counts is decremented by RemoveInstanceData() when slot data is truly deleted - and name count is deleted by CleanupInstances() or QuashInstance() when instance is truly deleted ======================================= */ } } /**************************************************************** NAME : BuildDefaultSlots DESCRIPTION : The current instance's address is in the global variable CurrentInstance. This builds the slots and the default values from the direct class of the instance and its inheritances. INPUTS : Flag indicating whether init message will be called for this instance or not RETURNS : Nothing useful SIDE EFFECTS : Allocates the slot array for the current instance NOTES : The current instance's address is stored in a global variable ****************************************************************/ static void BuildDefaultSlots( void *theEnv, intBool initMessage) { register unsigned i,j; unsigned scnt; unsigned lscnt; INSTANCE_SLOT *dst = NULL,**adst; SLOT_DESC **src; scnt = InstanceData(theEnv)->CurrentInstance->cls->instanceSlotCount; lscnt = InstanceData(theEnv)->CurrentInstance->cls->localInstanceSlotCount; if (scnt > 0) { InstanceData(theEnv)->CurrentInstance->slotAddresses = adst = (INSTANCE_SLOT **) gm2(theEnv,(sizeof(INSTANCE_SLOT *) * scnt)); if (lscnt != 0) InstanceData(theEnv)->CurrentInstance->slots = dst = (INSTANCE_SLOT *) gm2(theEnv,(sizeof(INSTANCE_SLOT) * lscnt)); src = InstanceData(theEnv)->CurrentInstance->cls->instanceTemplate; /* ================================================== A map of slot addresses is created - shared slots point at values in the class, and local slots point at values in the instance Also - slots are always given an initial value (since slots cannot be unbound). If there is already an instance of a class with a shared slot, that value is left alone ================================================== */ for (i = 0 , j = 0 ; i < scnt ; i++) { if (src[i]->shared) { src[i]->sharedCount++; adst[i] = &(src[i]->sharedValue); } else { dst[j].desc = src[i]; dst[j].value = NULL; adst[i] = &dst[j++]; } if (adst[i]->value == NULL) { adst[i]->valueRequired = initMessage; if (adst[i]->desc->multiple) { adst[i]->type = MULTIFIELD; adst[i]->value = CreateMultifield2(theEnv,0L); MultifieldInstall(theEnv,(MULTIFIELD_PTR) adst[i]->value); } else { adst[i]->type = SYMBOL; adst[i]->value = EnvAddSymbol(theEnv,"nil"); AtomInstall(theEnv,(int) adst[i]->type,adst[i]->value); } } else adst[i]->valueRequired = FALSE; adst[i]->override = FALSE; } } } /******************************************************************* NAME : CoreInitializeInstance DESCRIPTION : Performs the core work for initializing an instance INPUTS : 1) The instance address 2) Slot override expressions RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : EvaluationError set on errors - slots evaluated NOTES : None *******************************************************************/ static int CoreInitializeInstance( void *theEnv, INSTANCE_TYPE *ins, EXPRESSION *ovrexp) { DATA_OBJECT temp; if (ins->installed == 0) { PrintErrorID(theEnv,"INSMNGR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR," is already being initialized.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } /* ======================================================= Replace all default-slot values with any slot-overrides ======================================================= */ ins->busy++; ins->installed = 0; /* ================================================================= If the slots are initialized properly - the initializeInProgress flag will be turned off. ================================================================= */ ins->initializeInProgress = 1; ins->initSlotsCalled = 0; if (InsertSlotOverrides(theEnv,ins,ovrexp) == FALSE) { ins->installed = 1; ins->busy--; return(FALSE); } /* ================================================================= Now that all the slot expressions are established - replace them with their evaluation ================================================================= */ if (InstanceData(theEnv)->MkInsMsgPass) DirectMessage(theEnv,MessageHandlerData(theEnv)->INIT_SYMBOL,ins,&temp,NULL); else EvaluateClassDefaults(theEnv,ins); ins->busy--; ins->installed = 1; if (EvaluationData(theEnv)->EvaluationError) { PrintErrorID(theEnv,"INSMNGR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"An error occurred during the initialization of instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); } ins->initializeInProgress = 0; return((ins->initSlotsCalled == 0) ? FALSE : TRUE); } /********************************************************** NAME : InsertSlotOverrides DESCRIPTION : Replaces value-expression for a slot INPUTS : 1) The instance address 2) The address of the beginning of the list of slot-expressions RETURNS : TRUE if all okay, FALSE otherwise SIDE EFFECTS : Old slot expression deallocated NOTES : Assumes symbols not yet installed EVALUATES the slot-name expression but simply copies the slot value-expression **********************************************************/ static int InsertSlotOverrides( void *theEnv, INSTANCE_TYPE *ins, EXPRESSION *slot_exp) { INSTANCE_SLOT *slot; DATA_OBJECT temp,junk; EvaluationData(theEnv)->EvaluationError = FALSE; while (slot_exp != NULL) { if ((EvaluateExpression(theEnv,slot_exp,&temp) == TRUE) ? TRUE : (GetType(temp) != SYMBOL)) { PrintErrorID(theEnv,"INSMNGR",9,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid slot name for slot-override.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } slot = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) GetValue(temp)); if (slot == NULL) { PrintErrorID(theEnv,"INSMNGR",13,FALSE); EnvPrintRouter(theEnv,WERROR,"Slot "); EnvPrintRouter(theEnv,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,WERROR," does not exist in instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (InstanceData(theEnv)->MkInsMsgPass) { DirectMessage(theEnv,slot->desc->overrideMessage, ins,NULL,slot_exp->nextArg->argList); } else if (slot_exp->nextArg->argList) { if (EvaluateAndStoreInDataObject(theEnv,(int) slot->desc->multiple, slot_exp->nextArg->argList,&temp,TRUE)) PutSlotValue(theEnv,ins,slot,&temp,&junk,"function make-instance"); } else { SetpDOBegin(&temp,1); SetpDOEnd(&temp,0); SetpType(&temp,MULTIFIELD); SetpValue(&temp,ProceduralPrimitiveData(theEnv)->NoParamValue); PutSlotValue(theEnv,ins,slot,&temp,&junk,"function make-instance"); } if (EvaluationData(theEnv)->EvaluationError) return(FALSE); slot->override = TRUE; slot_exp = slot_exp->nextArg->nextArg; } return(TRUE); } /***************************************************************************** NAME : EvaluateClassDefaults DESCRIPTION : Evaluates default slots only - slots that were specified by overrides (sp->override == 1) are ignored) INPUTS : 1) Instance address RETURNS : Nothing useful SIDE EFFECTS : Each DATA_OBJECT slot in the instance's slot array is replaced by the evaluation (by EvaluateExpression) of the expression in the slot list. The old expression-values are deleted. NOTES : None *****************************************************************************/ static void EvaluateClassDefaults( void *theEnv, INSTANCE_TYPE *ins) { INSTANCE_SLOT *slot; DATA_OBJECT temp,junk; register unsigned i; if (ins->initializeInProgress == 0) { PrintErrorID(theEnv,"INSMNGR",15,FALSE); SetEvaluationError(theEnv,TRUE); EnvPrintRouter(theEnv,WERROR,"init-slots not valid in this context.\n"); return; } for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) { slot = ins->slotAddresses[i]; /* =========================================================== Slot-overrides are just a short-hand for put-slots, so they should be done with messages. Defaults are from the class definition and can be placed directly. =========================================================== */ if (!slot->override) { if (slot->desc->dynamicDefault) { if (EvaluateAndStoreInDataObject(theEnv,(int) slot->desc->multiple, (EXPRESSION *) slot->desc->defaultValue, &temp,TRUE)) PutSlotValue(theEnv,ins,slot,&temp,&junk,"function init-slots"); } else if (((slot->desc->shared == 0) || (slot->desc->sharedCount == 1)) && (slot->desc->noDefault == 0)) DirectPutSlotValue(theEnv,ins,slot,(DATA_OBJECT *) slot->desc->defaultValue,&junk); else if (slot->valueRequired) { PrintErrorID(theEnv,"INSMNGR",14,FALSE); EnvPrintRouter(theEnv,WERROR,"Override required for slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(slot->desc->slotName->name)); EnvPrintRouter(theEnv,WERROR," in instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } slot->valueRequired = FALSE; if (ins->garbage == 1) { EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR," instance deleted by slot-override evaluation.\n"); SetEvaluationError(theEnv,TRUE); } if (EvaluationData(theEnv)->EvaluationError) return; } slot->override = FALSE; } ins->initSlotsCalled = 1; } #if DEBUGGING_FUNCTIONS /*************************************************** NAME : PrintInstanceWatch DESCRIPTION : Prints out a trace message for the creation/deletion of an instance INPUTS : 1) The trace string indicating if this is a creation or deletion 2) The instance RETURNS : Nothing usful SIDE EFFECTS : Watch message printed NOTES : None ***************************************************/ static void PrintInstanceWatch( void *theEnv, char *traceString, INSTANCE_TYPE *theInstance) { EnvPrintRouter(theEnv,WTRACE,traceString); EnvPrintRouter(theEnv,WTRACE," instance "); PrintInstanceNameAndClass(theEnv,WTRACE,theInstance,TRUE); } #endif #endif clips-6.24/clipssrc/scanner.c0000755000175000017500000006765507422634766014372 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* SCANNER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for scanning lexical tokens from an */ /* input source. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Chris Culbert */ /* Brian Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _SCANNER_SOURCE_ #include #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "router.h" #include "symbol.h" #include "utility.h" #include "memalloc.h" #include "scanner.h" #include /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *ScanSymbol(void *,char *,int,unsigned short *); static void *ScanString(void *,char *); static void ScanNumber(void *,char *,struct token *); static void DeallocateScannerData(void *); /************************************************/ /* InitializeScannerData: Allocates environment */ /* data for scanner routines. */ /************************************************/ globle void InitializeScannerData( void *theEnv) { AllocateEnvironmentData(theEnv,SCANNER_DATA,sizeof(struct scannerData),DeallocateScannerData); } /**************************************************/ /* DeallocateScannerData: Deallocates environment */ /* data for scanner routines. */ /**************************************************/ static void DeallocateScannerData( void *theEnv) { if (ScannerData(theEnv)->GlobalMax != 0) { genfree(theEnv,ScannerData(theEnv)->GlobalString,ScannerData(theEnv)->GlobalMax); } } /***********************************************************************/ /* GetToken: Reads next token from the input stream. The pointer to */ /* the token data structure passed as an argument is set to contain */ /* the type of token (e.g., symbol, string, integer, etc.), the data */ /* value for the token (i.e., a symbol table location if it is a */ /* symbol or string, an integer table location if it is an integer), */ /* and the pretty print representation. */ /***********************************************************************/ globle void GetToken( void *theEnv, char *logicalName, struct token *theToken) { int inchar; unsigned short type; /*=======================================*/ /* Set Unknown default values for token. */ /*=======================================*/ theToken->type = UNKNOWN_VALUE; theToken->value = NULL; theToken->printForm = "unknown"; ScannerData(theEnv)->GlobalPos = 0; ScannerData(theEnv)->GlobalMax = 0; /*==============================================*/ /* Remove all white space before processing the */ /* GetToken() request. */ /*==============================================*/ inchar = EnvGetcRouter(theEnv,logicalName); while ((inchar == ' ') || (inchar == '\n') || (inchar == '\f') || (inchar == '\r') || (inchar == ';') || (inchar == '\t')) { /*=======================*/ /* Remove comment lines. */ /*=======================*/ if (inchar == ';') { inchar = EnvGetcRouter(theEnv,logicalName); while ((inchar != '\n') && (inchar != '\r') && (inchar != EOF) ) { inchar = EnvGetcRouter(theEnv,logicalName); } } inchar = EnvGetcRouter(theEnv,logicalName); } /*==========================*/ /* Process Symbolic Tokens. */ /*==========================*/ if (isalpha(inchar)) { theToken->type = SYMBOL; EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,0,&type); theToken->printForm = ValueToString(theToken->value); } /*===============================================*/ /* Process Number Tokens beginning with a digit. */ /*===============================================*/ else if (isdigit(inchar)) { EnvUngetcRouter(theEnv,inchar,logicalName); ScanNumber(theEnv,logicalName,theToken); } else switch (inchar) { /*========================*/ /* Process String Tokens. */ /*========================*/ case '"': theToken->value = (void *) ScanString(theEnv,logicalName); theToken->type = STRING; theToken->printForm = StringPrintForm(theEnv,ValueToString(theToken->value)); break; /*=======================================*/ /* Process Tokens that might be numbers. */ /*=======================================*/ case '-': case '.': case '+': EnvUngetcRouter(theEnv,inchar,logicalName); ScanNumber(theEnv,logicalName,theToken); break; /*===================================*/ /* Process ? and ? Tokens. */ /*===================================*/ case '?': inchar = EnvGetcRouter(theEnv,logicalName); if (isalpha(inchar) #if DEFGLOBAL_CONSTRUCT || (inchar == '*')) #else ) #endif { EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,0,&type); theToken->type = SF_VARIABLE; #if DEFGLOBAL_CONSTRUCT if ((ValueToString(theToken->value)[0] == '*') && (((int) strlen(ValueToString(theToken->value))) > 1) && (ValueToString(theToken->value)[strlen(ValueToString(theToken->value)) - 1] == '*')) { size_t count; theToken->type = GBL_VARIABLE; theToken->printForm = AppendStrings(theEnv,"?",ValueToString(theToken->value)); count = strlen(ScannerData(theEnv)->GlobalString); ScannerData(theEnv)->GlobalString[count-1] = EOS; theToken->value = EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString+1); ScannerData(theEnv)->GlobalString[count-1] = (char) inchar; } else #endif theToken->printForm = AppendStrings(theEnv,"?",ValueToString(theToken->value)); } else { theToken->type = SF_WILDCARD; theToken->value = (void *) EnvAddSymbol(theEnv,"?"); EnvUngetcRouter(theEnv,inchar,logicalName); theToken->printForm = "?"; } break; /*=====================================*/ /* Process $? and $? Tokens. */ /*=====================================*/ case '$': if ((inchar = EnvGetcRouter(theEnv,logicalName)) == '?') { inchar = EnvGetcRouter(theEnv,logicalName); if (isalpha(inchar) #if DEFGLOBAL_CONSTRUCT || (inchar == '*')) #else ) #endif { EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,0,&type); theToken->type = MF_VARIABLE; #if DEFGLOBAL_CONSTRUCT if ((ValueToString(theToken->value)[0] == '*') && ((int) (strlen(ValueToString(theToken->value))) > 1) && (ValueToString(theToken->value)[strlen(ValueToString(theToken->value)) - 1] == '*')) { size_t count; theToken->type = MF_GBL_VARIABLE; theToken->printForm = AppendStrings(theEnv,"$?",ValueToString(theToken->value)); count = strlen(ScannerData(theEnv)->GlobalString); ScannerData(theEnv)->GlobalString[count-1] = EOS; theToken->value = EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString+1); ScannerData(theEnv)->GlobalString[count-1] = (char) inchar; } else #endif theToken->printForm = AppendStrings(theEnv,"$?",ValueToString(theToken->value)); } else { theToken->type = MF_WILDCARD; theToken->value = (void *) EnvAddSymbol(theEnv,"$?"); theToken->printForm = "$?"; EnvUngetcRouter(theEnv,inchar,logicalName); } } else { theToken->type = SYMBOL; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,'$',ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,1,&type); theToken->printForm = ValueToString(theToken->value); } break; /*============================*/ /* Symbols beginning with '<' */ /*============================*/ case '<': theToken->type = SYMBOL; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,'<',ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); theToken->value = (void *) ScanSymbol(theEnv,logicalName,1,&type); theToken->printForm = ValueToString(theToken->value); break; /*=============================================*/ /* Process "(", ")", "~", "|", and "&" Tokens. */ /*=============================================*/ case '(': theToken->type = LPAREN; theToken->value = (void *) EnvAddSymbol(theEnv,"("); theToken->printForm = "("; break; case ')': theToken->type= RPAREN; theToken->value = (void *) EnvAddSymbol(theEnv,")"); theToken->printForm = ")"; break; case '~': theToken->type = NOT_CONSTRAINT; theToken->value = (void *) EnvAddSymbol(theEnv,"~"); theToken->printForm = "~"; break; case '|': theToken->type = OR_CONSTRAINT; theToken->value = (void *) EnvAddSymbol(theEnv,"|"); theToken->printForm = "|"; break; case '&': theToken->type = AND_CONSTRAINT; theToken->value = (void *) EnvAddSymbol(theEnv,"&"); theToken->printForm = "&"; break; /*============================*/ /* Process End-of-File Token. */ /*============================*/ case EOF: case 0: case 3: theToken->type = STOP; theToken->value = (void *) EnvAddSymbol(theEnv,"stop"); theToken->printForm = ""; break; /*=======================*/ /* Process Other Tokens. */ /*=======================*/ default: if (isprint(inchar)) { EnvUngetcRouter(theEnv,inchar,logicalName); theToken->value = (void *) ScanSymbol(theEnv,logicalName,0,&type); theToken->type = type; theToken->printForm = ValueToString(theToken->value); } else { theToken->printForm = "<<>>"; } break; } /*===============================================*/ /* Put the new token in the pretty print buffer. */ /*===============================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) if (theToken->type == INSTANCE_NAME) { SavePPBuffer(theEnv,"["); SavePPBuffer(theEnv,theToken->printForm); SavePPBuffer(theEnv,"]"); } else { SavePPBuffer(theEnv,theToken->printForm); } #endif /*=========================================================*/ /* Return the temporary memory used in scanning the token. */ /*=========================================================*/ if (ScannerData(theEnv)->GlobalString != NULL) { rm(theEnv,ScannerData(theEnv)->GlobalString,ScannerData(theEnv)->GlobalMax); ScannerData(theEnv)->GlobalString = NULL; ScannerData(theEnv)->GlobalMax = 0; ScannerData(theEnv)->GlobalPos = 0; } return; } /*************************************/ /* ScanSymbol: Scans a symbol token. */ /*************************************/ static void *ScanSymbol( void *theEnv, char *logicalName, int count, unsigned short *type) { int inchar; #if OBJECT_SYSTEM void *symbol; #endif /*=====================================*/ /* Scan characters and add them to the */ /* symbol until a delimiter is found. */ /*=====================================*/ inchar = EnvGetcRouter(theEnv,logicalName); while ( (inchar != '<') && (inchar != '"') && (inchar != '(') && (inchar != ')') && (inchar != '&') && (inchar != '|') && (inchar != '~') && (inchar != ' ') && (inchar != ';') && isprint(inchar) ) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; inchar = EnvGetcRouter(theEnv,logicalName); } /*===================================================*/ /* Return the last character scanned (the delimiter) */ /* to the input stream so it will be scanned as part */ /* of the next token. */ /*===================================================*/ EnvUngetcRouter(theEnv,inchar,logicalName); /*====================================================*/ /* Add the symbol to the symbol table and return the */ /* symbol table address of the symbol. Symbols of the */ /* form [] are instance names, so the type */ /* returned is INSTANCE_NAME rather than SYMBOL. */ /*====================================================*/ #if OBJECT_SYSTEM if (count > 2) { if ((ScannerData(theEnv)->GlobalString[0] == '[') ? (ScannerData(theEnv)->GlobalString[count-1] == ']') : FALSE) { *type = INSTANCE_NAME; inchar = ']'; } else { *type = SYMBOL; return(EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString)); } ScannerData(theEnv)->GlobalString[count-1] = EOS; symbol = EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString+1); ScannerData(theEnv)->GlobalString[count-1] = (char) inchar; return(symbol); } else { *type = SYMBOL; return(EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString)); } #else *type = SYMBOL; return(EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString)); #endif } /*************************************/ /* ScanString: Scans a string token. */ /*************************************/ static void *ScanString( void *theEnv, char *logicalName) { int inchar; int pos = 0; unsigned max = 0; char *theString = NULL; void *thePtr; /*============================================*/ /* Scan characters and add them to the string */ /* until the " delimiter is found. */ /*============================================*/ inchar = EnvGetcRouter(theEnv,logicalName); while ((inchar != '"') && (inchar != EOF)) { if (inchar == '\\') { inchar = EnvGetcRouter(theEnv,logicalName); } theString = ExpandStringWithChar(theEnv,inchar,theString,&pos,&max,max+80); inchar = EnvGetcRouter(theEnv,logicalName); } if ((inchar == EOF) && (ScannerData(theEnv)->IgnoreCompletionErrors == FALSE)) { EnvPrintRouter(theEnv,WERROR,"\nEncountered End-Of-File while scanning a string\n"); } /*===============================================*/ /* Add the string to the symbol table and return */ /* the symbol table address of the string. */ /*===============================================*/ if (theString == NULL) { thePtr = EnvAddSymbol(theEnv,""); } else { thePtr = EnvAddSymbol(theEnv,theString); rm(theEnv,theString,max); } return(thePtr); } /**************************************/ /* ScanNumber: Scans a numeric token. */ /**************************************/ static void ScanNumber( void *theEnv, char *logicalName, struct token *theToken) { int count = 0; int inchar, phase; int digitFound = FALSE; int processFloat = FALSE; double fvalue; long lvalue; unsigned short type; /* Phases: */ /* -1 = sign */ /* 0 = integral */ /* 1 = decimal */ /* 2 = exponent-begin */ /* 3 = exponent-value */ /* 5 = done */ /* 9 = error */ inchar = EnvGetcRouter(theEnv,logicalName); phase = -1; while ((phase != 5) && (phase != 9)) { if (phase == -1) { if (isdigit(inchar)) { phase = 0; digitFound = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if ((inchar == '+') || (inchar == '-')) { phase = 0; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if (inchar == '.') { processFloat = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 1; } else if ((inchar == 'E') || (inchar == 'e')) { processFloat = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 2; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || (isprint(inchar) == 0) ) { phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } else if (phase == 0) { if (isdigit(inchar)) { digitFound = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if (inchar == '.') { processFloat = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 1; } else if ((inchar == 'E') || (inchar == 'e')) { processFloat = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 2; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || (isprint(inchar) == 0) ) { phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } else if (phase == 1) { if (isdigit(inchar)) { digitFound = TRUE; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if ((inchar == 'E') || (inchar == 'e')) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 2; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || (isprint(inchar) == 0) ) { phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } else if (phase == 2) { if (isdigit(inchar)) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 3; } else if ((inchar == '+') || (inchar == '-')) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; phase = 3; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || (isprint(inchar) == 0) ) { digitFound = FALSE; phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } else if (phase == 3) { if (isdigit(inchar)) { ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } else if ( (inchar == '<') || (inchar == '"') || (inchar == '(') || (inchar == ')') || (inchar == '&') || (inchar == '|') || (inchar == '~') || (inchar == ' ') || (inchar == ';') || (isprint(inchar) == 0) ) { if ((ScannerData(theEnv)->GlobalString[count-1] == '+') || (ScannerData(theEnv)->GlobalString[count-1] == '-')) { digitFound = FALSE; } phase = 5; } else { phase = 9; ScannerData(theEnv)->GlobalString = ExpandStringWithChar(theEnv,inchar,ScannerData(theEnv)->GlobalString,&ScannerData(theEnv)->GlobalPos,&ScannerData(theEnv)->GlobalMax,ScannerData(theEnv)->GlobalMax+80); count++; } } if ((phase != 5) && (phase != 9)) { inchar = EnvGetcRouter(theEnv,logicalName); } } if (phase == 9) { theToken->value = (void *) ScanSymbol(theEnv,logicalName,count,&type); theToken->type = type; theToken->printForm = ValueToString(theToken->value); return; } /*=======================================*/ /* Stuff last character back into buffer */ /* and return the number. */ /*=======================================*/ EnvUngetcRouter(theEnv,inchar,logicalName); if (! digitFound) { theToken->type = SYMBOL; theToken->value = (void *) EnvAddSymbol(theEnv,ScannerData(theEnv)->GlobalString); theToken->printForm = ValueToString(theToken->value); return; } if (processFloat) { fvalue = atof(ScannerData(theEnv)->GlobalString); theToken->type = FLOAT; theToken->value = (void *) EnvAddDouble(theEnv,fvalue); theToken->printForm = FloatToString(theEnv,ValueToDouble(theToken->value)); } else { lvalue = atol(ScannerData(theEnv)->GlobalString); if ((lvalue == LONG_MAX) || (lvalue == LONG_MIN)) { PrintWarningID(theEnv,"SCANNER",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Over or underflow of long integer.\n"); } theToken->type = INTEGER; theToken->value = (void *) EnvAddLong(theEnv,lvalue); theToken->printForm = LongIntegerToString(theEnv,ValueToLong(theToken->value)); } return; } /***********************************************************/ /* CopyToken: Copies values of one token to another token. */ /***********************************************************/ globle void CopyToken( struct token *destination, struct token *source) { destination->type = source->type; destination->value = source->value; destination->printForm = source->printForm; } /****************************************/ /* ResetLineCount: Resets the scanner's */ /* line count to zero. */ /****************************************/ globle void ResetLineCount( void *theEnv) { ScannerData(theEnv)->LineCount = 0; } /****************************************************/ /* GettLineCount: Returns the scanner's line count. */ /****************************************************/ globle long GetLineCount( void *theEnv) { return(ScannerData(theEnv)->LineCount); } /**********************************/ /* IncrementLineCount: Increments */ /* the scanner's line count. */ /**********************************/ globle void IncrementLineCount( void *theEnv) { ScannerData(theEnv)->LineCount++; } /**********************************/ /* DecrementLineCount: Decrements */ /* the scanner's line count. */ /**********************************/ globle void DecrementLineCount( void *theEnv) { ScannerData(theEnv)->LineCount--; } clips-6.24/clipssrc/._factqury.h0000400000175000017500000000075410441162151014742 0ustar jfsjfsMac OS X  2 RTEXTCWIETTFH Monacoz$`z$`1MOOTTF/BPFMPSRMWBBLclips-6.24/clipssrc/._objrtfnx.c0000400000175000017500000000452210441150305014726 0ustar jfsjfsMac OS X  2 R TEXTR*chn objrtfnx.crol PanelTCmr.txt.docTEXTR*ch p)J " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco,,:nLhnnGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/._symblbin.h0000400000175000017500000000012207422635005014720 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/rulebsc.c0000755000175000017500000003246410441150727014347 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFRULE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the defrule */ /* construct such as clear, reset, save, undefrule, */ /* ppdefrule, list-defrules, and */ /* get-defrule-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _RULEBSC_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "argacces.h" #include "constrct.h" #include "envrnmnt.h" #include "router.h" #include "watch.h" #include "extnfunc.h" #include "ruledef.h" #include "engine.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "rulebin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "rulecmp.h" #endif #include "rulebsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ResetDefrules(void *); static void SaveDefrules(void *,void *,char *); #if (! RUN_TIME) static int ClearDefrulesReady(void *); static void ClearDefrules(void *); #endif /*************************************************************/ /* DefruleBasicCommands: Initializes basic defrule commands. */ /*************************************************************/ globle void DefruleBasicCommands( void *theEnv) { EnvAddResetFunction(theEnv,"defrule",ResetDefrules,70); AddSaveFunction(theEnv,"defrule",SaveDefrules,0); #if (! RUN_TIME) AddClearReadyFunction(theEnv,"defrule",ClearDefrulesReady,0); EnvAddClearFunction(theEnv,"defrule",ClearDefrules,0); #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"rules",0,&DefruleData(theEnv)->WatchRules,70,DefruleWatchAccess,DefruleWatchPrint); #endif #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-defrule-list",'m',PTIEF GetDefruleListFunction,"GetDefruleListFunction","01w"); EnvDefineFunction2(theEnv,"undefrule",'v',PTIEF UndefruleCommand,"UndefruleCommand","11w"); EnvDefineFunction2(theEnv,"defrule-module",'w',PTIEF DefruleModuleFunction,"DefruleModuleFunction","11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"rules",'v', PTIEF ListDefrulesCommand,"ListDefrulesCommand","01w"); EnvDefineFunction2(theEnv,"list-defrules",'v', PTIEF ListDefrulesCommand,"ListDefrulesCommand","01w"); EnvDefineFunction2(theEnv,"ppdefrule",'v',PTIEF PPDefruleCommand,"PPDefruleCommand","11w"); #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DefruleBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefruleCompilerSetup(theEnv); #endif #endif } /*****************************************************/ /* ResetDefrules: Defrule reset routine for use with */ /* the reset command. Sets the current entity time */ /* tag (used by the conflict resolution strategies */ /* for recency) to zero. The focus stack is also */ /* cleared. */ /*****************************************************/ static void ResetDefrules( void *theEnv) { struct defmodule *theModule; DefruleData(theEnv)->CurrentEntityTimeTag = 0L; EnvClearFocusStack(theEnv); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,(void *) theModule); } #if (! RUN_TIME) /******************************************************************/ /* ClearDefrulesReady: Indicates whether defrules can be cleared. */ /******************************************************************/ static int ClearDefrulesReady( void *theEnv) { if (EngineData(theEnv)->ExecutingRule != NULL) return(FALSE); EnvClearFocusStack(theEnv); if (EnvGetCurrentModule(theEnv) == NULL) return(FALSE); DefruleData(theEnv)->CurrentEntityTimeTag = 0L; return(TRUE); } /***************************************************************/ /* ClearDefrules: Pushes the MAIN module as the current focus. */ /***************************************************************/ static void ClearDefrules( void *theEnv) { struct defmodule *theModule; theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,(void *) theModule); } #endif /**************************************/ /* SaveDefrules: Defrule save routine */ /* for use with the save command. */ /**************************************/ static void SaveDefrules( void *theEnv, void *theModule, char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DefruleData(theEnv)->DefruleConstruct); } /******************************************/ /* UndefruleCommand: H/L access routine */ /* for the undefrule command. */ /******************************************/ globle void UndefruleCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefrule",DefruleData(theEnv)->DefruleConstruct); } /**********************************/ /* EnvUndefrule: C access routine */ /* for the undefrule command. */ /**********************************/ globle intBool EnvUndefrule( void *theEnv, void *theDefrule) { return(Undefconstruct(theEnv,theDefrule,DefruleData(theEnv)->DefruleConstruct)); } /************************************************/ /* GetDefruleListFunction: H/L access routine */ /* for the get-defrule-list function. */ /************************************************/ globle void GetDefruleListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-defrule-list",returnValue,DefruleData(theEnv)->DefruleConstruct); } /****************************************/ /* EnvGetDefruleList: C access routine */ /* for the get-defrule-list function. */ /****************************************/ globle void EnvGetDefruleList( void *theEnv, DATA_OBJECT_PTR returnValue, void *theModule) { GetConstructList(theEnv,returnValue,DefruleData(theEnv)->DefruleConstruct,(struct defmodule *) theModule); } /*********************************************/ /* DefruleModuleFunction: H/L access routine */ /* for the defrule-module function. */ /*********************************************/ globle void *DefruleModuleFunction( void *theEnv) { return(GetConstructModuleCommand(theEnv,"defrule-module",DefruleData(theEnv)->DefruleConstruct)); } #if DEBUGGING_FUNCTIONS /******************************************/ /* PPDefruleCommand: H/L access routine */ /* for the ppdefrule command. */ /******************************************/ globle void PPDefruleCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefrule",DefruleData(theEnv)->DefruleConstruct); } /***********************************/ /* PPDefrule: C access routine for */ /* the ppdefrule command. */ /***********************************/ globle int PPDefrule( void *theEnv, char *defruleName, char *logicalName) { return(PPConstruct(theEnv,defruleName,logicalName,DefruleData(theEnv)->DefruleConstruct)); } /*********************************************/ /* ListDefrulesCommand: H/L access routine */ /* for the list-defrules command. */ /*********************************************/ globle void ListDefrulesCommand( void *theEnv) { ListConstructCommand(theEnv,"list-defrules",DefruleData(theEnv)->DefruleConstruct); } /*************************************/ /* EnvListDefrules: C access routine */ /* for the list-defrules command. */ /*************************************/ globle void EnvListDefrules( void *theEnv, char *logicalName, void *theModule) { ListConstruct(theEnv,DefruleData(theEnv)->DefruleConstruct,logicalName,(struct defmodule *) theModule); } /*******************************************************/ /* EnvGetDefruleWatchActivations: C access routine for */ /* retrieving the current watch value of a defrule's */ /* activations. */ /*******************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDefruleWatchActivations( void *theEnv, void *rulePtr) { struct defrule *thePtr; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif for (thePtr = (struct defrule *) rulePtr; thePtr != NULL; thePtr = thePtr->disjunct) { if (thePtr->watchActivation) return(TRUE); } return(FALSE); } /***********************************************/ /* EnvGetDefruleWatchFirings: C access routine */ /* for retrieving the current watch value of */ /* a defrule's firings. */ /***********************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDefruleWatchFirings( void *theEnv, void *rulePtr) { struct defrule *thePtr; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif for (thePtr = (struct defrule *) rulePtr; thePtr != NULL; thePtr = thePtr->disjunct) { if (thePtr->watchFiring) return(TRUE); } return(FALSE); } /***************************************************/ /* EnvSetDefruleWatchActivations: C access routine */ /* for setting the current watch value of a */ /* defrule's activations. */ /***************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDefruleWatchActivations( void *theEnv, unsigned newState, void *rulePtr) { struct defrule *thePtr; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif for (thePtr = (struct defrule *) rulePtr; thePtr != NULL; thePtr = thePtr->disjunct) { thePtr->watchActivation = newState; } } /****************************************************/ /* EnvSetDefruleWatchFirings: C access routine for */ /* setting the current watch value of a defrule's */ /* firings. */ /****************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDefruleWatchFirings( void *theEnv, unsigned newState, void *rulePtr) { struct defrule *thePtr; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif for (thePtr = (struct defrule *) rulePtr; thePtr != NULL; thePtr = thePtr->disjunct) { thePtr->watchFiring = newState; } } /*******************************************************************/ /* DefruleWatchAccess: Access function for setting the watch flags */ /* associated with rules (activations and rule firings). */ /*******************************************************************/ globle unsigned DefruleWatchAccess( void *theEnv, int code, unsigned newState, struct expr *argExprs) { if (code) return(ConstructSetWatchAccess(theEnv,DefruleData(theEnv)->DefruleConstruct,newState,argExprs, EnvGetDefruleWatchActivations,EnvSetDefruleWatchActivations)); else return(ConstructSetWatchAccess(theEnv,DefruleData(theEnv)->DefruleConstruct,newState,argExprs, EnvGetDefruleWatchFirings,EnvSetDefruleWatchFirings)); } /*****************************************************************/ /* DefruleWatchPrint: Access routine for printing which defrules */ /* have their watch flag set via the list-watch-items command. */ /*****************************************************************/ globle unsigned DefruleWatchPrint( void *theEnv, char *logName, int code, struct expr *argExprs) { if (code) return(ConstructPrintWatchAccess(theEnv,DefruleData(theEnv)->DefruleConstruct,logName,argExprs, EnvGetDefruleWatchActivations,EnvSetDefruleWatchActivations)); else return(ConstructPrintWatchAccess(theEnv,DefruleData(theEnv)->DefruleConstruct,logName,argExprs, EnvGetDefruleWatchActivations,EnvSetDefruleWatchActivations)); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/msgcom.c0000755000175000017500000011416210441602244014165 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* OBJECT MESSAGE COMMANDS */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS */ /* compilation flag. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "classinf.h" #include "envrnmnt.h" #include "insfun.h" #include "insmoddp.h" #include "msgfun.h" #include "prccode.h" #include "router.h" #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if ! RUN_TIME #include "extnfunc.h" #endif #if (! BLOAD_ONLY) && (! RUN_TIME) #include "constrct.h" #include "msgpsr.h" #endif #if DEBUGGING_FUNCTIONS #include "watch.h" #endif #define _MSGCOM_SOURCE_ #include "msgcom.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if ! RUN_TIME static void CreateSystemHandlers(void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) static int WildDeleteHandler(void *,DEFCLASS *,SYMBOL_HN *,char *); #endif #if DEBUGGING_FUNCTIONS static unsigned DefmessageHandlerWatchAccess(void *,int,unsigned,EXPRESSION *); static unsigned DefmessageHandlerWatchPrint(void *,char *,int,EXPRESSION *); static unsigned DefmessageHandlerWatchSupport(void *,char *,char *,int, void (*)(void *,char *,void *,unsigned), void (*)(void *,int,void *,unsigned), EXPRESSION *); static unsigned WatchClassHandlers(void *,void *,char *,int,char *,int,int, void (*)(void *,char *,void *,unsigned), void (*)(void *,int,void *,unsigned)); static void PrintHandlerWatchFlag(void *,char *,void *,unsigned); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupMessageHandlers DESCRIPTION : Sets up internal symbols and fucntion definitions pertaining to message-handlers. Also creates system handlers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions and data structures initialized NOTES : Should be called before SetupInstanceModDupCommands() in INSMODDP.C ***************************************************/ globle void SetupMessageHandlers( void *theEnv) { ENTITY_RECORD handlerGetInfo = { "HANDLER_GET", HANDLER_GET,0,1,1, PrintHandlerSlotGetFunction, PrintHandlerSlotGetFunction,NULL, HandlerSlotGetFunction, NULL,NULL,NULL,NULL,NULL,NULL }, handlerPutInfo = { "HANDLER_PUT", HANDLER_PUT,0,1,1, PrintHandlerSlotPutFunction, PrintHandlerSlotPutFunction,NULL, HandlerSlotPutFunction, NULL,NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,MESSAGE_HANDLER_DATA,sizeof(struct messageHandlerData),NULL); memcpy(&MessageHandlerData(theEnv)->HandlerGetInfo,&handlerGetInfo,sizeof(struct entityRecord)); memcpy(&MessageHandlerData(theEnv)->HandlerPutInfo,&handlerPutInfo,sizeof(struct entityRecord)); MessageHandlerData(theEnv)->hndquals[0] = "around"; MessageHandlerData(theEnv)->hndquals[1] = "before"; MessageHandlerData(theEnv)->hndquals[2] = "primary"; MessageHandlerData(theEnv)->hndquals[3] = "after"; InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerGetInfo,HANDLER_GET); InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerPutInfo,HANDLER_PUT); #if ! RUN_TIME MessageHandlerData(theEnv)->INIT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INIT_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->INIT_SYMBOL); MessageHandlerData(theEnv)->DELETE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,DELETE_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->DELETE_SYMBOL); MessageHandlerData(theEnv)->CREATE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,CREATE_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->CREATE_SYMBOL); EnvAddClearFunction(theEnv,"defclass",CreateSystemHandlers,-100); #if ! BLOAD_ONLY MessageHandlerData(theEnv)->SELF_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SELF_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->SELF_SYMBOL); AddConstruct(theEnv,"defmessage-handler","defmessage-handlers", ParseDefmessageHandler,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL); EnvDefineFunction2(theEnv,"undefmessage-handler",'v',PTIEF UndefmessageHandlerCommand, "UndefmessageHandlerCommand","23w"); #endif EnvDefineFunction2(theEnv,"send",'u',PTIEF SendCommand,"SendCommand","2*uuw"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"preview-send",'v',PTIEF PreviewSendCommand,"PreviewSendCommand","22w"); EnvDefineFunction2(theEnv,"ppdefmessage-handler",'v',PTIEF PPDefmessageHandlerCommand, "PPDefmessageHandlerCommand","23w"); EnvDefineFunction2(theEnv,"list-defmessage-handlers",'v',PTIEF ListDefmessageHandlersCommand, "ListDefmessageHandlersCommand","02w"); #endif EnvDefineFunction2(theEnv,"next-handlerp",'b',PTIEF NextHandlerAvailable,"NextHandlerAvailable","00"); FuncSeqOvlFlags(theEnv,"next-handlerp",TRUE,FALSE); EnvDefineFunction2(theEnv,"call-next-handler",'u', PTIEF CallNextHandler,"CallNextHandler","00"); FuncSeqOvlFlags(theEnv,"call-next-handler",TRUE,FALSE); EnvDefineFunction2(theEnv,"override-next-handler",'u', PTIEF CallNextHandler,"CallNextHandler",NULL); FuncSeqOvlFlags(theEnv,"override-next-handler",TRUE,FALSE); EnvDefineFunction2(theEnv,"dynamic-get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w"); EnvDefineFunction2(theEnv,"dynamic-put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w"); EnvDefineFunction2(theEnv,"get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w"); EnvDefineFunction2(theEnv,"put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w"); #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"messages",0,&MessageHandlerData(theEnv)->WatchMessages,36,NULL,NULL); AddWatchItem(theEnv,"message-handlers",0,&MessageHandlerData(theEnv)->WatchHandlers,35, DefmessageHandlerWatchAccess,DefmessageHandlerWatchPrint); #endif } /***************************************************** NAME : EnvGetDefmessageHandlerName DESCRIPTION : Gets the name of a message-handler INPUTS : 1) Pointer to a class 2) Array index of handler in class's message-handler array (+1) RETURNS : Name-string of message-handler SIDE EFFECTS : None NOTES : None *****************************************************/ #if IBM_TBC #pragma argsused #endif char *EnvGetDefmessageHandlerName( void *theEnv, void *ptr, unsigned theIndex) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(ValueToString(((DEFCLASS *) ptr)->handlers[theIndex-1].name)); } /***************************************************** NAME : EnvGetDefmessageHandlerType DESCRIPTION : Gets the type of a message-handler INPUTS : 1) Pointer to a class 2) Array index of handler in class's message-handler array (+1) RETURNS : Type-string of message-handler SIDE EFFECTS : None NOTES : None *****************************************************/ globle char *EnvGetDefmessageHandlerType( void *theEnv, void *ptr, unsigned theIndex) { return(MessageHandlerData(theEnv)->hndquals[((DEFCLASS *) ptr)->handlers[theIndex-1].type]); } /************************************************************** NAME : EnvGetNextDefmessageHandler DESCRIPTION : Finds first or next handler for a class INPUTS : 1) The address of the handler's class 2) The array index of the current handler (+1) RETURNS : The array index (+1) of the next handler, or 0 if there is none SIDE EFFECTS : None NOTES : If index == 0, the first handler array index (i.e. 1) returned **************************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetNextDefmessageHandler( void *theEnv, void *ptr, unsigned theIndex) { DEFCLASS *cls; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif cls = (DEFCLASS *) ptr; if (theIndex == 0) return((cls->handlers != NULL) ? 1U : 0U); if (theIndex == cls->handlerCount) return(0); return(theIndex+1); } /***************************************************** NAME : GetDefmessageHandlerPointer DESCRIPTION : Returns a pointer to a handler INPUTS : 1) Pointer to a class 2) Array index of handler in class's message-handler array (+1) RETURNS : Pointer to the handler. SIDE EFFECTS : None NOTES : None *****************************************************/ globle HANDLER *GetDefmessageHandlerPointer( void *ptr, unsigned theIndex) { return(&((DEFCLASS *) ptr)->handlers[theIndex-1]); } #if DEBUGGING_FUNCTIONS /********************************************************* NAME : EnvGetDefmessageHandlerWatch DESCRIPTION : Determines if trace messages for calls to this handler will be generated or not INPUTS : 1) A pointer to the class 2) The index of the handler RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDefmessageHandlerWatch( void *theEnv, void *theClass, unsigned theIndex) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) theClass)->handlers[theIndex-1].trace); } /********************************************************* NAME : EnvSetDefmessageHandlerWatch DESCRIPTION : Sets the trace to ON/OFF for the calling of the handler INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the class 3) The index of the handler RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the handler set NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDefmessageHandlerWatch( void *theEnv, int newState, void *theClass, unsigned theIndex) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((DEFCLASS *) theClass)->handlers[theIndex-1].trace = newState; } #endif /*************************************************** NAME : EnvFindDefmessageHandler DESCRIPTION : Determines the index of a specfied message-handler INPUTS : 1) A pointer to the class 2) Name-string of the handler 3) Handler-type: "around","before", "primary", or "after" RETURNS : The index of the handler (0 if not found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle unsigned EnvFindDefmessageHandler( void *theEnv, void *ptr, char *hname, char *htypestr) { unsigned htype; SYMBOL_HN *hsym; DEFCLASS *cls; int theIndex; htype = HandlerType(theEnv,"handler-lookup",htypestr); if (htype == MERROR) return(0); hsym = FindSymbolHN(theEnv,hname); if (hsym == NULL) return(0); cls = (DEFCLASS *) ptr; theIndex = FindHandlerByIndex(cls,hsym,(unsigned) htype); return((unsigned) (theIndex+1)); } /*************************************************** NAME : EnvIsDefmessageHandlerDeletable DESCRIPTION : Determines if a message-handler can be deleted INPUTS : 1) Address of the handler's class 2) Index of the handler RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDefmessageHandlerDeletable( void *theEnv, void *ptr, unsigned theIndex) { DEFCLASS *cls; if (! ConstructsDeletable(theEnv)) { return FALSE; } cls = (DEFCLASS *) ptr; if (cls->handlers[theIndex-1].system == 1) return(FALSE); #if (! BLOAD_ONLY) && (! RUN_TIME) return((HandlersExecuting(cls) == FALSE) ? TRUE : FALSE); #else return FALSE; #endif } /****************************************************************************** NAME : UndefmessageHandlerCommand DESCRIPTION : Deletes a handler from a class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Handler deleted if possible NOTES : H/L Syntax: (undefmessage-handler []) ******************************************************************************/ globle void UndefmessageHandlerCommand( void *theEnv) { #if RUN_TIME || BLOAD_ONLY PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); #else SYMBOL_HN *mname; char *tname; DATA_OBJECT tmp; DEFCLASS *cls; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) { PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); return; } #endif if (EnvArgTypeCheck(theEnv,"undefmessage-handler",1,SYMBOL,&tmp) == FALSE) return; cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if ((cls == NULL) ? (strcmp(DOToString(tmp),"*") != 0) : FALSE) { ClassExistError(theEnv,"undefmessage-handler",DOToString(tmp)); return; } if (EnvArgTypeCheck(theEnv,"undefmessage-handler",2,SYMBOL,&tmp) == FALSE) return; mname = (SYMBOL_HN *) tmp.value; if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"undefmessage-handler",3,SYMBOL,&tmp) == FALSE) return; tname = DOToString(tmp); if (strcmp(tname,"*") == 0) tname = NULL; } else tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY]; WildDeleteHandler(theEnv,cls,mname,tname); #endif } /*********************************************************** NAME : EnvUndefmessageHandler DESCRIPTION : Deletes a handler from a class INPUTS : 1) Class address (Can be NULL) 2) Handler index (can be 0) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Handler deleted if possible NOTES : None ***********************************************************/ globle int EnvUndefmessageHandler( void *theEnv, void *vptr, unsigned mhi) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(vptr) #pragma unused(mhi) #endif #if RUN_TIME || BLOAD_ONLY PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); return(0); #else DEFCLASS *cls; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) { PrintErrorID(theEnv,"MSGCOM",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n"); return(0); } #endif if (vptr == NULL) { if (mhi != 0) { PrintErrorID(theEnv,"MSGCOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Incomplete message-handler specification for deletion.\n"); return(0); } return(WildDeleteHandler(theEnv,NULL,NULL,NULL)); } if (mhi == 0) return(WildDeleteHandler(theEnv,(DEFCLASS *) vptr,NULL,NULL)); cls = (DEFCLASS *) vptr; if (HandlersExecuting(cls)) { HandlerDeleteError(theEnv,EnvGetDefclassName(theEnv,(void *) cls)); return(0); } cls->handlers[mhi-1].mark = 1; DeallocateMarkedHandlers(theEnv,cls); return(1); #endif } #if DEBUGGING_FUNCTIONS /******************************************************************************* NAME : PPDefmessageHandlerCommand DESCRIPTION : Displays the pretty-print form (if any) for a handler INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (ppdefmessage-handler []) *******************************************************************************/ globle void PPDefmessageHandlerCommand( void *theEnv) { DATA_OBJECT temp; SYMBOL_HN *csym,*msym; char *tname; DEFCLASS *cls = NULL; unsigned mtype; HANDLER *hnd; if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",1,SYMBOL,&temp) == FALSE) return; csym = FindSymbolHN(theEnv,DOToString(temp)); if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",2,SYMBOL,&temp) == FALSE) return; msym = FindSymbolHN(theEnv,DOToString(temp)); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",3,SYMBOL,&temp) == FALSE) return; tname = DOToString(temp); } else tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY]; mtype = HandlerType(theEnv,"ppdefmessage-handler",tname); if (mtype == MERROR) { SetEvaluationError(theEnv,TRUE); return; } if (csym != NULL) cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(csym)); if (((cls == NULL) || (msym == NULL)) ? TRUE : ((hnd = FindHandlerByAddress(cls,msym,(unsigned) mtype)) == NULL)) { PrintErrorID(theEnv,"MSGCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find message-handler "); EnvPrintRouter(theEnv,WERROR,ValueToString(msym)); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,tname); EnvPrintRouter(theEnv,WERROR," for class "); EnvPrintRouter(theEnv,WERROR,ValueToString(csym)); EnvPrintRouter(theEnv,WERROR," in function ppdefmessage-handler.\n"); SetEvaluationError(theEnv,TRUE); return; } if (hnd->ppForm != NULL) PrintInChunks(theEnv,WDISPLAY,hnd->ppForm); } /***************************************************************************** NAME : ListDefmessageHandlersCommand DESCRIPTION : Depending on arguments, does lists handlers which match restrictions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (list-defmessage-handlers [ [inherit]])) *****************************************************************************/ globle void ListDefmessageHandlersCommand( void *theEnv) { int inhp; void *clsptr; if (EnvRtnArgCount(theEnv) == 0) EnvListDefmessageHandlers(theEnv,WDISPLAY,NULL,0); else { clsptr = ClassInfoFnxArgs(theEnv,"list-defmessage-handlers",&inhp); if (clsptr == NULL) return; EnvListDefmessageHandlers(theEnv,WDISPLAY,clsptr,inhp); } } /******************************************************************** NAME : PreviewSendCommand DESCRIPTION : Displays a list of the core for a message describing shadows,etc. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Temporary core created and destroyed NOTES : H/L Syntax: (preview-send ) ********************************************************************/ globle void PreviewSendCommand( void *theEnv) { DEFCLASS *cls; DATA_OBJECT temp; /* ============================= Get the class for the message ============================= */ if (EnvArgTypeCheck(theEnv,"preview-send",1,SYMBOL,&temp) == FALSE) return; cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (cls == NULL) { ClassExistError(theEnv,"preview-send",ValueToString(temp.value)); return; } if (EnvArgTypeCheck(theEnv,"preview-send",2,SYMBOL,&temp) == FALSE) return; EnvPreviewSend(theEnv,WDISPLAY,(void *) cls,DOToString(temp)); } /******************************************************** NAME : EnvGetDefmessageHandlerPPForm DESCRIPTION : Gets a message-handler pretty print form INPUTS : 1) Address of the handler's class 2) Index of the handler RETURNS : TRUE if printable, FALSE otherwise SIDE EFFECTS : None NOTES : None ********************************************************/ #if IBM_TBC #pragma argsused #endif globle char *EnvGetDefmessageHandlerPPForm( void *theEnv, void *ptr, unsigned theIndex) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) ptr)->handlers[theIndex-1].ppForm); } /******************************************************************* NAME : EnvListDefmessageHandlers DESCRIPTION : Lists message-handlers for a class INPUTS : 1) The logical name of the output 2) Class name (NULL to display all handlers) 3) A flag indicating whether to list inherited handlers or not RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *******************************************************************/ globle void EnvListDefmessageHandlers( void *theEnv, char *logName, void *vptr, int inhp) { DEFCLASS *cls; long cnt; PACKED_CLASS_LINKS plinks; if (vptr != NULL) { cls = (DEFCLASS *) vptr; if (inhp) cnt = DisplayHandlersInLinks(theEnv,logName,&cls->allSuperclasses,0); else { plinks.classCount = 1; plinks.classArray = &cls; cnt = DisplayHandlersInLinks(theEnv,logName,&plinks,0); } } else { plinks.classCount = 1; cnt = 0L; for (cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) { plinks.classArray = &cls; cnt += DisplayHandlersInLinks(theEnv,logName,&plinks,0); } } PrintTally(theEnv,logName,cnt,"message-handler","message-handlers"); } /******************************************************************** NAME : EnvPreviewSend DESCRIPTION : Displays a list of the core for a message describing shadows,etc. INPUTS : 1) Logical name of output 2) Class pointer 3) Message name-string RETURNS : Nothing useful SIDE EFFECTS : Temporary core created and destroyed NOTES : None ********************************************************************/ globle void EnvPreviewSend( void *theEnv, char *logicalName, void *clsptr, char *msgname) { HANDLER_LINK *core; SYMBOL_HN *msym; msym = FindSymbolHN(theEnv,msgname); if (msym == NULL) return; core = FindPreviewApplicableHandlers(theEnv,(DEFCLASS *) clsptr,msym); if (core != NULL) { DisplayCore(theEnv,logicalName,core,0); DestroyHandlerLinks(theEnv,core); } } /**************************************************** NAME : DisplayHandlersInLinks DESCRIPTION : Recursively displays all handlers for an array of classes INPUTS : 1) The logical name of the output 2) The packed class links 3) The index to print from the links RETURNS : The number of handlers printed SIDE EFFECTS : None NOTES : Used by DescribeClass() ****************************************************/ globle long DisplayHandlersInLinks( void *theEnv, char *logName, PACKED_CLASS_LINKS *plinks, unsigned theIndex) { register unsigned i; long cnt; cnt = (long) plinks->classArray[theIndex]->handlerCount; if (((int) theIndex) < (plinks->classCount - 1)) cnt += DisplayHandlersInLinks(theEnv,logName,plinks,theIndex + 1); for (i = 0 ; i < plinks->classArray[theIndex]->handlerCount ; i++) PrintHandler(theEnv,logName,&plinks->classArray[theIndex]->handlers[i],TRUE); return(cnt); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if ! RUN_TIME /********************************************************** NAME : CreateSystemHandlers DESCRIPTION : Attachess the system message-handlers after a (clear) INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : System handlers created NOTES : Must be called after CreateSystemClasses() **********************************************************/ static void CreateSystemHandlers( void *theEnv) { NewSystemHandler(theEnv,USER_TYPE_NAME,INIT_STRING,"init-slots",0); NewSystemHandler(theEnv,USER_TYPE_NAME,DELETE_STRING,"delete-instance",0); NewSystemHandler(theEnv,USER_TYPE_NAME,CREATE_STRING,"(create-instance)",0); #if DEBUGGING_FUNCTIONS NewSystemHandler(theEnv,USER_TYPE_NAME,PRINT_STRING,"ppinstance",0); #endif NewSystemHandler(theEnv,USER_TYPE_NAME,DIRECT_MODIFY_STRING,"(direct-modify)",1); NewSystemHandler(theEnv,USER_TYPE_NAME,MSG_MODIFY_STRING,"(message-modify)",1); NewSystemHandler(theEnv,USER_TYPE_NAME,DIRECT_DUPLICATE_STRING,"(direct-duplicate)",2); NewSystemHandler(theEnv,USER_TYPE_NAME,MSG_DUPLICATE_STRING,"(message-duplicate)",2); } #endif #if (! BLOAD_ONLY) && (! RUN_TIME) /************************************************************ NAME : WildDeleteHandler DESCRIPTION : Deletes a handler from a class INPUTS : 1) Class address (Can be NULL) 2) Message Handler Name (Can be NULL) 3) Type name ("primary", etc.) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Handler deleted if possible NOTES : None ************************************************************/ static int WildDeleteHandler( void *theEnv, DEFCLASS *cls, SYMBOL_HN *msym, char *tname) { int mtype; if (msym == NULL) msym = (SYMBOL_HN *) EnvAddSymbol(theEnv,"*"); if (tname != NULL) { mtype = (int) HandlerType(theEnv,"undefmessage-handler",tname); if (mtype == MERROR) return(0); } else mtype = -1; if (cls == NULL) { int success = 1; for (cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) if (DeleteHandler(theEnv,cls,msym,mtype,FALSE) == 0) success = 0; return(success); } return(DeleteHandler(theEnv,cls,msym,mtype,TRUE)); } #endif #if DEBUGGING_FUNCTIONS /****************************************************************** NAME : DefmessageHandlerWatchAccess DESCRIPTION : Parses a list of class names passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set 0 - Watch instance creation/deletion 1 - Watch slot changes to instances 2) The value to which to set the trace flags 3) A list of expressions containing the names of the classes for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified classes NOTES : Accessory function for AddWatchItem() ******************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DefmessageHandlerWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(DefmessageHandlerWatchSupport(theEnv,(char *) (newState ? "watch" : "unwatch"),NULL,(int) newState, NULL,EnvSetDefmessageHandlerWatch,argExprs)); } /*********************************************************************** NAME : DefclassWatchPrint DESCRIPTION : Parses a list of class names passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined 0 - Watch instance creation/deletion 1 - Watch slot changes to instances 3) A list of expressions containing the names of the classes for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified classes NOTES : Accessory function for AddWatchItem() ***********************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DefmessageHandlerWatchPrint( void *theEnv, char *logName, int code, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(DefmessageHandlerWatchSupport(theEnv,"list-watch-items",logName,-1, PrintHandlerWatchFlag,NULL,argExprs)); } /******************************************************* NAME : DefmessageHandlerWatchSupport DESCRIPTION : Sets or displays handlers specified INPUTS : 1) The calling function name 2) The logical output name for displays (can be NULL) 4) The new set state (can be -1) 5) The print function (can be NULL) 6) The trace function (can be NULL) 7) The handlers expression list RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handler trace flags set or displayed NOTES : None *******************************************************/ static unsigned DefmessageHandlerWatchSupport( void *theEnv, char *funcName, char *logName, int newState, void (*printFunc)(void *,char *,void *,unsigned), void (*traceFunc)(void *,int,void *,unsigned), EXPRESSION *argExprs) { struct defmodule *theModule; void *theClass; char *theHandlerStr; int theType; int argIndex = 2; DATA_OBJECT tmpData; /* =============================== If no handlers are specified, show the trace for all handlers in all handlers =============================== */ if (argExprs == NULL) { SaveCurrentModule(theEnv); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); if (traceFunc == NULL) { EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logName,":\n"); } theClass = EnvGetNextDefclass(theEnv,NULL); while (theClass != NULL) { if (WatchClassHandlers(theEnv,theClass,NULL,-1,logName,newState, TRUE,printFunc,traceFunc) == FALSE) return(FALSE); theClass = EnvGetNextDefclass(theEnv,theClass); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } RestoreCurrentModule(theEnv); return(TRUE); } /* ================================================ Set or show the traces for the specified handler ================================================ */ while (argExprs != NULL) { if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"class name"); return(FALSE); } theClass = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmpData)); if (theClass == NULL) { ExpectedTypeError1(theEnv,funcName,argIndex,"class name"); return(FALSE); } if (GetNextArgument(argExprs) != NULL) { argExprs = GetNextArgument(argExprs); argIndex++; if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler name"); return(FALSE); } theHandlerStr = DOToString(tmpData); if (GetNextArgument(argExprs) != NULL) { argExprs = GetNextArgument(argExprs); argIndex++; if (EvaluateExpression(theEnv,argExprs,&tmpData)) return(FALSE); if (tmpData.type != SYMBOL) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler type"); return(FALSE); } if ((theType = (int) HandlerType(theEnv,funcName,DOToString(tmpData))) == MERROR) return(FALSE); } else theType = -1; } else { theHandlerStr = NULL; theType = -1; } if (WatchClassHandlers(theEnv,theClass,theHandlerStr,theType,logName, newState,FALSE,printFunc,traceFunc) == FALSE) { ExpectedTypeError1(theEnv,funcName,argIndex,"handler"); return(FALSE); } argIndex++; argExprs = GetNextArgument(argExprs); } return(TRUE); } /******************************************************* NAME : WatchClassHandlers DESCRIPTION : Sets or displays handlers specified INPUTS : 1) The class 2) The handler name (or NULL wildcard) 3) The handler type (or -1 wildcard) 4) The logical output name for displays (can be NULL) 5) The new set state (can be -1) 6) The print function (can be NULL) 7) The trace function (can be NULL) RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handler trace flags set or displayed NOTES : None *******************************************************/ static unsigned WatchClassHandlers( void *theEnv, void *theClass, char *theHandlerStr, int theType, char *logName, int newState, int indentp, void (*printFunc)(void *,char *,void *,unsigned), void (*traceFunc)(void *,int,void *,unsigned)) { unsigned theHandler; int found = FALSE; theHandler = EnvGetNextDefmessageHandler(theEnv,theClass,0); while (theHandler != 0) { if ((theType == -1) ? TRUE : (theType == (int) ((DEFCLASS *) theClass)->handlers[theHandler-1].type)) { if ((theHandlerStr == NULL) ? TRUE : (strcmp(theHandlerStr,EnvGetDefmessageHandlerName(theEnv,theClass,theHandler)) == 0)) { if (traceFunc != NULL) (*traceFunc)(theEnv,newState,theClass,theHandler); else { if (indentp) EnvPrintRouter(theEnv,logName," "); (*printFunc)(theEnv,logName,theClass,theHandler); } found = TRUE; } } theHandler = EnvGetNextDefmessageHandler(theEnv,theClass,theHandler); } if ((theHandlerStr != NULL) && (theType != -1) && (found == FALSE)) return(FALSE); return(TRUE); } /*************************************************** NAME : PrintHandlerWatchFlag DESCRIPTION : Displays trace value for handler INPUTS : 1) The logical name of the output 2) The class 3) The handler index RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void PrintHandlerWatchFlag( void *theEnv, char *logName, void *theClass, unsigned theHandler) { EnvPrintRouter(theEnv,logName,EnvGetDefclassName(theEnv,theClass)); EnvPrintRouter(theEnv,logName," "); EnvPrintRouter(theEnv,logName,EnvGetDefmessageHandlerName(theEnv,theClass,theHandler)); EnvPrintRouter(theEnv,logName," "); EnvPrintRouter(theEnv,logName,EnvGetDefmessageHandlerType(theEnv,theClass,theHandler)); EnvPrintRouter(theEnv,logName,(char *) (EnvGetDefmessageHandlerWatch(theEnv,theClass,theHandler) ? " = on\n" : " = off\n")); } #endif /* DEBUGGING_FUNCTIONS */ #endif clips-6.24/clipssrc/._router.c0000400000175000017500000000075410441602316014421 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco,fi,finNZNjITTFHFFMWBBMPSRclips-6.24/clipssrc/rulepsr.h0000755000175000017500000000276007422634732014415 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* RULE PARSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Coordinates parsing of a rule. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_rulepsr #define _H_rulepsr #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDefrule(void *,char *); LOCALE struct lhsParseNode *FindVariable(struct symbolHashNode *, struct lhsParseNode *); #endif clips-6.24/clipssrc/tmpltdef.h0000755000175000017500000001275010441151173014524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.26 06/05/06 */ /* */ /* DEFTEMPLATE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_tmpltdef #define _H_tmpltdef struct deftemplate; struct templateSlot; struct deftemplateModule; #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #include "factbld.h" #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif struct deftemplate { struct constructHeader header; struct templateSlot *slotList; unsigned int implied : 1; unsigned int watch : 1; unsigned int inScope : 1; unsigned short numberOfSlots; long busyCount; struct factPatternNode *patternNetwork; struct fact *factList; struct fact *lastFact; }; struct templateSlot { struct symbolHashNode *slotName; unsigned int multislot : 1; unsigned int noDefault : 1; unsigned int defaultPresent : 1; unsigned int defaultDynamic : 1; CONSTRAINT_RECORD *constraints; struct expr *defaultList; struct templateSlot *next; }; struct deftemplateModule { struct defmoduleItemHeader header; }; #define DEFTEMPLATE_DATA 5 struct deftemplateData { struct construct *DeftemplateConstruct; int DeftemplateModuleIndex; struct entityRecord DeftemplatePtrRecord; #if DEBUGGING_FUNCTIONS int DeletedTemplateDebugFlags; #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DeftemplateCodeItem; #endif #if (! RUN_TIME) && (! BLOAD_ONLY) int DeftemplateError; #endif }; #define EnvGetDeftemplateName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define EnvGetDeftemplatePPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define EnvDeftemplateModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define DeftemplateData(theEnv) ((struct deftemplateData *) GetEnvironmentData(theEnv,DEFTEMPLATE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define FindDeftemplate(theEnv,a) EnvFindDeftemplate(theEnv,a) #define GetNextDeftemplate(theEnv,a) EnvGetNextDeftemplate(theEnv,a) #define IsDeftemplateDeletable(theEnv,a) EnvIsDeftemplateDeletable(theEnv,a) #define GetDeftemplateName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define GetDeftemplatePPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetNextFactInTemplate(theEnv,a,b) EnvGetNextFactInTemplate(theEnv,a,b) #define DeftemplateModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #else #define FindDeftemplate(a) EnvFindDeftemplate(GetCurrentEnvironment(),a) #define GetNextDeftemplate(a) EnvGetNextDeftemplate(GetCurrentEnvironment(),a) #define IsDeftemplateDeletable(a) EnvIsDeftemplateDeletable(GetCurrentEnvironment(),a) #define GetDeftemplateName(x) GetConstructNameString((struct constructHeader *) x) #define GetDeftemplatePPForm(x) GetConstructPPForm(GetCurrentEnvironment(),(struct constructHeader *) x) #define GetNextFactInTemplate(a,b) EnvGetNextFactInTemplate(GetCurrentEnvironment(),a,b) #define DeftemplateModule(x) GetConstructModuleName((struct constructHeader *) x) #endif LOCALE void InitializeDeftemplates(void *); LOCALE void *EnvFindDeftemplate(void *,char *); LOCALE void *EnvGetNextDeftemplate(void *,void *); LOCALE intBool EnvIsDeftemplateDeletable(void *,void *); LOCALE void *EnvGetNextFactInTemplate(void *,void *,void *); LOCALE struct deftemplateModule *GetDeftemplateModuleItem(void *,struct defmodule *); LOCALE void ReturnSlots(void *,struct templateSlot *); LOCALE void IncrementDeftemplateBusyCount(void *,void *); LOCALE void DecrementDeftemplateBusyCount(void *,void *); #endif clips-6.24/clipssrc/dffnxpsr.h0000755000175000017500000000305110441112015014521 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_dffnxpsr #define _H_dffnxpsr #if DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ParseDeffunction(void *,char *); #ifndef _DFFNXPSR_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/strngrtr.h0000755000175000017500000000455207422634607014610 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* STRING I/O ROUTER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: I/O Router routines which allow strings to be */ /* used as input and output sources. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_strngrtr #define _H_strngrtr #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define STRING_ROUTER_DATA 48 struct stringRouter { char *name; char *str; int currentPosition; unsigned maximumPosition; int readWriteType; struct stringRouter *next; }; struct stringRouterData { struct stringRouter *ListOfStringRouters; }; #define StringRouterData(theEnv) ((struct stringRouterData *) GetEnvironmentData(theEnv,STRING_ROUTER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _STRNGRTR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /**************************/ /* I/O ROUTER DEFINITIONS */ /**************************/ LOCALE void InitializeStringRouter(void *); LOCALE int OpenStringSource(void *,char *,char *,int); LOCALE int OpenTextSource(void *,char *,char *,int,unsigned); LOCALE int CloseStringSource(void *,char *); LOCALE int OpenStringDestination(void *,char *,char *,unsigned); LOCALE int CloseStringDestination(void *,char *); #endif clips-6.24/clipssrc/factgen.h0000755000175000017500000001672107422634625014333 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT RETE FUNCTION GENERATION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factgen #define _H_factgen #ifndef _H_reorder #include "reorder.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTGEN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /**********************************************************/ /* factGetVarPN1Call: This structure is used to store the */ /* arguments to the most general extraction routine for */ /* retrieving a variable from the fact pattern network. */ /**********************************************************/ struct factGetVarPN1Call { unsigned int factAddress : 1; unsigned int allFields : 1; unsigned short whichField; unsigned short whichSlot; }; /***********************************************************/ /* factGetVarPN2Call: This structure is used to store the */ /* arguments to the most specific extraction routine for */ /* retrieving a variable from the fact pattern network. */ /* It is used for retrieving the single value stored in */ /* a single field slot (the slot index can be used to */ /* directly to retrieve the value from the fact array). */ /***********************************************************/ struct factGetVarPN2Call { unsigned short whichSlot; }; /**********************************************************/ /* factGetVarPN3Call: */ /**********************************************************/ struct factGetVarPN3Call { unsigned int fromBeginning : 1; unsigned int fromEnd : 1; unsigned short beginOffset; unsigned short endOffset; unsigned short whichSlot; }; /**************************************************************/ /* factConstantPN1Call: Used for testing for a constant value */ /* in the fact pattern network. Compare the value of a */ /* single field slot to a constant. */ /**************************************************************/ struct factConstantPN1Call { unsigned int testForEquality : 1; unsigned int whichSlot : 8; }; /******************************************************************/ /* factConstantPN2Call: Used for testing for a constant value in */ /* the fact pattern network. Compare the value of a multifield */ /* slot to a constant (where the value retrieved for comparison */ /* from the slot contains no multifields before or only one */ /* multifield before and none after). */ /******************************************************************/ struct factConstantPN2Call { unsigned int testForEquality : 1; unsigned int fromBeginning : 1; unsigned int offset : 8; unsigned int whichSlot : 8; }; /**********************************************************/ /* factGetVarJN1Call: This structure is used to store the */ /* arguments to the most general extraction routine for */ /* retrieving a fact variable from the join network. */ /**********************************************************/ struct factGetVarJN1Call { unsigned int factAddress : 1; unsigned int allFields : 1; unsigned short whichPattern; unsigned short whichSlot; unsigned short whichField; }; /**********************************************************/ /* factGetVarJN2Call: */ /**********************************************************/ struct factGetVarJN2Call { unsigned short whichPattern; unsigned short whichSlot; }; /**********************************************************/ /* factGetVarJN3Call: */ /**********************************************************/ struct factGetVarJN3Call { unsigned int fromBeginning : 1; unsigned int fromEnd : 1; unsigned short beginOffset; unsigned short endOffset; unsigned short whichPattern; unsigned short whichSlot; }; /**********************************************************/ /* factCompVarsPN1Call: */ /**********************************************************/ struct factCompVarsPN1Call { unsigned int pass : 1; unsigned int fail : 1; unsigned int field1 : 7; unsigned int field2 : 7; }; /**********************************************************/ /* factCompVarsJN1Call: */ /**********************************************************/ struct factCompVarsJN1Call { unsigned int pass : 1; unsigned int fail : 1; unsigned int slot1 : 7; unsigned int pattern2 : 8; unsigned int slot2 : 7; }; /**********************************************************/ /* factCompVarsJN2Call: */ /**********************************************************/ struct factCompVarsJN2Call { unsigned int pass : 1; unsigned int fail : 1; unsigned int slot1 : 7; unsigned int fromBeginning1 : 1; unsigned int offset1 : 7; unsigned int pattern2 : 8; unsigned int slot2 : 7; unsigned int fromBeginning2 : 1; unsigned int offset2 : 7; }; /**********************************************************/ /* factCheckLengthPNCall: This structure is used to store */ /* the arguments to the routine for determining if the */ /* length of a multifield slot is equal or greater than */ /* a specified value. */ /**********************************************************/ struct factCheckLengthPNCall { unsigned int exactly : 1; unsigned short minLength; unsigned short whichSlot; }; /****************************************/ /* GLOBAL EXTERNAL FUNCTION DEFINITIONS */ /****************************************/ LOCALE void InitializeFactReteFunctions(void *); LOCALE struct expr *FactPNVariableComparison(void *,struct lhsParseNode *, struct lhsParseNode *); LOCALE struct expr *FactJNVariableComparison(void *,struct lhsParseNode *, struct lhsParseNode *); LOCALE void FactReplaceGetvar(void *,struct expr *,struct lhsParseNode *); LOCALE void FactReplaceGetfield(void *,struct expr *,struct lhsParseNode *); LOCALE struct expr *FactGenPNConstant(void *,struct lhsParseNode *); LOCALE struct expr *FactGenGetfield(void *,struct lhsParseNode *); LOCALE struct expr *FactGenGetvar(void *,struct lhsParseNode *); LOCALE struct expr *FactGenCheckLength(void *,struct lhsParseNode *); LOCALE struct expr *FactGenCheckZeroLength(void *,unsigned); #endif clips-6.24/clipssrc/._cstrnbin.h0000400000175000017500000000012207422634707014733 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/envrnmnt.h0000755000175000017500000000760710441602151014556 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* ENVRNMNT HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for supporting multiple environments. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added CreateRuntimeEnvironment function. */ /* */ /* Added support for context information when an */ /* environment is created (i.e a pointer from the */ /* CLIPS environment to its parent environment). */ /* */ /*************************************************************/ #ifndef _H_envrnmnt #define _H_envrnmnt #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _ENVRNMNT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define USER_ENVIRONMENT_DATA 70 #define MAXIMUM_ENVIRONMENT_POSITIONS 100 struct environmentCleanupFunction { char *name; void (*func)(void *); int priority; struct environmentCleanupFunction *next; }; struct environmentData { unsigned int initialized : 1; unsigned long environmentIndex; void *context; void *routerContext; void **theData; void (**cleanupFunctions)(void *); struct environmentCleanupFunction *listOfCleanupEnvironmentFunctions; struct environmentData *next; }; typedef struct environmentData ENVIRONMENT_DATA; typedef struct environmentData * ENVIRONMENT_DATA_PTR; #define GetEnvironmentData(theEnv,position) (((struct environmentData *) theEnv)->theData[position]) #define SetEnvironmentData(theEnv,position,value) (((struct environmentData *) theEnv)->theData[position] = value) LOCALE intBool AllocateEnvironmentData(void *,unsigned int,unsigned long,void (*)(void *)); LOCALE intBool DeallocateEnvironmentData(void); #if ALLOW_ENVIRONMENT_GLOBALS LOCALE void SetCurrentEnvironment(void *); LOCALE intBool SetCurrentEnvironmentByIndex(unsigned long); LOCALE void *GetEnvironmentByIndex(unsigned long); LOCALE void *GetCurrentEnvironment(void); LOCALE unsigned long GetEnvironmentIndex(void *); #endif LOCALE void *CreateEnvironment(void); LOCALE void *CreateRuntimeEnvironment(struct symbolHashNode **,struct floatHashNode **, struct integerHashNode **,struct bitMapHashNode **); LOCALE intBool DestroyEnvironment(void *); LOCALE intBool AddEnvironmentCleanupFunction(void *,char *,void (*)(void *),int); LOCALE void *GetEnvironmentContext(void *); LOCALE void *SetEnvironmentContext(void *,void *); LOCALE void *GetEnvironmentRouterContext(void *); LOCALE void *SetEnvironmentRouterContext(void *,void *); #endif clips-6.24/clipssrc/defins.c0000755000175000017500000007702210441131540014147 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* DEFINSTANCES MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Kernel definstances interface commands */ /* and routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFINSTANCES_CONSTRUCT #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "dfinsbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "dfinscmp.h" #endif #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "cstrccom.h" #include "cstrcpsr.h" #include "constant.h" #include "constrct.h" #include "envrnmnt.h" #include "evaluatn.h" #include "extnfunc.h" #include "insfun.h" #include "inspsr.h" #include "memalloc.h" #include "modulpsr.h" #include "router.h" #include "scanner.h" #include "symbol.h" #include "utility.h" #define _DEFINS_SOURCE_ #include "defins.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define ACTIVE_RLN "active" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if (! BLOAD_ONLY) && (! RUN_TIME) static int ParseDefinstances(void *,char *); static SYMBOL_HN *ParseDefinstancesName(void *,char *,int *); static void RemoveDefinstances(void *,void *); static void SaveDefinstances(void *,void *,char *); static intBool RemoveAllDefinstances(void *); static void DefinstancesDeleteError(void *,char *); #if DEFRULE_CONSTRUCT static void CreateInitialDefinstances(void *); #endif #endif #if ! RUN_TIME static void *AllocateModule(void *); static void ReturnModule(void *,void *); static intBool ClearDefinstancesReady(void *); static void CheckDefinstancesBusy(void *,struct constructHeader *,void *); static void DestroyDefinstancesAction(void *,struct constructHeader *,void *); #endif static void ResetDefinstances(void *); static void ResetDefinstancesAction(void *,struct constructHeader *,void *); static void DeallocateDefinstancesData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupDefinstances DESCRIPTION : Adds the definstance support routines to the Kernel INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Appropriate function lists modified NOTES : None ***************************************************/ globle void SetupDefinstances( void *theEnv) { AllocateEnvironmentData(theEnv,DEFINSTANCES_DATA,sizeof(struct definstancesData),DeallocateDefinstancesData); DefinstancesData(theEnv)->DefinstancesModuleIndex = RegisterModuleItem(theEnv,"definstances", #if (! RUN_TIME) AllocateModule,ReturnModule, #else NULL,NULL, #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefinstancesModuleRef, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefinstancesCModuleReference, #else NULL, #endif EnvFindDefinstances); DefinstancesData(theEnv)->DefinstancesConstruct = AddConstruct(theEnv,"definstances","definstances", #if (! BLOAD_ONLY) && (! RUN_TIME) ParseDefinstances, #else NULL, #endif EnvFindDefinstances, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefinstances,SetNextConstruct, EnvIsDefinstancesDeletable,EnvUndefinstances, #if (! BLOAD_ONLY) && (! RUN_TIME) RemoveDefinstances #else NULL #endif ); #if ! RUN_TIME AddClearReadyFunction(theEnv,"definstances",ClearDefinstancesReady,0); #if ! BLOAD_ONLY EnvDefineFunction2(theEnv,"undefinstances",'v',PTIEF UndefinstancesCommand,"UndefinstancesCommand","11w"); AddSaveFunction(theEnv,"definstances",SaveDefinstances,0); #if DEFRULE_CONSTRUCT EnvAddClearFunction(theEnv,"definstances",CreateInitialDefinstances,-1000); #endif #endif #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"ppdefinstances",'v',PTIEF PPDefinstancesCommand ,"PPDefinstancesCommand","11w"); EnvDefineFunction2(theEnv,"list-definstances",'v',PTIEF ListDefinstancesCommand,"ListDefinstancesCommand","01"); #endif EnvDefineFunction2(theEnv,"get-definstances-list",'m',PTIEF GetDefinstancesListFunction, "GetDefinstancesListFunction","01"); EnvDefineFunction2(theEnv,"definstances-module",'w',PTIEF GetDefinstancesModuleCommand, "GetDefinstancesModuleCommand","11w"); #endif EnvAddResetFunction(theEnv,"definstances",(void (*)(void *)) ResetDefinstances,0); #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE SetupDefinstancesBload(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) SetupDefinstancesCompiler(theEnv); #endif } /*******************************************************/ /* DeallocateDefinstancesData: Deallocates environment */ /* data for the definstances construct. */ /*******************************************************/ static void DeallocateDefinstancesData( void *theEnv) { #if ! RUN_TIME struct definstancesModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct definstancesModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefinstancesData(theEnv)->DefinstancesModuleIndex); rtn_struct(theEnv,definstancesModule,theModuleItem); } #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /*****************************************************/ /* DestroyDefinstancesAction: Action used to remove */ /* definstances as a result of DestroyEnvironment. */ /*****************************************************/ #if IBM_TBC #pragma argsused #endif static void DestroyDefinstancesAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct definstances *theDefinstances = (struct definstances *) theConstruct; if (theDefinstances == NULL) return; ReturnPackedExpression(theEnv,theDefinstances->mkinstance); DestroyConstructHeader(theEnv,&theDefinstances->header); rtn_struct(theEnv,definstances,theDefinstances); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theConstruct,theEnv) #endif #endif } #endif /*********************************************************** NAME : EnvGetNextDefinstances DESCRIPTION : Finds first or next definstances INPUTS : The address of the current definstances RETURNS : The address of the next definstances (NULL if none) SIDE EFFECTS : None NOTES : If ptr == NULL, the first definstances is returned. ***********************************************************/ globle void *EnvGetNextDefinstances( void *theEnv, void *ptr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr, DefinstancesData(theEnv)->DefinstancesModuleIndex)); } /*************************************************** NAME : EnvFindDefinstances DESCRIPTION : Looks up a definstance construct by name-string INPUTS : The symbolic name RETURNS : The definstance address, or NULL if not found SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvFindDefinstances( void *theEnv, char *name) { return(FindNamedConstruct(theEnv,name,DefinstancesData(theEnv)->DefinstancesConstruct)); } /*************************************************** NAME : EnvIsDefinstancesDeletable DESCRIPTION : Determines if a definstances can be deleted INPUTS : Address of the definstances RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle int EnvIsDefinstancesDeletable( void *theEnv, void *ptr) { if (! ConstructsDeletable(theEnv)) { return FALSE; } return((((DEFINSTANCES *) ptr)->busy == 0) ? TRUE : FALSE); } /*********************************************************** NAME : UndefinstancesCommand DESCRIPTION : Removes a definstance INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Definstance deallocated NOTES : H/L Syntax : (undefinstances | *) ***********************************************************/ globle void UndefinstancesCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefinstances",DefinstancesData(theEnv)->DefinstancesConstruct); } /***************************************************************** NAME : GetDefinstancesModuleCommand DESCRIPTION : Determines to which module a definstances belongs INPUTS : None RETURNS : The symbolic name of the module SIDE EFFECTS : None NOTES : H/L Syntax: (definstances-module ) *****************************************************************/ globle void *GetDefinstancesModuleCommand( void *theEnv) { return(GetConstructModuleCommand(theEnv,"definstances-module",DefinstancesData(theEnv)->DefinstancesConstruct)); } /*********************************************************** NAME : EnvUndefinstances DESCRIPTION : Removes a definstance INPUTS : Address of definstances to remove RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Definstance deallocated NOTES : None ***********************************************************/ globle intBool EnvUndefinstances( void *theEnv, void *vptr) { #if RUN_TIME || BLOAD_ONLY #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv,vptr) #endif return(FALSE); #else DEFINSTANCES *dptr; dptr = (DEFINSTANCES *) vptr; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); #endif if (dptr == NULL) return(RemoveAllDefinstances(theEnv)); if (EnvIsDefinstancesDeletable(theEnv,vptr) == FALSE) return(FALSE); RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr); RemoveDefinstances(theEnv,(void *) dptr); return(TRUE); #endif } #if DEBUGGING_FUNCTIONS /*************************************************************** NAME : PPDefinstancesCommand DESCRIPTION : Prints out the pretty-print form of a definstance INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (ppdefinstances ) ***************************************************************/ globle void PPDefinstancesCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefinstances",DefinstancesData(theEnv)->DefinstancesConstruct); } /*************************************************** NAME : ListDefinstancesCommand DESCRIPTION : Displays all definstances names INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Definstances name sprinted NOTES : H/L Interface ***************************************************/ globle void ListDefinstancesCommand( void *theEnv) { ListConstructCommand(theEnv,"list-definstances",DefinstancesData(theEnv)->DefinstancesConstruct); } /*************************************************** NAME : EnvListDefinstances DESCRIPTION : Displays all definstances names INPUTS : 1) The logical name of the output 2) The module RETURNS : Nothing useful SIDE EFFECTS : Definstances names printed NOTES : C Interface ***************************************************/ globle void EnvListDefinstances( void *theEnv, char *logicalName, struct defmodule *theModule) { ListConstruct(theEnv,DefinstancesData(theEnv)->DefinstancesConstruct,logicalName,theModule); } #endif /**************************************************************** NAME : GetDefinstancesListFunction DESCRIPTION : Groups all definstances names into a multifield list INPUTS : A data object buffer to hold the multifield result RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : H/L Syntax: (get-definstances-list []) ****************************************************************/ globle void GetDefinstancesListFunction( void *theEnv, DATA_OBJECT*returnValue) { GetConstructListFunction(theEnv,"get-definstances-list",returnValue,DefinstancesData(theEnv)->DefinstancesConstruct); } /*************************************************************** NAME : EnvGetDefinstancesList DESCRIPTION : Groups all definstances names into a multifield list INPUTS : 1) A data object buffer to hold the multifield result 2) The module from which to obtain definstances RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : External C access ***************************************************************/ globle void EnvGetDefinstancesList( void *theEnv, DATA_OBJECT *returnValue, struct defmodule *theModule) { GetConstructList(theEnv,returnValue,DefinstancesData(theEnv)->DefinstancesConstruct,theModule); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if (! BLOAD_ONLY) && (! RUN_TIME) /********************************************************************* NAME : ParseDefinstances DESCRIPTION : Parses and allocates a definstances construct INPUTS : The logical name of the input source RETURNS : FALSE if no errors, TRUE otherwise SIDE EFFECTS : Definstances parsed and created NOTES : H/L Syntax : (definstances [active] [] +) ::= ( of *) ::= ( *) *********************************************************************/ static int ParseDefinstances( void *theEnv, char *readSource) { SYMBOL_HN *dname; void *mkinsfcall; EXPRESSION *mkinstance,*mkbot = NULL; DEFINSTANCES *dobj; int active; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(definstances "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"definstances"); return(TRUE); } #endif dname = ParseDefinstancesName(theEnv,readSource,&active); if (dname == NULL) return(TRUE); dobj = get_struct(theEnv,definstances); InitializeConstructHeader(theEnv,"definstances",(struct constructHeader *) dobj,dname); dobj->busy = 0; dobj->mkinstance = NULL; #if DEFRULE_CONSTRUCT mkinsfcall = (void *) FindFunction(theEnv,(char *) (active ? "active-make-instance" : "make-instance")); #else mkinsfcall = (void *) FindFunction(theEnv,"make-instance"); #endif while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { mkinstance = GenConstant(theEnv,UNKNOWN_VALUE,mkinsfcall); mkinstance = ParseInitializeInstance(theEnv,mkinstance,readSource); if (mkinstance == NULL) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(TRUE); } if (ExpressionContainsVariables(mkinstance,FALSE) == TRUE) { LocalVariableErrorMessage(theEnv,"definstances"); ReturnExpression(theEnv,mkinstance); ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(TRUE); } if (mkbot == NULL) dobj->mkinstance = mkinstance; else GetNextArgument(mkbot) = mkinstance; mkbot = mkinstance; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); SyntaxErrorMessage(theEnv,"definstances"); return(TRUE); } else { if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(FALSE); } #if DEBUGGING_FUNCTIONS if (EnvGetConserveMemory(theEnv) == FALSE) { if (dobj->mkinstance != NULL) PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")\n"); SetDefinstancesPPForm((void *) dobj,CopyPPBuffer(theEnv)); } #endif mkinstance = dobj->mkinstance; dobj->mkinstance = PackExpression(theEnv,mkinstance); ReturnExpression(theEnv,mkinstance); IncrementSymbolCount(GetDefinstancesNamePointer((void *) dobj)); ExpressionInstall(theEnv,dobj->mkinstance); } AddConstructToModule((struct constructHeader *) dobj); return(FALSE); } /************************************************************* NAME : ParseDefinstancesName DESCRIPTION : Parses definstance name and optional comment and optional "active" keyword INPUTS : 1) The logical name of the input source 2) Buffer to hold flag indicating if definstances should cause pattern-matching to occur during slot-overrides RETURNS : Address of name symbol, or NULL if there was an error SIDE EFFECTS : Token after name or comment is scanned NOTES : Assumes "(definstances" has already been scanned. *************************************************************/ static SYMBOL_HN *ParseDefinstancesName( void *theEnv, char *readSource, int *active) { SYMBOL_HN *dname; *active = FALSE; dname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"definstances", EnvFindDefinstances,EnvUndefinstances,"@", TRUE,FALSE,TRUE); if (dname == NULL) return(NULL); #if DEFRULE_CONSTRUCT if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? FALSE : (strcmp(ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken)),ACTIVE_RLN) == 0)) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); *active = TRUE; } #endif if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } return(dname); } /************************************************************** NAME : RemoveDefinstances DESCRIPTION : Deallocates and removes a definstance construct INPUTS : The definstance address RETURNS : Nothing useful SIDE EFFECTS : Existing definstance construct deleted NOTES : Assumes busy count of definstance is 0 **************************************************************/ static void RemoveDefinstances( void *theEnv, void *vdptr) { DEFINSTANCES *dptr = (DEFINSTANCES *) vdptr; DecrementSymbolCount(theEnv,GetDefinstancesNamePointer((void *) dptr)); ExpressionDeinstall(theEnv,dptr->mkinstance); ReturnPackedExpression(theEnv,dptr->mkinstance); SetDefinstancesPPForm((void *) dptr,NULL); ClearUserDataList(theEnv,dptr->header.usrData); rtn_struct(theEnv,definstances,dptr); } /*************************************************** NAME : SaveDefinstances DESCRIPTION : Prints pretty print form of definstances to specified output INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void SaveDefinstances( void *theEnv, void *theModule, char *logName) { SaveConstruct(theEnv,theModule,logName,DefinstancesData(theEnv)->DefinstancesConstruct); } /*************************************************** NAME : RemoveAllDefinstances DESCRIPTION : Removes all definstances constructs INPUTS : None RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : All definstances deallocated NOTES : None ***************************************************/ static intBool RemoveAllDefinstances( void *theEnv) { DEFINSTANCES *dptr,*dhead; int success = TRUE; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); #endif dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,NULL); while (dhead != NULL) { dptr = dhead; dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,(void *) dhead); if (EnvIsDefinstancesDeletable(theEnv,(void *) dptr)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDefinstances(theEnv,(void *) dptr); } else { DefinstancesDeleteError(theEnv,EnvGetDefinstancesName(theEnv,(void *) dptr)); success = FALSE; } } return(success); } /*************************************************** NAME : DefinstancesDeleteError DESCRIPTION : Prints an error message for unsuccessful definstances deletion attempts INPUTS : The name of the definstances RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ***************************************************/ static void DefinstancesDeleteError( void *theEnv, char *dname) { CantDeleteItemErrorMessage(theEnv,"definstances",dname); } #if DEFRULE_CONSTRUCT /******************************************************** NAME : CreateInitialDefinstances DESCRIPTION : Makes the initial-object definstances structure for creating an initial-object which will match default object patterns in defrules INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : initial-object definstances created NOTES : None ********************************************************/ static void CreateInitialDefinstances( void *theEnv) { EXPRESSION *tmp; DEFINSTANCES *theDefinstances; theDefinstances = get_struct(theEnv,definstances); InitializeConstructHeader(theEnv,"definstances",(struct constructHeader *) theDefinstances, DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); theDefinstances->busy = 0; tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance")); tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); tmp->argList->nextArg = GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME)); theDefinstances->mkinstance = PackExpression(theEnv,tmp); ReturnExpression(theEnv,tmp); IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances)); ExpressionInstall(theEnv,theDefinstances->mkinstance); AddConstructToModule((struct constructHeader *) theDefinstances); } #endif #endif #if ! RUN_TIME /***************************************************** 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)); } /*************************************************** NAME : ReturnModule DESCRIPTION : Removes a definstances module and all associated definstances INPUTS : The definstances module RETURNS : Nothing useful SIDE EFFECTS : Module and definstances deleted NOTES : None ***************************************************/ static void ReturnModule( void *theEnv, void *theItem) { #if (! BLOAD_ONLY) FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefinstancesData(theEnv)->DefinstancesConstruct); #endif rtn_struct(theEnv,definstancesModule,theItem); } /*************************************************** NAME : ClearDefinstancesReady DESCRIPTION : Determines if it is safe to remove all definstances Assumes *all* constructs will be deleted INPUTS : None RETURNS : TRUE if all definstances can be deleted, FALSE otherwise SIDE EFFECTS : None NOTES : Used by (clear) and (bload) ***************************************************/ static intBool ClearDefinstancesReady( void *theEnv) { int flagBuffer = TRUE; DoForAllConstructs(theEnv,CheckDefinstancesBusy,DefinstancesData(theEnv)->DefinstancesModuleIndex, FALSE,(void *) &flagBuffer); return(flagBuffer); } /*************************************************** NAME : CheckDefinstancesBusy DESCRIPTION : Determines if a definstances is in use or not INPUTS : 1) The definstances 2) A buffer to set to 0 if the the definstances is busy RETURNS : Nothing useful SIDE EFFECTS : Buffer set to 0 if definstances busy NOTES : The flag buffer is not modified if definstances is not busy (assumed to be initialized to 1) ***************************************************/ #if IBM_TBC #pragma argsused #endif static void CheckDefinstancesBusy( void *theEnv, struct constructHeader *theDefinstances, void *userBuffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (((DEFINSTANCES *) theDefinstances)->busy > 0) * (int *) userBuffer = FALSE; } #endif /*************************************************** NAME : ResetDefinstances DESCRIPTION : Calls EvaluateExpression for each of the make-instance calls in all of the definstances constructs INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : All instances in the definstances are evaluated (and created if there are no errors) Any previously existing instances are deleted first. NOTES : None ***************************************************/ static void ResetDefinstances( void *theEnv) { DoForAllConstructs(theEnv,ResetDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,TRUE,NULL); } /*************************************************** NAME : ResetDefinstancesAction DESCRIPTION : Performs all the make-instance calls in a definstances INPUTS : 1) The definstances 2) User data buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Instances created NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void ResetDefinstancesAction( void *theEnv, struct constructHeader *vDefinstances, void *userBuffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(userBuffer) #endif DEFINSTANCES *theDefinstances = (DEFINSTANCES *) vDefinstances; EXPRESSION *theExp; DATA_OBJECT temp; SaveCurrentModule(theEnv); EnvSetCurrentModule(theEnv,(void *) vDefinstances->whichModule->theModule); theDefinstances->busy++; for (theExp = theDefinstances->mkinstance ; theExp != NULL ; theExp = GetNextArgument(theExp)) { EvaluateExpression(theEnv,theExp,&temp); if (EvaluationData(theEnv)->HaltExecution || ((GetType(temp) == SYMBOL) && (GetValue(temp) == EnvFalseSymbol(theEnv)))) { RestoreCurrentModule(theEnv); theDefinstances->busy--; return; } } theDefinstances->busy--; RestoreCurrentModule(theEnv); } #endif clips-6.24/clipssrc/textpro.h0000755000175000017500000000365010441126763014420 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* TEXT PROCESSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added get-region function. */ /* */ /*************************************************************/ #ifndef _H_textpro #define _H_textpro #ifdef LOCALE #undef LOCALE #endif #ifdef _TEXTPRO_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if TEXTPRO_FUNCTIONS LOCALE void FetchCommand(void *,DATA_OBJECT *); LOCALE int PrintRegionCommand(void *); LOCALE void *GetRegionCommand(void *); int TossCommand(void *); #endif #if HELP_FUNCTIONS LOCALE void HelpFunction(void *); LOCALE void HelpPathFunction(void *); #endif LOCALE void HelpFunctionDefinitions(void *); #endif clips-6.24/clipssrc/commline.c0000755000175000017500000010142010441602065014475 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* COMMAND LINE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of routines for processing */ /* commands entered at the top level prompt. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Refactored several functions and added */ /* additional functions for use by an interface */ /* layered on top of CLIPS. */ /* */ /*************************************************************/ #define _COMMLINE_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "argacces.h" #include "constrct.h" #include "cstrcpsr.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "filecom.h" #include "memalloc.h" #include "prcdrfun.h" #include "prcdrpsr.h" #include "router.h" #include "scanner.h" #include "strngrtr.h" #include "symbol.h" #include "utility.h" #include "commline.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if ! RUN_TIME static int DoString(char *,int,int *); static int DoComment(char *,int); static int DoWhiteSpace(char *,int); static int DefaultGetNextEvent(void *); #endif static void DeallocateCommandLineData(void *); /****************************************************/ /* InitializeCommandLineData: Allocates environment */ /* data for command line functionality. */ /****************************************************/ globle void InitializeCommandLineData( void *theEnv) { AllocateEnvironmentData(theEnv,COMMANDLINE_DATA,sizeof(struct commandLineData),DeallocateCommandLineData); #if ! RUN_TIME CommandLineData(theEnv)->BannerString = BANNER_STRING; CommandLineData(theEnv)->EventFunction = DefaultGetNextEvent; #endif } /*******************************************************/ /* DeallocateCommandLineData: Deallocates environment */ /* data for the command line functionality. */ /******************************************************/ static void DeallocateCommandLineData( void *theEnv) { #if ! RUN_TIME if (CommandLineData(theEnv)->CommandString != NULL) { rm(theEnv,CommandLineData(theEnv)->CommandString,CommandLineData(theEnv)->MaximumCharacters); } #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /***************************************************/ /* ExpandCommandString: Appends a character to the */ /* command string. Returns TRUE if the command */ /* string was successfully expanded, otherwise */ /* FALSE. Expanding the string also includes */ /* adding a backspace character which reduces */ /* string's length. */ /***************************************************/ globle int ExpandCommandString( void *theEnv, int inchar) { register int k; k = RouterData(theEnv)->CommandBufferInputCount; CommandLineData(theEnv)->CommandString = ExpandStringWithChar(theEnv,inchar,CommandLineData(theEnv)->CommandString,&RouterData(theEnv)->CommandBufferInputCount, &CommandLineData(theEnv)->MaximumCharacters,CommandLineData(theEnv)->MaximumCharacters+80); return((RouterData(theEnv)->CommandBufferInputCount != k) ? TRUE : FALSE); } /******************************************************************/ /* FlushCommandString: Empties the contents of the CommandString. */ /******************************************************************/ globle void FlushCommandString( void *theEnv) { if (CommandLineData(theEnv)->CommandString != NULL) rm(theEnv,CommandLineData(theEnv)->CommandString,CommandLineData(theEnv)->MaximumCharacters); CommandLineData(theEnv)->CommandString = NULL; CommandLineData(theEnv)->MaximumCharacters = 0; RouterData(theEnv)->CommandBufferInputCount = 0; } /*********************************************************************************/ /* SetCommandString: Sets the contents of the CommandString to a specific value. */ /*********************************************************************************/ globle void SetCommandString( void *theEnv, char *str) { unsigned length; FlushCommandString(theEnv); length = strlen(str); CommandLineData(theEnv)->CommandString = (char *) genrealloc(theEnv,CommandLineData(theEnv)->CommandString,(unsigned) CommandLineData(theEnv)->MaximumCharacters, (unsigned) CommandLineData(theEnv)->MaximumCharacters + length + 1); strcpy(CommandLineData(theEnv)->CommandString,str); CommandLineData(theEnv)->MaximumCharacters += (length + 1); RouterData(theEnv)->CommandBufferInputCount += (int) length; } /*************************************************************/ /* SetNCommandString: Sets the contents of the CommandString */ /* to a specific value up to N characters. */ /*************************************************************/ globle void SetNCommandString( void *theEnv, char *str, unsigned length) { FlushCommandString(theEnv); CommandLineData(theEnv)->CommandString = (char *) genrealloc(theEnv,CommandLineData(theEnv)->CommandString,(unsigned) CommandLineData(theEnv)->MaximumCharacters, (unsigned) CommandLineData(theEnv)->MaximumCharacters + length + 1); strncpy(CommandLineData(theEnv)->CommandString,str,length); CommandLineData(theEnv)->CommandString[CommandLineData(theEnv)->MaximumCharacters + length] = 0; CommandLineData(theEnv)->MaximumCharacters += (length + 1); RouterData(theEnv)->CommandBufferInputCount += (int) length; } /******************************************************************************/ /* AppendCommandString: Appends a value to the contents of the CommandString. */ /******************************************************************************/ globle void AppendCommandString( void *theEnv, char *str) { CommandLineData(theEnv)->CommandString = AppendToString(theEnv,str,CommandLineData(theEnv)->CommandString,&RouterData(theEnv)->CommandBufferInputCount,&CommandLineData(theEnv)->MaximumCharacters); } /************************************************************/ /* AppendNCommandString: Appends a value up to N characters */ /* to the contents of the CommandString. */ /************************************************************/ globle void AppendNCommandString( void *theEnv, char *str, unsigned length) { CommandLineData(theEnv)->CommandString = AppendNToString(theEnv,str,CommandLineData(theEnv)->CommandString,length,&RouterData(theEnv)->CommandBufferInputCount,&CommandLineData(theEnv)->MaximumCharacters); } /*****************************************************************************/ /* GetCommandString: Returns a pointer to the contents of the CommandString. */ /*****************************************************************************/ globle char *GetCommandString( void *theEnv) { return(CommandLineData(theEnv)->CommandString); } /**************************************************************************/ /* CompleteCommand: Determines whether a string forms a complete command. */ /* A complete command is either a constant, a variable, or a function */ /* call which is followed (at some point) by a carriage return. Once a */ /* complete command is found (not including the parenthesis), */ /* extraneous parenthesis and other tokens are ignored. If a complete */ /* command exists, then 1 is returned. 0 is returned if the command was */ /* not complete and without errors. -1 is returned if the command */ /* contains an error. */ /**************************************************************************/ globle int CompleteCommand( char *mstring) { int i; char inchar; int depth = 0; int moreThanZero = 0; int complete; int error = 0; if (mstring == NULL) return(0); /*===================================================*/ /* Loop through each character of the command string */ /* to determine if there is a complete command. */ /*===================================================*/ i = 0; while ((inchar = mstring[i++]) != EOS) { switch(inchar) { /*======================================================*/ /* If a carriage return or line feed is found, there is */ /* at least one completed token in the command buffer, */ /* and parentheses are balanced, then a complete */ /* command has been found. Otherwise, remove all white */ /* space beginning with the current character. */ /*======================================================*/ case '\n' : case '\r' : if (error) return(-1); if (moreThanZero && (depth == 0)) return(1); i = DoWhiteSpace(mstring,i); break; /*=====================*/ /* Remove white space. */ /*=====================*/ case ' ' : case '\f' : case '\t' : i = DoWhiteSpace(mstring,i); break; /*======================================================*/ /* If the opening quotation of a string is encountered, */ /* determine if the closing quotation of the string is */ /* in the command buffer. Until the closing quotation */ /* is found, a complete command can not be made. */ /*======================================================*/ case '"' : i = DoString(mstring,i,&complete); if ((depth == 0) && complete) moreThanZero = TRUE; break; /*====================*/ /* Process a comment. */ /*====================*/ case ';' : i = DoComment(mstring,i); if (moreThanZero && (depth == 0) && (mstring[i] != EOS)) { if (error) return(-1); else return(1); } else if (mstring[i] != EOS) i++; break; /*====================================================*/ /* A left parenthesis increases the nesting depth of */ /* the current command by 1. Don't bother to increase */ /* the depth if the first token encountered was not */ /* a parenthesis (e.g. for the command string */ /* "red (+ 3 4", the symbol red already forms a */ /* complete command, so the next carriage return will */ /* cause evaluation of red--the closing parenthesis */ /* for "(+ 3 4" does not have to be found). */ /*====================================================*/ case '(' : if ((depth > 0) || (moreThanZero == FALSE)) { depth++; moreThanZero = TRUE; } break; /*====================================================*/ /* A right parenthesis decreases the nesting depth of */ /* the current command by 1. If the parenthesis is */ /* the first token of the command, then an error is */ /* generated. */ /*====================================================*/ case ')' : if (depth > 0) depth--; else if (moreThanZero == FALSE) error = TRUE; break; /*=====================================================*/ /* If the command begins with any other character and */ /* an opening parenthesis hasn't yet been found, then */ /* skip all characters on the same line. If a carriage */ /* return or line feed is found, then a complete */ /* command exists. */ /*=====================================================*/ default: if (depth == 0) { if (isprint(inchar)) { while ((inchar = mstring[i++]) != EOS) { if ((inchar == '\n') || (inchar == '\r')) { if (error) return(-1); else return(1); } } return(0); } } break; } } /*====================================================*/ /* Return 0 because a complete command was not found. */ /*====================================================*/ return(0); } /***********************************************************/ /* DoString: Skips over a string contained within a string */ /* until the closing quotation mark is encountered. */ /***********************************************************/ static int DoString( char *str, int pos, int *complete) { int inchar; /*=================================================*/ /* Process the string character by character until */ /* the closing quotation mark is found. */ /*=================================================*/ inchar = str[pos]; while (inchar != '"') { /*=====================================================*/ /* If a \ is found, then the next character is ignored */ /* even if it is a closing quotation mark. */ /*=====================================================*/ if (inchar == '\\') { pos++; inchar = str[pos]; } /*===================================================*/ /* If the end of input is reached before the closing */ /* quotation mark is found, the return the last */ /* position that was reached and indicate that a */ /* complete string was not found. */ /*===================================================*/ if (inchar == EOS) { *complete = FALSE; return(pos); } /*================================*/ /* Move on to the next character. */ /*================================*/ pos++; inchar = str[pos]; } /*======================================================*/ /* Indicate that a complete string was found and return */ /* the position of the closing quotation mark. */ /*======================================================*/ pos++; *complete = TRUE; return(pos); } /*************************************************************/ /* DoComment: Skips over a comment contained within a string */ /* until a line feed or carriage return is encountered. */ /*************************************************************/ static int DoComment( char *str, int pos) { int inchar; inchar = str[pos]; while ((inchar != '\n') && (inchar != '\r')) { if (inchar == EOS) { return(pos); } pos++; inchar = str[pos]; } return(pos); } /**************************************************************/ /* DoWhiteSpace: Skips over white space consisting of spaces, */ /* tabs, and form feeds that is contained within a string. */ /**************************************************************/ static int DoWhiteSpace( char *str, int pos) { int inchar; inchar = str[pos]; while ((inchar == ' ') || (inchar == '\f') || (inchar == '\t')) { pos++; inchar = str[pos]; } return(pos); } /********************************************************************/ /* CommandLoop: Endless loop which waits for user commands and then */ /* executes them. The command loop will bypass the EventFunction */ /* if there is an active batch file. */ /********************************************************************/ globle void CommandLoop( void *theEnv) { int inchar; EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString); SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); PeriodicCleanup(theEnv,TRUE,FALSE); PrintPrompt(theEnv); RouterData(theEnv)->CommandBufferInputCount = 0; while (TRUE) { /*===================================================*/ /* If a batch file is active, grab the command input */ /* directly from the batch file, otherwise call the */ /* event function. */ /*===================================================*/ if (BatchActive(theEnv) == TRUE) { inchar = LLGetcBatch(theEnv,"stdin",TRUE); if (inchar == EOF) { (*CommandLineData(theEnv)->EventFunction)(theEnv); } else { ExpandCommandString(theEnv,(char) inchar); } } else { (*CommandLineData(theEnv)->EventFunction)(theEnv); } /*=================================================*/ /* If execution was halted, then remove everything */ /* from the command buffer. */ /*=================================================*/ if (GetHaltExecution(theEnv) == TRUE) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); #if ! WINDOW_INTERFACE fflush(stdin); #endif EnvPrintRouter(theEnv,WPROMPT,"\n"); PrintPrompt(theEnv); } /*=========================================*/ /* If a complete command is in the command */ /* buffer, then execute it. */ /*=========================================*/ ExecuteIfCommandComplete(theEnv); } } /***********************************************************/ /* CommandLoopBatch: Loop which waits for commands from a */ /* batch file and then executes them. Returns when there */ /* are no longer any active batch files. */ /***********************************************************/ globle void CommandLoopBatch( void *theEnv) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); PeriodicCleanup(theEnv,TRUE,FALSE); PrintPrompt(theEnv); RouterData(theEnv)->CommandBufferInputCount = 0; CommandLoopBatchDriver(theEnv); } /************************************************************/ /* CommandLoopOnceThenBatch: Loop which waits for commands */ /* from a batch file and then executes them. Returns when */ /* there are no longer any active batch files. */ /************************************************************/ globle void CommandLoopOnceThenBatch( void *theEnv) { if (! ExecuteIfCommandComplete(theEnv)) return; CommandLoopBatchDriver(theEnv); } /*********************************************************/ /* CommandLoopBatchDriver: Loop which waits for commands */ /* from a batch file and then executes them. Returns */ /* when there are no longer any active batch files. */ /*********************************************************/ globle void CommandLoopBatchDriver( void *theEnv) { int inchar; while (TRUE) { if (GetHaltCommandLoopBatch(theEnv) == TRUE) { CloseAllBatchSources(theEnv); SetHaltCommandLoopBatch(theEnv,FALSE); } /*===================================================*/ /* If a batch file is active, grab the command input */ /* directly from the batch file, otherwise call the */ /* event function. */ /*===================================================*/ if (BatchActive(theEnv) == TRUE) { inchar = LLGetcBatch(theEnv,"stdin",TRUE); if (inchar == EOF) { return; } else { ExpandCommandString(theEnv,(char) inchar); } } else { return; } /*=================================================*/ /* If execution was halted, then remove everything */ /* from the command buffer. */ /*=================================================*/ if (GetHaltExecution(theEnv) == TRUE) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); #if ! WINDOW_INTERFACE fflush(stdin); #endif EnvPrintRouter(theEnv,WPROMPT,"\n"); PrintPrompt(theEnv); } /*=========================================*/ /* If a complete command is in the command */ /* buffer, then execute it. */ /*=========================================*/ ExecuteIfCommandComplete(theEnv); } } /**********************************************************/ /* ExecuteIfCommandComplete: Checks to determine if there */ /* is a completed command and if so executes it. */ /**********************************************************/ globle intBool ExecuteIfCommandComplete( void *theEnv) { if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) || (RouterData(theEnv)->CommandBufferInputCount <= 0)) { return FALSE; } FlushPPBuffer(theEnv); SetPPBufferStatus(theEnv,OFF); RouterData(theEnv)->CommandBufferInputCount = -1; RouteCommand(theEnv,CommandLineData(theEnv)->CommandString,TRUE); FlushPPBuffer(theEnv); SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); FlushBindList(theEnv); PeriodicCleanup(theEnv,TRUE,FALSE); PrintPrompt(theEnv); return TRUE; } /*******************************************/ /* CommandCompleteAndNotEmpty: */ /*******************************************/ globle intBool CommandCompleteAndNotEmpty( void *theEnv) { if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) || (RouterData(theEnv)->CommandBufferInputCount <= 0)) { return FALSE; } return TRUE; } /*******************************************/ /* PrintPrompt: Prints the command prompt. */ /*******************************************/ globle void PrintPrompt( void *theEnv) { EnvPrintRouter(theEnv,WPROMPT,COMMAND_PROMPT); if (CommandLineData(theEnv)->AfterPromptFunction != NULL) { (*CommandLineData(theEnv)->AfterPromptFunction)(theEnv); } } /*****************************************/ /* PrintBanner: Prints the CLIPS banner. */ /*****************************************/ globle void PrintBanner( void *theEnv) { EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString); } /************************************************/ /* SetAfterPromptFunction: Replaces the current */ /* value of AfterPromptFunction. */ /************************************************/ globle void SetAfterPromptFunction( void *theEnv, int (*funptr)(void *)) { CommandLineData(theEnv)->AfterPromptFunction = funptr; } /************************************************/ /* RouteCommand: Processes a completed command. */ /************************************************/ globle intBool RouteCommand( void *theEnv, char *command, int printResult) { DATA_OBJECT result; struct expr *top; char *commandName; struct token theToken; if (command == NULL) { return(0); } /*========================================*/ /* Open a string input source and get the */ /* first token from that source. */ /*========================================*/ OpenStringSource(theEnv,"command",command,0); GetToken(theEnv,"command",&theToken); /*=====================*/ /* Evaluate constants. */ /*=====================*/ if ((theToken.type == SYMBOL) || (theToken.type == STRING) || (theToken.type == FLOAT) || (theToken.type == INTEGER) || (theToken.type == INSTANCE_NAME)) { CloseStringSource(theEnv,"command"); if (printResult) { PrintAtom(theEnv,"stdout",theToken.type,theToken.value); EnvPrintRouter(theEnv,"stdout","\n"); } return(1); } /*============================*/ /* Evaluate global variables. */ /*============================*/ if (theToken.type == GBL_VARIABLE) { CloseStringSource(theEnv,"command"); top = GenConstant(theEnv,theToken.type,theToken.value); EvaluateExpression(theEnv,top,&result); rtn_struct(theEnv,expr,top); if (printResult) { PrintDataObject(theEnv,"stdout",&result); EnvPrintRouter(theEnv,"stdout","\n"); } return(1); } /*========================================================*/ /* If the next token isn't the beginning left parenthesis */ /* of a command or construct, then whatever was entered */ /* cannot be evaluated at the command prompt. */ /*========================================================*/ if (theToken.type != LPAREN) { PrintErrorID(theEnv,"COMMLINE",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a '(', constant, or global variable\n"); CloseStringSource(theEnv,"command"); return(0); } /*===========================================================*/ /* The next token must be a function name or construct type. */ /*===========================================================*/ GetToken(theEnv,"command",&theToken); if (theToken.type != SYMBOL) { PrintErrorID(theEnv,"COMMLINE",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a command.\n"); CloseStringSource(theEnv,"command"); return(0); } commandName = ValueToString(theToken.value); /*======================*/ /* Evaluate constructs. */ /*======================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) { int errorFlag; errorFlag = ParseConstruct(theEnv,commandName,"command"); if (errorFlag != -1) { CloseStringSource(theEnv,"command"); if (errorFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); } DestroyPPBuffer(theEnv); return(errorFlag); } } #endif /*========================*/ /* Parse a function call. */ /*========================*/ CommandLineData(theEnv)->ParsingTopLevelCommand = TRUE; top = Function2Parse(theEnv,"command",commandName); CommandLineData(theEnv)->ParsingTopLevelCommand = FALSE; ClearParsedBindNames(theEnv); /*================================*/ /* Close the string input source. */ /*================================*/ CloseStringSource(theEnv,"command"); /*=========================*/ /* Evaluate function call. */ /*=========================*/ if (top == NULL) return(0); CommandLineData(theEnv)->EvaluatingTopLevelCommand = TRUE; ExpressionInstall(theEnv,top); EvaluateExpression(theEnv,top,&result); ExpressionDeinstall(theEnv,top); CommandLineData(theEnv)->EvaluatingTopLevelCommand = FALSE; ReturnExpression(theEnv,top); if ((result.type != RVOID) && printResult) { PrintDataObject(theEnv,"stdout",&result); EnvPrintRouter(theEnv,"stdout","\n"); } return(1); } /*****************************************************************/ /* DefaultGetNextEvent: Default event-handling function. Handles */ /* only keyboard events by first calling GetcRouter to get a */ /* character and then calling ExpandCommandString to add the */ /* character to the CommandString. */ /*****************************************************************/ static int DefaultGetNextEvent( void *theEnv) { int inchar; inchar = EnvGetcRouter(theEnv,"stdin"); if (inchar == EOF) inchar = '\n'; ExpandCommandString(theEnv,(char) inchar); return 0; } /*************************************/ /* SetEventFunction: Replaces the */ /* current value of EventFunction. */ /*************************************/ globle int (*SetEventFunction(void *theEnv,int (*theFunction)(void *)))(void *) { int (*tmp_ptr)(void *); tmp_ptr = CommandLineData(theEnv)->EventFunction; CommandLineData(theEnv)->EventFunction = theFunction; return(tmp_ptr); } /****************************************/ /* TopLevelCommand: Indicates whether a */ /* top-level command is being parsed. */ /****************************************/ globle intBool TopLevelCommand( void *theEnv) { return(CommandLineData(theEnv)->ParsingTopLevelCommand); } /***********************************************************/ /* GetCommandCompletionString: Returns the last token in a */ /* string if it is a valid token for command completion. */ /***********************************************************/ globle char *GetCommandCompletionString( void *theEnv, char *theString, unsigned maxPosition) { struct token lastToken; struct token theToken; char lastChar; char *rs; unsigned length; /*=========================*/ /* Get the command string. */ /*=========================*/ if (theString == NULL) return(""); /*=========================================================================*/ /* If the last character in the command string is a space, character */ /* return, or quotation mark, then the command completion can be anything. */ /*=========================================================================*/ lastChar = theString[maxPosition - 1]; if ((lastChar == ' ') || (lastChar == '"') || (lastChar == '\t') || (lastChar == '\f') || (lastChar == '\n') || (lastChar == '\r')) { return(""); } /*============================================*/ /* Find the last token in the command string. */ /*============================================*/ OpenTextSource(theEnv,"CommandCompletion",theString,0,maxPosition); ScannerData(theEnv)->IgnoreCompletionErrors = TRUE; GetToken(theEnv,"CommandCompletion",&theToken); CopyToken(&lastToken,&theToken); while (theToken.type != STOP) { CopyToken(&lastToken,&theToken); GetToken(theEnv,"CommandCompletion",&theToken); } CloseStringSource(theEnv,"CommandCompletion"); ScannerData(theEnv)->IgnoreCompletionErrors = FALSE; /*===============================================*/ /* Determine if the last token can be completed. */ /*===============================================*/ if (lastToken.type == SYMBOL) { rs = ValueToString(lastToken.value); if (rs[0] == '[') return (&rs[1]); return(ValueToString(lastToken.value)); } else if (lastToken.type == SF_VARIABLE) { return(ValueToString(lastToken.value)); } else if (lastToken.type == MF_VARIABLE) { return(ValueToString(lastToken.value)); } else if ((lastToken.type == GBL_VARIABLE) || (lastToken.type == MF_GBL_VARIABLE) || (lastToken.type == INSTANCE_NAME)) { return(NULL); } else if (lastToken.type == STRING) { length = strlen(ValueToString(lastToken.value)); return(GetCommandCompletionString(theEnv,ValueToString(lastToken.value),length)); } else if ((lastToken.type == FLOAT) || (lastToken.type == INTEGER)) { return(NULL); } return(""); } /****************************************************************/ /* SetHaltCommandLoopBatch: Sets the HaltCommandLoopBatch flag. */ /****************************************************************/ globle void SetHaltCommandLoopBatch( void *theEnv, int value) { CommandLineData(theEnv)->HaltCommandLoopBatch = value; } /*******************************************************************/ /* GetHaltCommandLoopBatch: Returns the HaltCommandLoopBatch flag. */ /*******************************************************************/ globle int GetHaltCommandLoopBatch( void *theEnv) { return(CommandLineData(theEnv)->HaltCommandLoopBatch); } #endif clips-6.24/clipssrc/default.c0000755000175000017500000004004610441166550014330 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFAULT ATTRIBUTE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for parsing the default */ /* attribute and determining default values based on */ /* slot constraints. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Support for deftemplate-slot-default-value */ /* function. */ /* */ /*************************************************************/ #define _DEFAULT_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include "constant.h" #include "constrnt.h" #include "cstrnchk.h" #include "multifld.h" #include "inscom.h" #include "exprnpsr.h" #include "scanner.h" #include "router.h" #include "factmngr.h" #include "cstrnutl.h" #include "envrnmnt.h" #include "default.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *FindDefaultValue(void *,int,CONSTRAINT_RECORD *,void *); /********************************************************/ /* DeriveDefaultFromConstraints: Returns an appropriate */ /* default value for the supplied constraints. */ /********************************************************/ globle void DeriveDefaultFromConstraints( void *theEnv, CONSTRAINT_RECORD *constraints, DATA_OBJECT *theDefault, int multifield, int garbageMultifield) { unsigned short theType; unsigned long minFields; void *theValue; /*=============================================================*/ /* If no constraints are specified, then use the symbol nil as */ /* a default for single field slots and a multifield of length */ /* 0 as a default for multifield slots. */ /*=============================================================*/ if (constraints == NULL) { if (multifield) { SetpType(theDefault,MULTIFIELD); SetpDOBegin(theDefault,1); SetpDOEnd(theDefault,0); if (garbageMultifield) SetpValue(theDefault,(void *) EnvCreateMultifield(theEnv,0L)); else SetpValue(theDefault,(void *) CreateMultifield2(theEnv,0L)); } else { theDefault->type = SYMBOL; theDefault->value = EnvAddSymbol(theEnv,"nil"); } return; } /*=========================================*/ /* Determine the default's type and value. */ /*=========================================*/ if (constraints->anyAllowed || constraints->symbolsAllowed) { theType = SYMBOL; theValue = FindDefaultValue(theEnv,SYMBOL,constraints,EnvAddSymbol(theEnv,"nil")); } else if (constraints->stringsAllowed) { theType = STRING; theValue = FindDefaultValue(theEnv,STRING,constraints,EnvAddSymbol(theEnv,"")); } else if (constraints->integersAllowed) { theType = INTEGER; theValue = FindDefaultValue(theEnv,INTEGER,constraints,EnvAddLong(theEnv,0L)); } else if (constraints->floatsAllowed) { theType = FLOAT; theValue = FindDefaultValue(theEnv,FLOAT,constraints,EnvAddDouble(theEnv,0.0)); } #if OBJECT_SYSTEM else if (constraints->instanceNamesAllowed) { theType = INSTANCE_NAME; theValue = FindDefaultValue(theEnv,INSTANCE_NAME,constraints,EnvAddSymbol(theEnv,"nil")); } else if (constraints->instanceAddressesAllowed) { theType = INSTANCE_ADDRESS; theValue = (void *) &InstanceData(theEnv)->DummyInstance; } #endif #if DEFTEMPLATE_CONSTRUCT else if (constraints->factAddressesAllowed) { theType = FACT_ADDRESS; theValue = (void *) &FactData(theEnv)->DummyFact; } #endif else if (constraints->externalAddressesAllowed) { theType = EXTERNAL_ADDRESS; theValue = NULL; } else { theType = SYMBOL; theValue = EnvAddSymbol(theEnv,"nil"); } /*=========================================================*/ /* If the default is for a multifield slot, then create a */ /* multifield default value that satisfies the cardinality */ /* constraints for the slot. The default value for a */ /* multifield slot is a multifield of length 0. */ /*=========================================================*/ if (multifield) { if (constraints->minFields == NULL) minFields = 0; else if (constraints->minFields->value == SymbolData(theEnv)->NegativeInfinity) minFields = 0; else minFields = (unsigned long) ValueToLong(constraints->minFields->value); SetpType(theDefault,MULTIFIELD); SetpDOBegin(theDefault,1); SetpDOEnd(theDefault,(long) minFields); if (garbageMultifield) SetpValue(theDefault,(void *) EnvCreateMultifield(theEnv,minFields)); else SetpValue(theDefault,(void *) CreateMultifield2(theEnv,minFields)); for (; minFields > 0; minFields--) { SetMFType(GetpValue(theDefault),minFields,theType); SetMFValue(GetpValue(theDefault),minFields,theValue); } } else { theDefault->type = theType; theDefault->value = theValue; } } /***********************************************************************/ /* FindDefaultValue: Searches the list of restriction values for a */ /* constraint to find a default value of the specified type. For */ /* example, if the attribute (allowed-symbols on off) was specified, */ /* then the symbol "on" would be used as a default value rather than */ /* the symbol "nil". For integers and floats, the range attribute is */ /* also used to select a suitable default value. If a minimum value */ /* was specified, then this value is used first followed by the */ /* maximum value. */ /************************************************************************/ static void *FindDefaultValue( void *theEnv, int theType, CONSTRAINT_RECORD *theConstraints, void *standardDefault) { struct expr *theList; /*=====================================================*/ /* Look on the the allowed values list to see if there */ /* is a value of the requested type. Return the first */ /* value found of the requested type. */ /*=====================================================*/ theList = theConstraints->restrictionList; while (theList != NULL) { if (theList->type == theType) return(theList->value); theList = theList->nextArg; } /*=============================================================*/ /* If no specific values were available for the default value, */ /* and the type requested is a float or integer, then use the */ /* range attribute to select a default value. */ /*=============================================================*/ if (theType == INTEGER) { if (theConstraints->minValue->type == INTEGER) { return(theConstraints->minValue->value); } else if (theConstraints->minValue->type == FLOAT) { return(EnvAddLong(theEnv,(long) ValueToDouble(theConstraints->minValue->value))); } else if (theConstraints->maxValue->type == INTEGER) { return(theConstraints->maxValue->value); } else if (theConstraints->maxValue->type == FLOAT) { return(EnvAddLong(theEnv,(long) ValueToDouble(theConstraints->maxValue->value))); } } else if (theType == FLOAT) { if (theConstraints->minValue->type == FLOAT) { return(theConstraints->minValue->value); } else if (theConstraints->minValue->type == INTEGER) { return(EnvAddDouble(theEnv,(double) ValueToLong(theConstraints->minValue->value))); } else if (theConstraints->maxValue->type == FLOAT) { return(theConstraints->maxValue->value); } else if (theConstraints->maxValue->type == INTEGER) { return(EnvAddDouble(theEnv,(double) ValueToLong(theConstraints->maxValue->value))); } } /*======================================*/ /* Use the standard default value (such */ /* as nil if symbols are allowed). */ /*======================================*/ return(standardDefault); } #if (! RUN_TIME) && (! BLOAD_ONLY) /**********************************************/ /* ParseDefault: Parses a default value list. */ /**********************************************/ globle struct expr *ParseDefault( void *theEnv, char *readSource, int multifield, int dynamic, int evalStatic, int *noneSpecified, int *deriveSpecified, int *error) { struct expr *defaultList = NULL, *lastDefault = NULL; struct expr *newItem, *tmpItem; struct token theToken; DATA_OBJECT theValue; CONSTRAINT_RECORD *rv; int specialVarCode; *noneSpecified = FALSE; *deriveSpecified = FALSE; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); /*===================================================*/ /* Read the items contained in the default attribute */ /* until a closing right parenthesis is encountered. */ /*===================================================*/ while (theToken.type != RPAREN) { /*========================================*/ /* Get the next item in the default list. */ /*========================================*/ newItem = ParseAtomOrExpression(theEnv,readSource,&theToken); if (newItem == NULL) { ReturnExpression(theEnv,defaultList); *error = TRUE; return(NULL); } /*===========================================================*/ /* Check for invalid variable usage. With the expection of */ /* ?NONE for the default attribute, local variables may not */ /* be used within the default or default-dynamic attributes. */ /*===========================================================*/ if ((newItem->type == SF_VARIABLE) || (newItem->type == MF_VARIABLE)) { if (strcmp(ValueToString(newItem->value),"NONE") == 0) { specialVarCode = 0; } else if (strcmp(ValueToString(newItem->value),"DERIVE") == 0) { specialVarCode = 1; } else { specialVarCode = -1; } if ((dynamic) || (newItem->type == MF_VARIABLE) || (specialVarCode == -1) || ((specialVarCode != -1) && (defaultList != NULL))) { if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute"); else SyntaxErrorMessage(theEnv,"default attribute"); ReturnExpression(theEnv,newItem); ReturnExpression(theEnv,defaultList); *error = TRUE; return(NULL); } ReturnExpression(theEnv,newItem); /*============================================*/ /* Check for the closing right parenthesis of */ /* the default or default dynamic attribute. */ /*============================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != RPAREN) { if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute"); else SyntaxErrorMessage(theEnv,"default attribute"); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); *error = TRUE; } if (specialVarCode == 0) *noneSpecified = TRUE; else *deriveSpecified = TRUE; return(NULL); } /*====================================================*/ /* Look to see if any variables have been used within */ /* expressions contained within the default list. */ /*====================================================*/ if (ExpressionContainsVariables(newItem,FALSE) == TRUE) { ReturnExpression(theEnv,defaultList); ReturnExpression(theEnv,newItem); *error = TRUE; if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute"); else SyntaxErrorMessage(theEnv,"default attribute"); return(NULL); } /*============================================*/ /* Add the default value to the default list. */ /*============================================*/ if (lastDefault == NULL) { defaultList = newItem; } else { lastDefault->nextArg = newItem; } lastDefault = newItem; /*=======================================*/ /* Begin parsing the next default value. */ /*=======================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); } /*=====================================*/ /* Fix up pretty print representation. */ /*=====================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); /*=========================================*/ /* A single field slot's default attribute */ /* must contain a single value. */ /*=========================================*/ if (multifield == FALSE) { if (defaultList == NULL) { *error = TRUE; } else if (defaultList->nextArg != NULL) { *error = TRUE; } else { rv = ExpressionToConstraintRecord(theEnv,defaultList); rv->multifieldsAllowed = FALSE; if (UnmatchableConstraint(rv)) *error = TRUE; RemoveConstraint(theEnv,rv); } if (*error) { PrintErrorID(theEnv,"DEFAULT",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The default value for a single field slot must be a single field value\n"); ReturnExpression(theEnv,defaultList); return(NULL); } } /*=======================================================*/ /* If the dynamic-default attribute is not being parsed, */ /* evaluate the expressions to make the default value. */ /*=======================================================*/ if (dynamic || (! evalStatic) || (defaultList == NULL)) return(defaultList); tmpItem = defaultList; newItem = defaultList; defaultList = NULL; while (newItem != NULL) { SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,newItem,&theValue)) *error = TRUE; if ((theValue.type == MULTIFIELD) && (multifield == FALSE) && (*error == FALSE)) { PrintErrorID(theEnv,"DEFAULT",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The default value for a single field slot must be a single field value\n"); *error = TRUE; } if (*error) { ReturnExpression(theEnv,tmpItem); ReturnExpression(theEnv,defaultList); *error = TRUE; return(NULL); } lastDefault = ConvertValueToExpression(theEnv,&theValue); defaultList = AppendExpressions(defaultList,lastDefault); newItem = newItem->nextArg; } ReturnExpression(theEnv,tmpItem); /*==========================*/ /* Return the default list. */ /*==========================*/ return(defaultList); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ clips-6.24/clipssrc/._globlbin.c0000400000175000017500000000061407673515206014702 0ustar jfsjfsMac OS X  2 R:TEXT????2282K2MWBB clips-6.24/clipssrc/._ruledlt.h0000400000175000017500000000012207422634772014566 0ustar jfsjfsMac OS X  2 RTEXT???? clips-6.24/clipssrc/._genrcexe.c0000400000175000017500000000075410441071747014711 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0c0c!"))$TTFSfFMPSRMWBBLclips-6.24/clipssrc/._exprnops.h0000400000175000017500000000075410441132027014761 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zG,,TTFS FMWBBMPSRclips-6.24/clipssrc/moduldef.h0000755000175000017500000002545610441150024014505 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFMODULE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic defmodule primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* defmodule data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_moduldef #define _H_moduldef struct defmodule; struct portItem; struct defmoduleItemHeader; struct moduleItem; #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_modulpsr #include "modulpsr.h" #endif #ifndef _H_utility #include "utility.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif /**********************************************************************/ /* defmodule */ /* ---------- */ /* name: The name of the defmodule (stored as a reference in the */ /* table). */ /* */ /* ppForm: The pretty print representation of the defmodule (used by */ /* the save and ppdefmodule commands). */ /* */ /* itemsArray: An array of pointers to the module specific data used */ /* by each construct specified with the RegisterModuleItem */ /* function. The data pointer stored in the array is allocated by */ /* the allocateFunction in moduleItem data structure. */ /* */ /* importList: The list of items which are being imported by this */ /* module from other modules. */ /* */ /* next: A pointer to the next defmodule data structure. */ /**********************************************************************/ struct defmodule { struct symbolHashNode *name; char *ppForm; struct defmoduleItemHeader **itemsArray; struct portItem *importList; struct portItem *exportList; unsigned visitedFlag; long bsaveID; struct userData *usrData; struct defmodule *next; }; struct portItem { struct symbolHashNode *moduleName; struct symbolHashNode *constructType; struct symbolHashNode *constructName; struct portItem *next; }; struct defmoduleItemHeader { struct defmodule *theModule; struct constructHeader *firstItem; struct constructHeader *lastItem; }; #define MIHS (struct defmoduleItemHeader *) /**********************************************************************/ /* moduleItem */ /* ---------- */ /* name: The name of the construct which can be placed in a module. */ /* For example, "defrule". */ /* */ /* allocateFunction: Used to allocate a data structure containing all */ /* pertinent information related to a specific construct for a */ /* given module. For example, the deffacts construct stores a */ /* pointer to the first and last deffacts for each each module. */ /* */ /* freeFunction: Used to deallocate a data structure allocated by */ /* the allocateFunction. In addition, the freeFunction deletes */ /* all constructs of the specified type in the given module. */ /* */ /* bloadModuleReference: Used during a binary load to establish a */ /* link between the defmodule data structure and the data structure */ /* containing all pertinent module information for a specific */ /* construct. */ /* */ /* findFunction: Used to determine if a specified construct is in a */ /* specific module. The name is the specific construct is passed as */ /* a string and the function returns a pointer to the specified */ /* construct if it exists. */ /* */ /* exportable: If TRUE, then the specified construct type can be */ /* exported (and hence imported). If FALSE, it can't be exported. */ /* */ /* next: A pointer to the next moduleItem data structure. */ /**********************************************************************/ struct moduleItem { char *name; int moduleIndex; void *(*allocateFunction)(void *); void (*freeFunction)(void *,void *); void *(*bloadModuleReference)(void *,int); void (*constructsToCModuleReference)(void *,FILE *,int,int,int); void *(*findFunction)(void *,char *); struct moduleItem *next; }; typedef struct moduleStackItem { intBool changeFlag; struct defmodule *theModule; struct moduleStackItem *next; } MODULE_STACK_ITEM; #define DEFMODULE_DATA 4 struct defmoduleData { struct moduleItem *LastModuleItem; struct callFunctionItem *AfterModuleChangeFunctions; MODULE_STACK_ITEM *ModuleStack; intBool CallModuleChangeFunctions; struct defmodule *ListOfDefmodules; struct defmodule *CurrentModule; struct defmodule *LastDefmodule; int NumberOfModuleItems; struct moduleItem *ListOfModuleItems; long ModuleChangeIndex; int MainModuleRedefinable; #if (! RUN_TIME) && (! BLOAD_ONLY) struct portConstructItem *ListOfPortConstructItems; long NumberOfDefmodules; struct callFunctionItem *AfterModuleDefinedFunctions; #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefmoduleCodeItem; #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) long BNumberOfDefmodules; long NumberOfPortItems; struct portItem *PortItemArray; struct defmodule *DefmoduleArray; #endif }; #define DefmoduleData(theEnv) ((struct defmoduleData *) GetEnvironmentData(theEnv,DEFMODULE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define FindDefmodule(theEnv,a) EnvFindDefmodule(theEnv,a) #define GetCurrentModule(theEnv) EnvGetCurrentModule(theEnv) #define GetDefmoduleName(theEnv,a) EnvGetDefmoduleName(theEnv,a) #define GetDefmodulePPForm(theEnv,a) EnvGetDefmodulePPForm(theEnv,a) #define GetNextDefmodule(theEnv,a) EnvGetNextDefmodule(theEnv,a) #define SetCurrentModule(theEnv,a) EnvSetCurrentModule(theEnv,a) #else #define FindDefmodule(a) EnvFindDefmodule(GetCurrentEnvironment(),a) #define GetCurrentModule() EnvGetCurrentModule(GetCurrentEnvironment()) #define GetDefmoduleName(a) EnvGetDefmoduleName(GetCurrentEnvironment(),a) #define GetDefmodulePPForm(a) EnvGetDefmodulePPForm(GetCurrentEnvironment(),a) #define GetNextDefmodule(a) EnvGetNextDefmodule(GetCurrentEnvironment(),a) #define SetCurrentModule(a) EnvSetCurrentModule(GetCurrentEnvironment(),a) #endif LOCALE void InitializeDefmodules(void *); LOCALE void *EnvFindDefmodule(void *,char *); LOCALE char *EnvGetDefmoduleName(void *,void *); LOCALE char *EnvGetDefmodulePPForm(void *,void *); LOCALE void *EnvGetNextDefmodule(void *,void *); LOCALE void RemoveAllDefmodules(void *); LOCALE int AllocateModuleStorage(void); LOCALE int RegisterModuleItem(void *,char *, void *(*)(void *), void (*)(void *,void *), void *(*)(void *,int), void (*)(void *,FILE *,int,int,int), void *(*)(void *,char *)); LOCALE void *GetModuleItem(void *,struct defmodule *,int); LOCALE void SetModuleItem(void *,struct defmodule *,int,void *); LOCALE void *EnvGetCurrentModule(void *); LOCALE void *EnvSetCurrentModule(void *,void *); LOCALE void *GetCurrentModuleCommand(void *); LOCALE void *SetCurrentModuleCommand(void *); LOCALE int GetNumberOfModuleItems(void *); LOCALE void CreateMainModule(void *); LOCALE void SetListOfDefmodules(void *,void *); LOCALE struct moduleItem *GetListOfModuleItems(void *); LOCALE struct moduleItem *FindModuleItem(void *,char *); LOCALE void SaveCurrentModule(void *); LOCALE void RestoreCurrentModule(void *); LOCALE void AddAfterModuleChangeFunction(void *,char *,void (*)(void *),int); LOCALE void IllegalModuleSpecifierMessage(void *); LOCALE void AllocateDefmoduleGlobals(void *); #endif clips-6.24/clipssrc/modulbsc.h0000755000175000017500000000437307422634611014527 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFMODULE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deffacts */ /* construct such as clear, reset, save, undeffacts, */ /* ppdeffacts, list-deffacts, and get-deffacts-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_modulbsc #define _H_modulbsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetDefmoduleList(theEnv,a) EnvGetDefmoduleList(theEnv,a) #define ListDefmodules(theEnv,a) EnvListDefmodules(theEnv,a) #else #define GetDefmoduleList(a) EnvGetDefmoduleList(GetCurrentEnvironment(),a) #define ListDefmodules(a) EnvListDefmodules(GetCurrentEnvironment(),a) #endif LOCALE void DefmoduleBasicCommands(void *); LOCALE void EnvGetDefmoduleList(void *,DATA_OBJECT_PTR); LOCALE void PPDefmoduleCommand(void *); LOCALE int PPDefmodule(void *,char *,char *); LOCALE void ListDefmodulesCommand(void *); LOCALE void EnvListDefmodules(void *,char *); #endif clips-6.24/clipssrc/constrct.h0000755000175000017500000001642110441131344014541 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* CONSTRUCT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_constrct #define _H_constrct struct constructHeader; struct construct; #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #include "userdata.h" struct constructHeader { struct symbolHashNode *name; char *ppForm; struct defmoduleItemHeader *whichModule; long bsaveID; struct constructHeader *next; struct userData *usrData; }; #define CHS (struct constructHeader *) struct construct { char *constructName; char *pluralName; int (*parseFunction)(void *,char *); void *(*findFunction)(void *,char *); struct symbolHashNode *(*getConstructNameFunction)(struct constructHeader *); char *(*getPPFormFunction)(void *,struct constructHeader *); struct defmoduleItemHeader *(*getModuleItemFunction)(struct constructHeader *); void *(*getNextItemFunction)(void *,void *); void (*setNextItemFunction)(struct constructHeader *,struct constructHeader *); intBool (*isConstructDeletableFunction)(void *,void *); int (*deleteFunction)(void *,void *); void (*freeFunction)(void *,void *); struct construct *next; }; #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #define CONSTRUCT_DATA 42 struct constructData { int ClearReadyInProgress; int ClearInProgress; int ResetReadyInProgress; int ResetInProgress; #if (! RUN_TIME) && (! BLOAD_ONLY) struct callFunctionItem *ListOfSaveFunctions; intBool PrintWhileLoading; unsigned WatchCompilations; #endif struct construct *ListOfConstructs; struct callFunctionItem *ListOfResetFunctions; struct callFunctionItem *ListOfClearFunctions; struct callFunctionItem *ListOfClearReadyFunctions; int Executing; int (*BeforeResetFunction)(void *); int CheckSyntaxMode; }; #define ConstructData(theEnv) ((struct constructData *) GetEnvironmentData(theEnv,CONSTRUCT_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _CONSTRCT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define Clear(theEnv) EnvClear(theEnv) #define Reset(theEnv) EnvReset(theEnv) #define Save(theEnv,a) EnvSave(theEnv,a) #define RemoveClearFunction(theEnv,a) EnvRemoveClearFunction(theEnv,a) #define RemoveResetFunction(theEnv,a) EnvRemoveResetFunction(theEnv,a) #else #define Clear() EnvClear(GetCurrentEnvironment()) #define Reset() EnvReset(GetCurrentEnvironment()) #define Save(a) EnvSave(GetCurrentEnvironment(),a) #define RemoveClearFunction(a) EnvRemoveClearFunction(GetCurrentEnvironment(),a) #define RemoveResetFunction(a) EnvRemoveResetFunction(GetCurrentEnvironment(),a) #endif LOCALE void InitializeConstructData(void *); LOCALE int EnvSave(void *,char *); LOCALE intBool AddSaveFunction(void *,char *,void (*)(void *,void *,char *),int); LOCALE intBool RemoveSaveFunction(void *,char *); LOCALE void EnvReset(void *); LOCALE intBool EnvAddResetFunction(void *,char *,void (*)(void *),int); LOCALE intBool AddResetFunction(char *,void (*)(void),int); LOCALE intBool EnvRemoveResetFunction(void *,char *); LOCALE void EnvClear(void *); LOCALE intBool AddClearReadyFunction(void *,char *,int (*)(void *),int); LOCALE intBool RemoveClearReadyFunction(void *,char *); LOCALE intBool EnvAddClearFunction(void *,char *,void (*)(void *),int); LOCALE intBool AddClearFunction(char *,void (*)(void),int); LOCALE intBool EnvRemoveClearFunction(void *,char *); LOCALE struct construct *AddConstruct(void *,char *,char *, int (*)(void *,char *), void *(*)(void *,char *), SYMBOL_HN *(*)(struct constructHeader *), char *(*)(void *,struct constructHeader *), struct defmoduleItemHeader *(*)(struct constructHeader *), void *(*)(void *,void *), void (*)(struct constructHeader *,struct constructHeader *), intBool (*)(void *,void *), int (*)(void *,void *), void (*)(void *,void *)); LOCALE int RemoveConstruct(void *,char *); LOCALE void SetCompilationsWatch(void *,unsigned); LOCALE unsigned GetCompilationsWatch(void *); LOCALE void SetPrintWhileLoading(void *,intBool); LOCALE intBool GetPrintWhileLoading(void *); LOCALE int ExecutingConstruct(void *); LOCALE void SetExecutingConstruct(void *,int); LOCALE void InitializeConstructs(void *); LOCALE int (*SetBeforeResetFunction(void *,int (*)(void *)))(void *); LOCALE void OldGetConstructList(void *,DATA_OBJECT *, void *(*)(void *,void *), char *(*)(void *,void *)); LOCALE void ResetCommand(void *); LOCALE void ClearCommand(void *); LOCALE intBool ClearReady(void *); LOCALE struct construct *FindConstruct(void *,char *); LOCALE void DeinstallConstructHeader(void *,struct constructHeader *); LOCALE void DestroyConstructHeader(void *,struct constructHeader *); #endif clips-6.24/clipssrc/._tmpltcmp.h0000400000175000017500000000012207422634772014753 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/dffctdef.c0000755000175000017500000002255110441602126014444 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* DEFFACTS DEFINITION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic deffacts primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* deffacts data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /*************************************************************/ #define _DFFCTDEF_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "dffctpsr.h" #include "dffctbsc.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "dffctbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "dffctcmp.h" #endif #include "dffctdef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *AllocateModule(void *); static void ReturnModule(void *,void *); static void ReturnDeffacts(void *,void *); static void InitializeDeffactsModules(void *); static void DeallocateDeffactsData(void *); #if ! RUN_TIME static void DestroyDeffactsAction(void *,struct constructHeader *,void *); #endif /***********************************************************/ /* InitializeDeffacts: Initializes the deffacts construct. */ /***********************************************************/ globle void InitializeDeffacts( void *theEnv) { AllocateEnvironmentData(theEnv,DEFFACTS_DATA,sizeof(struct deffactsData),DeallocateDeffactsData); InitializeDeffactsModules(theEnv); DeffactsBasicCommands(theEnv); DeffactsData(theEnv)->DeffactsConstruct = AddConstruct(theEnv,"deffacts","deffacts",ParseDeffacts,EnvFindDeffacts, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDeffacts,SetNextConstruct, EnvIsDeffactsDeletable,EnvUndeffacts,ReturnDeffacts); } /***************************************************/ /* DeallocateDeffactsData: Deallocates environment */ /* data for the deffacts construct. */ /***************************************************/ static void DeallocateDeffactsData( void *theEnv) { #if ! RUN_TIME struct deffactsModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDeffactsAction,DeffactsData(theEnv)->DeffactsModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct deffactsModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DeffactsData(theEnv)->DeffactsModuleIndex); rtn_struct(theEnv,deffactsModule,theModuleItem); } #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } #if ! RUN_TIME /*********************************************************/ /* DestroyDeffactsAction: Action used to remove deffacts */ /* as a result of DestroyEnvironment. */ /*********************************************************/ #if IBM_TBC #pragma argsused #endif static void DestroyDeffactsAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct deffacts *theDeffacts = (struct deffacts *) theConstruct; if (theDeffacts == NULL) return; ReturnPackedExpression(theEnv,theDeffacts->assertList); DestroyConstructHeader(theEnv,&theDeffacts->header); rtn_struct(theEnv,deffacts,theDeffacts); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv,theConstruct) #endif #endif } #endif /*******************************************************/ /* InitializeDeffactsModules: Initializes the deffacts */ /* construct for use with the defmodule construct. */ /*******************************************************/ static void InitializeDeffactsModules( void *theEnv) { DeffactsData(theEnv)->DeffactsModuleIndex = RegisterModuleItem(theEnv,"deffacts", AllocateModule, ReturnModule, #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDeffactsModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DeffactsCModuleReference, #else NULL, #endif EnvFindDeffacts); } /************************************************/ /* AllocateModule: Allocates a deffacts module. */ /************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,deffactsModule)); } /************************************************/ /* ReturnModule: Deallocates a deffacts module. */ /************************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DeffactsData(theEnv)->DeffactsConstruct); rtn_struct(theEnv,deffactsModule,theItem); } /*************************************************************/ /* GetDeffactsModuleItem: Returns a pointer to the defmodule */ /* item for the specified deffacts or defmodule. */ /*************************************************************/ globle struct deffactsModule *GetDeffactsModuleItem( void *theEnv, struct defmodule *theModule) { return((struct deffactsModule *) GetConstructModuleItemByIndex(theEnv,theModule,DeffactsData(theEnv)->DeffactsModuleIndex)); } /**************************************************/ /* EnvFindDeffacts: Searches for a deffact in the */ /* list of deffacts. Returns a pointer to the */ /* deffact if found, otherwise NULL. */ /**************************************************/ globle void *EnvFindDeffacts( void *theEnv, char *deffactsName) { return(FindNamedConstruct(theEnv,deffactsName,DeffactsData(theEnv)->DeffactsConstruct)); } /*********************************************************/ /* EnvGetNextDeffacts: If passed a NULL pointer, returns */ /* the first deffacts in the ListOfDeffacts. Otherwise */ /* returns the next deffacts following the deffacts */ /* passed as an argument. */ /*********************************************************/ globle void *EnvGetNextDeffacts( void *theEnv, void *deffactsPtr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) deffactsPtr,DeffactsData(theEnv)->DeffactsModuleIndex)); } /********************************************************/ /* EnvIsDeffactsDeletable: Returns TRUE if a particular */ /* deffacts can be deleted, otherwise returns FALSE. */ /********************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool EnvIsDeffactsDeletable( void *theEnv, void *ptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(ptr) #endif if (! ConstructsDeletable(theEnv)) { return FALSE; } if (ConstructData(theEnv)->ResetInProgress) return(FALSE); return(TRUE); } /***********************************************************/ /* ReturnDeffacts: Returns the data structures associated */ /* with a deffacts construct to the pool of free memory. */ /***********************************************************/ static void ReturnDeffacts( void *theEnv, void *vTheDeffacts) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vTheDeffacts) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct deffacts *theDeffacts = (struct deffacts *) vTheDeffacts; if (theDeffacts == NULL) return; ExpressionDeinstall(theEnv,theDeffacts->assertList); ReturnPackedExpression(theEnv,theDeffacts->assertList); DeinstallConstructHeader(theEnv,&theDeffacts->header); rtn_struct(theEnv,deffacts,theDeffacts); #endif } #endif /* DEFFACTS_CONSTRUCT */ clips-6.24/clipssrc/factcom.c0000755000175000017500000012410210441164424014312 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FACT COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the facts, assert, retract, save-facts, */ /* load-facts, set-fact-duplication, get-fact-duplication, */ /* assert-string, and fact-index commands and functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #define _FACTCOM_SOURCE_ #include "memalloc.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "factmngr.h" #include "argacces.h" #include "match.h" #include "router.h" #include "scanner.h" #include "constant.h" #include "factrhs.h" #include "factmch.h" #include "extnfunc.h" #include "tmpltpsr.h" #include "tmpltutl.h" #include "facthsh.h" #include "modulutl.h" #include "strngrtr.h" #include "tmpltdef.h" #include "tmpltfun.h" #include "sysdep.h" #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY #include "bload.h" #endif #include "factcom.h" #define INVALID -2L #define UNSPECIFIED -1L /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) static struct expr *AssertParse(void *,struct expr *,char *); #endif #if DEBUGGING_FUNCTIONS static long int GetFactsArgument(void *,int,int); #endif static struct expr *StandardLoadFact(void *,char *,struct token *); static DATA_OBJECT_PTR GetSaveFactsDeftemplateNames(void *,struct expr *,int,int *,int *); /***************************************/ /* FactCommandDefinitions: Initializes */ /* fact commands and functions. */ /***************************************/ globle void FactCommandDefinitions( void *theEnv) { #if ! RUN_TIME #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"facts", 'v', PTIEF FactsCommand, "FactsCommand", "*4iu"); #endif EnvDefineFunction(theEnv,"assert", 'u', PTIEF AssertCommand, "AssertCommand"); EnvDefineFunction2(theEnv,"retract", 'v', PTIEF RetractCommand, "RetractCommand","1*z"); EnvDefineFunction2(theEnv,"assert-string", 'u', PTIEF AssertStringFunction, "AssertStringFunction", "11s"); EnvDefineFunction2(theEnv,"str-assert", 'u', PTIEF AssertStringFunction, "AssertStringFunction", "11s"); EnvDefineFunction2(theEnv,"get-fact-duplication",'b', GetFactDuplicationCommand,"GetFactDuplicationCommand", "00"); EnvDefineFunction2(theEnv,"set-fact-duplication",'b', SetFactDuplicationCommand,"SetFactDuplicationCommand", "11"); EnvDefineFunction2(theEnv,"save-facts", 'b', PTIEF SaveFactsCommand, "SaveFactsCommand", "1*wk"); EnvDefineFunction2(theEnv,"load-facts", 'b', PTIEF LoadFactsCommand, "LoadFactsCommand", "11k"); EnvDefineFunction2(theEnv,"fact-index", 'l', PTIEF FactIndexFunction,"FactIndexFunction", "11y"); AddFunctionParser(theEnv,"assert",AssertParse); FuncSeqOvlFlags(theEnv,"assert",FALSE,FALSE); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /***************************************/ /* AssertCommand: H/L access routine */ /* for the assert function. */ /***************************************/ globle void AssertCommand( void *theEnv, DATA_OBJECT_PTR rv) { struct deftemplate *theDeftemplate; struct field *theField; DATA_OBJECT theValue; struct expr *theExpression; struct templateSlot *slotPtr; struct fact *newFact; int error = FALSE; int i; struct fact *theFact; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(rv,SYMBOL); SetpValue(rv,EnvFalseSymbol(theEnv)); /*================================*/ /* Get the deftemplate associated */ /* with the fact being asserted. */ /*================================*/ theExpression = GetFirstArgument(); theDeftemplate = (struct deftemplate *) theExpression->value; /*=======================================*/ /* Create the fact and store the name of */ /* the deftemplate as the 1st field. */ /*=======================================*/ if (theDeftemplate->implied == FALSE) { newFact = CreateFactBySize(theEnv,theDeftemplate->numberOfSlots); slotPtr = theDeftemplate->slotList; } else { newFact = CreateFactBySize(theEnv,1); if (theExpression->nextArg == NULL) { newFact->theProposition.theFields[0].type = MULTIFIELD; newFact->theProposition.theFields[0].value = CreateMultifield2(theEnv,0L); } slotPtr = NULL; } newFact->whichDeftemplate = theDeftemplate; /*===================================================*/ /* Evaluate the expression associated with each slot */ /* and store the result in the appropriate slot of */ /* the newly created fact. */ /*===================================================*/ theField = newFact->theProposition.theFields; for (theExpression = theExpression->nextArg, i = 0; theExpression != NULL; theExpression = theExpression->nextArg, i++) { /*===================================================*/ /* Evaluate the expression to be stored in the slot. */ /*===================================================*/ EvaluateExpression(theEnv,theExpression,&theValue); /*============================================================*/ /* A multifield value can't be stored in a single field slot. */ /*============================================================*/ if ((slotPtr != NULL) ? (slotPtr->multislot == FALSE) && (theValue.type == MULTIFIELD) : FALSE) { MultiIntoSingleFieldSlotError(theEnv,slotPtr,theDeftemplate); theValue.type = SYMBOL; theValue.value = EnvFalseSymbol(theEnv); error = TRUE; } /*==============================*/ /* Store the value in the slot. */ /*==============================*/ theField[i].type = theValue.type; theField[i].value = theValue.value; /*========================================*/ /* Get the information for the next slot. */ /*========================================*/ if (slotPtr != NULL) slotPtr = slotPtr->next; } /*============================================*/ /* If an error occured while generating the */ /* fact's slot values, then abort the assert. */ /*============================================*/ if (error) { ReturnFact(theEnv,newFact); return; } /*================================*/ /* Add the fact to the fact-list. */ /*================================*/ theFact = (struct fact *) EnvAssert(theEnv,(void *) newFact); /*========================================*/ /* The asserted fact is the return value. */ /*========================================*/ if (theFact != NULL) { SetpType(rv,FACT_ADDRESS); SetpValue(rv,(void *) theFact); } return; } /****************************************/ /* RetractCommand: H/L access routine */ /* for the retract command. */ /****************************************/ globle void RetractCommand( void *theEnv) { long int factIndex; struct fact *ptr; struct expr *theArgument; DATA_OBJECT theResult; int argNumber; /*================================*/ /* Iterate through each argument. */ /*================================*/ for (theArgument = GetFirstArgument(), argNumber = 1; theArgument != NULL; theArgument = GetNextArgument(theArgument), argNumber++) { /*========================*/ /* Evaluate the argument. */ /*========================*/ EvaluateExpression(theEnv,theArgument,&theResult); /*===============================================*/ /* If the argument evaluates to an integer, then */ /* it's assumed to be the fact index of the fact */ /* to be retracted. */ /*===============================================*/ if (theResult.type == INTEGER) { /*==========================================*/ /* A fact index must be a positive integer. */ /*==========================================*/ factIndex = ValueToLong(theResult.value); if (factIndex < 0) { ExpectedTypeError1(theEnv,"retract",argNumber,"fact-address, fact-index, or the symbol *"); return; } /*================================================*/ /* See if a fact with the specified index exists. */ /*================================================*/ ptr = FindIndexedFact(theEnv,factIndex); /*=====================================*/ /* If the fact exists then retract it, */ /* otherwise print an error message. */ /*=====================================*/ if (ptr != NULL) { EnvRetract(theEnv,(void *) ptr); } else { char tempBuffer[20]; sprintf(tempBuffer,"f-%ld",factIndex); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); } } /*===============================================*/ /* Otherwise if the argument evaluates to a fact */ /* address, we can directly retract it. */ /*===============================================*/ else if (theResult.type == FACT_ADDRESS) { EnvRetract(theEnv,theResult.value); } /*============================================*/ /* Otherwise if the argument evaluates to the */ /* symbol *, then all facts are retracted. */ /*============================================*/ else if ((theResult.type == SYMBOL) ? (strcmp(ValueToString(theResult.value),"*") == 0) : FALSE) { RemoveAllFacts(theEnv); return; } /*============================================*/ /* Otherwise the argument has evaluated to an */ /* illegal value for the retract command. */ /*============================================*/ else { ExpectedTypeError1(theEnv,"retract",argNumber,"fact-address, fact-index, or the symbol *"); SetEvaluationError(theEnv,TRUE); } } } /***************************************************/ /* SetFactDuplicationCommand: H/L access routine */ /* for the set-fact-duplication command. */ /***************************************************/ globle int SetFactDuplicationCommand( void *theEnv) { int oldValue; DATA_OBJECT theValue; /*=====================================================*/ /* Get the old value of the fact duplication behavior. */ /*=====================================================*/ oldValue = EnvGetFactDuplication(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-fact-duplication",EXACTLY,1) == -1) { return(oldValue); } /*========================*/ /* Evaluate the argument. */ /*========================*/ EnvRtnUnknown(theEnv,1,&theValue); /*===============================================================*/ /* If the argument evaluated to FALSE, then the fact duplication */ /* behavior is disabled, otherwise it is enabled. */ /*===============================================================*/ if ((theValue.value == EnvFalseSymbol(theEnv)) && (theValue.type == SYMBOL)) { EnvSetFactDuplication(theEnv,FALSE); } else { EnvSetFactDuplication(theEnv,TRUE); } /*========================================================*/ /* Return the old value of the fact duplication behavior. */ /*========================================================*/ return(oldValue); } /***************************************************/ /* GetFactDuplicationCommand: H/L access routine */ /* for the get-fact-duplication command. */ /***************************************************/ globle int GetFactDuplicationCommand( void *theEnv) { int currentValue; /*=========================================================*/ /* Get the current value of the fact duplication behavior. */ /*=========================================================*/ currentValue = EnvGetFactDuplication(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"get-fact-duplication",EXACTLY,0) == -1) { return(currentValue); } /*============================================================*/ /* Return the current value of the fact duplication behavior. */ /*============================================================*/ return(currentValue); } /*******************************************/ /* FactIndexFunction: H/L access routine */ /* for the fact-index function. */ /*******************************************/ globle long int FactIndexFunction( void *theEnv) { DATA_OBJECT item; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"fact-index",EXACTLY,1) == -1) return(-1L); /*========================*/ /* Evaluate the argument. */ /*========================*/ EnvRtnUnknown(theEnv,1,&item); /*======================================*/ /* The argument must be a fact address. */ /*======================================*/ if (GetType(item) != FACT_ADDRESS) { ExpectedTypeError1(theEnv,"fact-index",1,"fact-address"); return(-1L); } /*================================================*/ /* Return the fact index associated with the fact */ /* address. If the fact has been retracted, then */ /* return -1 for the fact index. */ /*================================================*/ if (((struct fact *) GetValue(item))->garbage) return(-1L); return (EnvFactIndex(theEnv,GetValue(item))); } #if DEBUGGING_FUNCTIONS /**************************************/ /* FactsCommand: H/L access routine */ /* for the facts command. */ /**************************************/ globle void FactsCommand( void *theEnv) { int argumentCount; long int start = UNSPECIFIED, end = UNSPECIFIED, max = UNSPECIFIED; struct defmodule *theModule; DATA_OBJECT theValue; int argOffset; /*=========================================================*/ /* Determine the number of arguments to the facts command. */ /*=========================================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,"facts",NO_MORE_THAN,4)) == -1) return; /*==================================*/ /* The default module for the facts */ /* command is the current module. */ /*==================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /*==========================================*/ /* If no arguments were specified, then use */ /* the default values to list the facts. */ /*==========================================*/ if (argumentCount == 0) { EnvFacts(theEnv,WDISPLAY,theModule,(long) start,(long) end,(long) max); return; } /*========================================================*/ /* Since there are one or more arguments, see if a module */ /* or start index was specified as the first argument. */ /*========================================================*/ EnvRtnUnknown(theEnv,1,&theValue); /*===============================================*/ /* If the first argument is a symbol, then check */ /* to see that a valid module was specified. */ /*===============================================*/ if (theValue.type == SYMBOL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theValue.value)); if ((theModule == NULL) && (strcmp(ValueToString(theValue.value),"*") != 0)) { SetEvaluationError(theEnv,TRUE); CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theValue.value)); return; } if ((start = GetFactsArgument(theEnv,2,argumentCount)) == INVALID) return; argOffset = 1; } /*================================================*/ /* Otherwise if the first argument is an integer, */ /* check to see that a valid index was specified. */ /*================================================*/ else if (theValue.type == INTEGER) { start = DOToLong(theValue); if (start < 0) { ExpectedTypeError1(theEnv,"facts",1,"symbol or positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } argOffset = 0; } /*==========================================*/ /* Otherwise the first argument is invalid. */ /*==========================================*/ else { ExpectedTypeError1(theEnv,"facts",1,"symbol or positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } /*==========================*/ /* Get the other arguments. */ /*==========================*/ if ((end = GetFactsArgument(theEnv,2 + argOffset,argumentCount)) == INVALID) return; if ((max = GetFactsArgument(theEnv,3 + argOffset,argumentCount)) == INVALID) return; /*=================*/ /* List the facts. */ /*=================*/ EnvFacts(theEnv,WDISPLAY,theModule,(long) start,(long) end,(long) max); } /*****************************************************/ /* EnvFacts: C access routine for the facts command. */ /*****************************************************/ globle void EnvFacts( void *theEnv, char *logicalName, void *vTheModule, long start, long end, long max) { struct fact *factPtr; long count = 0; struct defmodule *oldModule, *theModule = (struct defmodule *) vTheModule; int allModules = FALSE; /*==========================*/ /* Save the current module. */ /*==========================*/ oldModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /*=========================================================*/ /* Determine if facts from all modules are to be displayed */ /* or just facts from the current module. */ /*=========================================================*/ if (theModule == NULL) allModules = TRUE; else EnvSetCurrentModule(theEnv,(void *) theModule); /*=====================================*/ /* Get the first fact to be displayed. */ /*=====================================*/ if (allModules) factPtr = (struct fact *) EnvGetNextFact(theEnv,NULL); else factPtr = (struct fact *) GetNextFactInScope(theEnv,NULL); /*===============================*/ /* Display facts until there are */ /* no more facts to display. */ /*===============================*/ while (factPtr != NULL) { /*==================================================*/ /* Abort the display of facts if the Halt Execution */ /* flag has been set (normally by user action). */ /*==================================================*/ if (GetHaltExecution(theEnv) == TRUE) { EnvSetCurrentModule(theEnv,(void *) oldModule); return; } /*===============================================*/ /* If the maximum fact index of facts to display */ /* has been reached, then stop displaying facts. */ /*===============================================*/ if ((factPtr->factIndex > end) && (end != UNSPECIFIED)) { PrintTally(theEnv,logicalName,count,"fact","facts"); EnvSetCurrentModule(theEnv,(void *) oldModule); return; } /*================================================*/ /* If the maximum number of facts to be displayed */ /* has been reached, then stop displaying facts. */ /*================================================*/ if (max == 0) { PrintTally(theEnv,logicalName,count,"fact","facts"); EnvSetCurrentModule(theEnv,(void *) oldModule); return; } /*======================================================*/ /* If the index of the fact is greater than the minimum */ /* starting fact index, then display the fact. */ /*======================================================*/ if (factPtr->factIndex >= start) { PrintFactWithIdentifier(theEnv,logicalName,factPtr); EnvPrintRouter(theEnv,logicalName,"\n"); count++; if (max > 0) max--; } /*========================================*/ /* Proceed to the next fact to be listed. */ /*========================================*/ if (allModules) factPtr = (struct fact *) EnvGetNextFact(theEnv,factPtr); else factPtr = (struct fact *) GetNextFactInScope(theEnv,factPtr); } /*===================================================*/ /* Print the total of the number of facts displayed. */ /*===================================================*/ PrintTally(theEnv,logicalName,count,"fact","facts"); /*=============================*/ /* Restore the current module. */ /*=============================*/ EnvSetCurrentModule(theEnv,(void *) oldModule); } /****************************************************************/ /* GetFactsArgument: Returns an argument for the facts command. */ /* A return value of -1 indicates that no value was specified. */ /* A return value of -2 indicates that the value specified is */ /* invalid. */ /****************************************************************/ static long int GetFactsArgument( void *theEnv, int whichOne, int argumentCount) { long int factIndex; DATA_OBJECT theValue; if (whichOne > argumentCount) return(UNSPECIFIED); if (EnvArgTypeCheck(theEnv,"facts",whichOne,INTEGER,&theValue) == FALSE) return(INVALID); factIndex = DOToLong(theValue); if (factIndex < 0) { ExpectedTypeError1(theEnv,"facts",whichOne,"positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(INVALID); } return(factIndex); } #endif /* DEBUGGING_FUNCTIONS */ /**********************************************/ /* AssertStringFunction: H/L access routine */ /* for the assert-string function. */ /**********************************************/ globle void AssertStringFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT argPtr; struct fact *theFact; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if (EnvArgCountCheck(theEnv,"assert-string",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"assert-string",1,STRING,&argPtr) == FALSE) { return; } /*==========================================*/ /* Call the driver routine for converting a */ /* string to a fact and then assert it. */ /*==========================================*/ theFact = (struct fact *) EnvAssertString(theEnv,DOToString(argPtr)); if (theFact != NULL) { SetpType(returnValue,FACT_ADDRESS); SetpValue(returnValue,(void *) theFact); } return; } /******************************************/ /* SaveFactsCommand: H/L access routine */ /* for the save-facts command. */ /******************************************/ globle int SaveFactsCommand( void *theEnv) { char *fileName; int numArgs, saveCode = LOCAL_SAVE; char *argument; DATA_OBJECT theValue; struct expr *theList = NULL; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"save-facts",AT_LEAST,1)) == -1) return(FALSE); /*=================================================*/ /* Get the file name to which facts will be saved. */ /*=================================================*/ if ((fileName = GetFileName(theEnv,"save-facts",1)) == NULL) return(FALSE); /*=============================================================*/ /* If specified, the second argument to save-facts indicates */ /* whether just facts local to the current module or all facts */ /* visible to the current module will be saved. */ /*=============================================================*/ if (numArgs > 1) { if (EnvArgTypeCheck(theEnv,"save-facts",2,SYMBOL,&theValue) == FALSE) return(FALSE); argument = DOToString(theValue); if (strcmp(argument,"local") == 0) { saveCode = LOCAL_SAVE; } else if (strcmp(argument,"visible") == 0) { saveCode = VISIBLE_SAVE; } else { ExpectedTypeError1(theEnv,"save-facts",2,"symbol with value local or visible"); return(FALSE); } } /*======================================================*/ /* Subsequent arguments indicate that only those facts */ /* associated with the specified deftemplates should be */ /* saved to the file. */ /*======================================================*/ if (numArgs > 2) theList = GetFirstArgument()->nextArg->nextArg; /*====================================*/ /* Call the SaveFacts driver routine. */ /*====================================*/ if (EnvSaveFacts(theEnv,fileName,saveCode,theList) == FALSE) { return(FALSE); } return(TRUE); } /******************************************/ /* LoadFactsCommand: H/L access routine */ /* for the load-facts command. */ /******************************************/ globle int LoadFactsCommand( void *theEnv) { char *fileName; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"load-facts",EXACTLY,1) == -1) return(FALSE); /*====================================================*/ /* Get the file name from which facts will be loaded. */ /*====================================================*/ if ((fileName = GetFileName(theEnv,"load-facts",1)) == NULL) return(FALSE); /*====================================*/ /* Call the LoadFacts driver routine. */ /*====================================*/ if (EnvLoadFacts(theEnv,fileName) == FALSE) return(FALSE); return(TRUE); } /**************************************************************/ /* EnvSaveFacts: C access routine for the save-facts command. */ /**************************************************************/ globle intBool EnvSaveFacts( void *theEnv, char *fileName, int saveCode, struct expr *theList) { int tempValue1, tempValue2, tempValue3; struct fact *theFact; FILE *filePtr; struct defmodule *theModule; DATA_OBJECT_PTR theDOArray; int count, i, printFact, error; /*======================================================*/ /* Open the file. Use either "fast save" or I/O Router. */ /*======================================================*/ if ((filePtr = GenOpen(theEnv,fileName,"w")) == NULL) { OpenErrorMessage(theEnv,"save-facts",fileName); return(FALSE); } SetFastSave(theEnv,filePtr); /*===========================================*/ /* Set the print flags so that addresses and */ /* strings are printed properly to the file. */ /*===========================================*/ tempValue1 = PrintUtilityData(theEnv)->PreserveEscapedCharacters; PrintUtilityData(theEnv)->PreserveEscapedCharacters = TRUE; tempValue2 = PrintUtilityData(theEnv)->AddressesToStrings; PrintUtilityData(theEnv)->AddressesToStrings = TRUE; tempValue3 = PrintUtilityData(theEnv)->InstanceAddressesToNames; PrintUtilityData(theEnv)->InstanceAddressesToNames = TRUE; /*===================================================*/ /* Determine the list of specific facts to be saved. */ /*===================================================*/ theDOArray = GetSaveFactsDeftemplateNames(theEnv,theList,saveCode,&count,&error); if (error) { PrintUtilityData(theEnv)->PreserveEscapedCharacters = tempValue1; PrintUtilityData(theEnv)->AddressesToStrings = tempValue2; PrintUtilityData(theEnv)->InstanceAddressesToNames = tempValue3; GenClose(theEnv,filePtr); SetFastSave(theEnv,NULL); return(FALSE); } /*=================*/ /* Save the facts. */ /*=================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL); theFact != NULL; theFact = (struct fact *) GetNextFactInScope(theEnv,theFact)) { /*===========================================================*/ /* If we're doing a local save and the facts's corresponding */ /* deftemplate isn't in the current module, then don't save */ /* the fact. */ /*===========================================================*/ if ((saveCode == LOCAL_SAVE) && (theFact->whichDeftemplate->header.whichModule->theModule != theModule)) { printFact = FALSE; } /*=====================================================*/ /* Otherwise, if the list of facts to be printed isn't */ /* restricted, then set the print flag to TRUE. */ /*=====================================================*/ else if (theList == NULL) { printFact = TRUE; } /*=======================================================*/ /* Otherwise see if the fact's corresponding deftemplate */ /* is in the list of deftemplates whose facts are to be */ /* saved. If it's in the list, then set the print flag */ /* to TRUE, otherwise set it to FALSE. */ /*=======================================================*/ else { printFact = FALSE; for (i = 0; i < count; i++) { if (theDOArray[i].value == (void *) theFact->whichDeftemplate) { printFact = TRUE; break; } } } /*===================================*/ /* If the print flag is set to TRUE, */ /* then save the fact to the file. */ /*===================================*/ if (printFact) { PrintFact(theEnv,(char *) filePtr,theFact,FALSE,FALSE); EnvPrintRouter(theEnv,(char *) filePtr,"\n"); } } /*==========================*/ /* Restore the print flags. */ /*==========================*/ PrintUtilityData(theEnv)->PreserveEscapedCharacters = tempValue1; PrintUtilityData(theEnv)->AddressesToStrings = tempValue2; PrintUtilityData(theEnv)->InstanceAddressesToNames = tempValue3; /*=================*/ /* Close the file. */ /*=================*/ GenClose(theEnv,filePtr); SetFastSave(theEnv,NULL); /*==================================*/ /* Free the deftemplate name array. */ /*==================================*/ if (theList != NULL) rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * count); /*===================================*/ /* Return TRUE to indicate no errors */ /* occurred while saving the facts. */ /*===================================*/ return(TRUE); } /*******************************************************************/ /* GetSaveFactsDeftemplateNames: Retrieves the list of deftemplate */ /* names for saving specific facts with the save-facts command. */ /*******************************************************************/ static DATA_OBJECT_PTR GetSaveFactsDeftemplateNames( void *theEnv, struct expr *theList, int saveCode, int *count, int *error) { struct expr *tempList; DATA_OBJECT_PTR theDOArray; int i, tempCount; struct deftemplate *theDeftemplate = NULL; /*=============================*/ /* Initialize the error state. */ /*=============================*/ *error = FALSE; /*=====================================================*/ /* If no deftemplate names were specified as arguments */ /* then the deftemplate name list is empty. */ /*=====================================================*/ if (theList == NULL) { *count = 0; return(NULL); } /*======================================*/ /* Determine the number of deftemplate */ /* names to be stored in the name list. */ /*======================================*/ for (tempList = theList, *count = 0; tempList != NULL; tempList = tempList->nextArg, (*count)++) { /* Do Nothing */ } /*=========================================*/ /* Allocate the storage for the name list. */ /*=========================================*/ theDOArray = (DATA_OBJECT_PTR) gm3(theEnv,(long) sizeof(DATA_OBJECT) * *count); /*=====================================*/ /* Loop through each of the arguments. */ /*=====================================*/ for (tempList = theList, i = 0; i < *count; tempList = tempList->nextArg, i++) { /*========================*/ /* Evaluate the argument. */ /*========================*/ EvaluateExpression(theEnv,tempList,&theDOArray[i]); if (EvaluationData(theEnv)->EvaluationError) { *error = TRUE; rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } /*======================================*/ /* A deftemplate name must be a symbol. */ /*======================================*/ if (theDOArray[i].type != SYMBOL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"symbol"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } /*===================================================*/ /* Find the deftemplate. For a local save, look only */ /* in the current module. For a visible save, look */ /* in all visible modules. */ /*===================================================*/ if (saveCode == LOCAL_SAVE) { theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,ValueToString(theDOArray[i].value)); if (theDeftemplate == NULL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"local deftemplate name"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } } else if (saveCode == VISIBLE_SAVE) { theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL, ValueToString(theDOArray[i].value), &tempCount,TRUE,NULL); if (theDeftemplate == NULL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"visible deftemplate name"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } } /*==================================*/ /* Add a pointer to the deftemplate */ /* to the array being created. */ /*==================================*/ theDOArray[i].type = DEFTEMPLATE_PTR; theDOArray[i].value = (void *) theDeftemplate; } /*===================================*/ /* Return the array of deftemplates. */ /*===================================*/ return(theDOArray); } /**************************************************************/ /* EnvLoadFacts: C access routine for the load-facts command. */ /**************************************************************/ globle intBool EnvLoadFacts( void *theEnv, char *fileName) { FILE *filePtr; struct token theToken; struct expr *testPtr; DATA_OBJECT rv; /*======================================================*/ /* Open the file. Use either "fast save" or I/O Router. */ /*======================================================*/ if ((filePtr = GenOpen(theEnv,fileName,"r")) == NULL) { OpenErrorMessage(theEnv,"load-facts",fileName); return(FALSE); } SetFastLoad(theEnv,filePtr); /*=================*/ /* Load the facts. */ /*=================*/ theToken.type = LPAREN; while (theToken.type != STOP) { testPtr = StandardLoadFact(theEnv,(char *) filePtr,&theToken); if (testPtr == NULL) theToken.type = STOP; else EvaluateExpression(theEnv,testPtr,&rv); ReturnExpression(theEnv,testPtr); } /*=================*/ /* Close the file. */ /*=================*/ SetFastLoad(theEnv,NULL); GenClose(theEnv,filePtr); /*================================================*/ /* Return TRUE if no error occurred while loading */ /* the facts, otherwise return FALSE. */ /*================================================*/ if (EvaluationData(theEnv)->EvaluationError) return(FALSE); return(TRUE); } /*********************************************/ /* EnvLoadFactsFromString: C access routine. */ /*********************************************/ globle intBool EnvLoadFactsFromString( void *theEnv, char *theString, int theMax) { char * theStrRouter = "*** load-facts-from-string ***"; struct token theToken; struct expr *testPtr; DATA_OBJECT rv; /*==========================*/ /* Initialize string router */ /*==========================*/ if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) : (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax))) return(FALSE); /*=================*/ /* Load the facts. */ /*=================*/ theToken.type = LPAREN; while (theToken.type != STOP) { testPtr = StandardLoadFact(theEnv,theStrRouter,&theToken); if (testPtr == NULL) theToken.type = STOP; else EvaluateExpression(theEnv,testPtr,&rv); ReturnExpression(theEnv,testPtr); } /*=================*/ /* Close router. */ /*=================*/ CloseStringSource(theEnv,theStrRouter); /*================================================*/ /* Return TRUE if no error occurred while loading */ /* the facts, otherwise return FALSE. */ /*================================================*/ if (EvaluationData(theEnv)->EvaluationError) return(FALSE); return(TRUE); } /**************************************************************************/ /* StandardLoadFact: Loads a single fact from the specified logical name. */ /**************************************************************************/ static struct expr *StandardLoadFact( void *theEnv, char *logicalName, struct token *theToken) { int error = FALSE; struct expr *temp; GetToken(theEnv,logicalName,theToken); if (theToken->type != LPAREN) return(NULL); temp = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert")); temp->argList = GetRHSPattern(theEnv,logicalName,theToken,&error, TRUE,FALSE,TRUE,RPAREN); if (error == TRUE) { EnvPrintRouter(theEnv,WERROR,"Function load-facts encountered an error\n"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,temp); return(NULL); } if (ExpressionContainsVariables(temp,TRUE)) { ReturnExpression(theEnv,temp); return(NULL); } return(temp); } #if (! RUN_TIME) /****************************************************************/ /* AssertParse: Driver routine for parsing the assert function. */ /****************************************************************/ static struct expr *AssertParse( void *theEnv, struct expr *top, char *logicalName) { int error; struct expr *rv; struct token theToken; ReturnExpression(theEnv,top); SavePPBuffer(theEnv," "); IncrementIndentDepth(theEnv,8); rv = BuildRHSAssert(theEnv,logicalName,&theToken,&error,TRUE,TRUE,"assert command"); DecrementIndentDepth(theEnv,8); return(rv); } #endif /* (! RUN_TIME) */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/._developr.c0000400000175000017500000000075410441072315014721 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco_:r_:rpTTFSmFMPSRMWBBLclips-6.24/clipssrc/._retract.c0000400000175000017500000000452210441162477014553 0ustar jfsjfsMac OS X  2 R TEXTR*chn retract.ctrol PanelTCmr.txt.docTEXTR*ch p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco<6(<6(;99n/BpnGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/._constrnt.c0000400000175000017500000000075410441131363014752 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monacoz[^Jz[^J#TTFS JFMWBBMPSRclips-6.24/clipssrc/msgpass.h0000755000175000017500000000634210441602246014364 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Message-passing support functions */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS */ /* compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_msgpass #define _H_msgpass #define GetActiveInstance(theEnv) ((INSTANCE_TYPE *) GetNthMessageArgument(theEnv,0)->value) #ifndef _H_object #include "object.h" #endif typedef struct messageHandlerLink { HANDLER *hnd; struct messageHandlerLink *nxt; } HANDLER_LINK; #ifdef LOCALE #undef LOCALE #endif #ifdef _MSGPASS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define Send(theEnv,a,b,c,d) EnvSend(theEnv,a,b,c,d) #else #define Send(a,b,c,d) EnvSend(GetCurrentEnvironment(),a,b,c,d) #endif LOCALE void DirectMessage(void *,SYMBOL_HN *,INSTANCE_TYPE *, DATA_OBJECT *,EXPRESSION *); LOCALE void EnvSend(void *,DATA_OBJECT *,char *,char *,DATA_OBJECT *); LOCALE void DestroyHandlerLinks(void *,HANDLER_LINK *); LOCALE void SendCommand(void *,DATA_OBJECT *); LOCALE DATA_OBJECT *GetNthMessageArgument(void *,int); LOCALE int NextHandlerAvailable(void *); LOCALE void CallNextHandler(void *,DATA_OBJECT *); LOCALE void FindApplicableOfName(void *,DEFCLASS *,HANDLER_LINK *[], HANDLER_LINK *[],SYMBOL_HN *); LOCALE HANDLER_LINK *JoinHandlerLinks(void *,HANDLER_LINK *[],HANDLER_LINK *[],SYMBOL_HN *); LOCALE void PrintHandlerSlotGetFunction(void *,char *,void *); LOCALE intBool HandlerSlotGetFunction(void *,void *,DATA_OBJECT *); LOCALE void PrintHandlerSlotPutFunction(void *,char *,void *); LOCALE intBool HandlerSlotPutFunction(void *,void *,DATA_OBJECT *); LOCALE void DynamicHandlerGetSlot(void *,DATA_OBJECT *); LOCALE void DynamicHandlerPutSlot(void *,DATA_OBJECT *); #endif clips-6.24/clipssrc/._dffnxbin.h0000400000175000017500000000012207422634621014702 0ustar jfsjfsMac OS X  2 RTEXT???? clips-6.24/clipssrc/msgpsr.h0000755000175000017500000000300107422635010014207 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_msgpsr #define _H_msgpsr #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #define SELF_STRING "self" #ifndef _H_object #include "object.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MSGCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int ParseDefmessageHandler(void *,char *); LOCALE void CreateGetAndPutHandlers(void *,SLOT_DESC *); #endif #endif clips-6.24/clipssrc/._generate.c0000400000175000017500000000012207422634654014677 0ustar jfsjfsMac OS X  2 RTEXT????aclips-6.24/clipssrc/._tmpltdef.h0000400000175000017500000000075410441151173014725 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco7T/7T/<llTTFS FMWBBMPSRclips-6.24/clipssrc/._globlpsr.h0000400000175000017500000000075410441143671014736 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z1TTFS FMWBBMPSRclips-6.24/clipssrc/._factfun.c0000400000175000017500000000075410443377305014540 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco8-I8-IhLLJTTFL=FMWBBMPSRclips-6.24/clipssrc/._exprnops.c0000400000175000017500000000075410441132020014745 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z@,,TTFS FMWBBMPSRclips-6.24/clipssrc/._dfinscmp.c0000400000175000017500000000012207422634542014704 0ustar jfsjfsMac OS X  2 RTEXT???? aclips-6.24/clipssrc/._objcmp.c0000400000175000017500000000075410441602257014357 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0z:TTFL,FMPSRMWBBLclips-6.24/clipssrc/._prntutil.h0000400000175000017500000000075410441602274014772 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco!"TTFL-FMPSRMWBBLclips-6.24/clipssrc/._globlcmp.c0000400000175000017500000000075410177533443014712 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z$C C C\TTFT# FMWBBMPSRclips-6.24/clipssrc/dfinsbin.c0000755000175000017500000004665010177533434014514 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions for Definstances */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFINSTANCES_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "memalloc.h" #include "cstrcbin.h" #include "defins.h" #include "modulbin.h" #define _DFINSBIN_SOURCE_ #include "dfinsbin.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef struct bsaveDefinstancesModule { struct bsaveDefmoduleItemHeader header; } BSAVE_DEFINSTANCES_MODULE; typedef struct bsaveDefinstances { struct bsaveConstructHeader header; long mkinstance; } BSAVE_DEFINSTANCES; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveDefinstancesFind(void *); static void MarkDefinstancesItems(void *,struct constructHeader *,void *); static void BsaveDefinstancesExpressions(void *,FILE *); static void BsaveDefinstancesExpression(void *,struct constructHeader *,void *); static void BsaveStorageDefinstances(void *,FILE *); static void BsaveDefinstancesDriver(void *,FILE *); static void BsaveDefinstances(void *,struct constructHeader *,void *); #endif static void BloadStorageDefinstances(void *); static void BloadDefinstances(void *); static void UpdateDefinstancesModule(void *,void *,long); static void UpdateDefinstances(void *,void *,long); static void ClearDefinstancesBload(void *); static void DeallocateDefinstancesBinaryData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupDefinstancesBload DESCRIPTION : Initializes data structures and routines for binary loads of definstances INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupDefinstancesBload( void *theEnv) { AllocateEnvironmentData(theEnv,DFINSBIN_DATA,sizeof(struct definstancesBinaryData),DeallocateDefinstancesBinaryData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"definstances",0,BsaveDefinstancesFind,BsaveDefinstancesExpressions, BsaveStorageDefinstances,BsaveDefinstancesDriver, BloadStorageDefinstances,BloadDefinstances, ClearDefinstancesBload); #else AddBinaryItem(theEnv,"definstances",0,NULL,NULL,NULL,NULL, BloadStorageDefinstances,BloadDefinstances, ClearDefinstancesBload); #endif } /*************************************************************/ /* DeallocateDefinstancesBinaryData: Deallocates environment */ /* data for the definstances binary functionality. */ /*************************************************************/ static void DeallocateDefinstancesBinaryData( void *theEnv) { unsigned long space; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) space = DefinstancesBinaryData(theEnv)->DefinstancesCount * sizeof(struct definstances); if (space != 0) genlongfree(theEnv,(void *) DefinstancesBinaryData(theEnv)->DefinstancesArray,space); space = DefinstancesBinaryData(theEnv)->ModuleCount * sizeof(struct definstancesModule); if (space != 0) genlongfree(theEnv,(void *) DefinstancesBinaryData(theEnv)->ModuleArray,space); #endif } /*************************************************** NAME : BloadDefinstancesModuleRef DESCRIPTION : Returns a pointer to the appropriate definstances module INPUTS : The index of the module RETURNS : A pointer to the module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *BloadDefinstancesModuleRef( void *theEnv, int theIndex) { return ((void *) &DefinstancesBinaryData(theEnv)->ModuleArray[theIndex]); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************************************** NAME : BsaveDefinstancesFind DESCRIPTION : For all definstances, this routine marks all the needed symbols. Also, it also counts the number of expression structures needed. Also, counts total number of definstances. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented for every expression needed Symbols are marked in their structures NOTES : Also sets bsaveIndex for each definstances (assumes definstances will be bsaved in order of binary list) ***************************************************************************/ static void BsaveDefinstancesFind( void *theEnv) { SaveBloadCount(theEnv,DefinstancesBinaryData(theEnv)->ModuleCount); SaveBloadCount(theEnv,DefinstancesBinaryData(theEnv)->DefinstancesCount); DefinstancesBinaryData(theEnv)->DefinstancesCount = 0L; DefinstancesBinaryData(theEnv)->ModuleCount = DoForAllConstructs(theEnv,MarkDefinstancesItems,DefinstancesData(theEnv)->DefinstancesModuleIndex, FALSE,NULL); } /*************************************************** NAME : MarkDefinstancesItems DESCRIPTION : Marks the needed items for a definstances bsave INPUTS : 1) The definstances 2) User data buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Needed items marked NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void MarkDefinstancesItems( void *theEnv, struct constructHeader *theDefinstances, void *userBuffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(userBuffer) #endif MarkConstructHeaderNeededItems(theDefinstances,DefinstancesBinaryData(theEnv)->DefinstancesCount++); ExpressionData(theEnv)->ExpressionCount += ExpressionSize(((DEFINSTANCES *) theDefinstances)->mkinstance); MarkNeededItems(theEnv,((DEFINSTANCES *) theDefinstances)->mkinstance); } /*************************************************** NAME : BsaveDefinstancesExpressions DESCRIPTION : Writes out all expressions needed by deffunctyions INPUTS : The file pointer of the binary file RETURNS : Nothing useful SIDE EFFECTS : File updated NOTES : None ***************************************************/ static void BsaveDefinstancesExpressions( void *theEnv, FILE *fp) { DoForAllConstructs(theEnv,BsaveDefinstancesExpression,DefinstancesData(theEnv)->DefinstancesModuleIndex, FALSE,(void *) fp); } /*************************************************** NAME : BsaveDefinstancesExpression DESCRIPTION : Saves the needed expressions for a definstances bsave INPUTS : 1) The definstances 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Expressions saved NOTES : None ***************************************************/ static void BsaveDefinstancesExpression( void *theEnv, struct constructHeader *theDefinstances, void *userBuffer) { BsaveExpression(theEnv,((DEFINSTANCES *) theDefinstances)->mkinstance,(FILE *) userBuffer); } /*********************************************************** NAME : BsaveStorageDefinstances DESCRIPTION : Writes out number of each type of structure required for definstances Space required for counts (unsigned long) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None ***********************************************************/ static void BsaveStorageDefinstances( void *theEnv, FILE *fp) { unsigned long space; space = sizeof(unsigned long) * 2; GenWrite((void *) &space,(unsigned long) sizeof(unsigned long),fp); GenWrite((void *) &DefinstancesBinaryData(theEnv)->ModuleCount,(unsigned long) sizeof(long),fp); GenWrite((void *) &DefinstancesBinaryData(theEnv)->DefinstancesCount,(unsigned long) sizeof(long),fp); } /************************************************************************************* NAME : BsaveDefinstancesDriver DESCRIPTION : Writes out definstances in binary format Space required (unsigned long) All definstances (sizeof(DEFINSTANCES) * Number of definstances) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None *************************************************************************************/ static void BsaveDefinstancesDriver( void *theEnv, FILE *fp) { unsigned long space; struct defmodule *theModule; DEFINSTANCES_MODULE *theModuleItem; BSAVE_DEFINSTANCES_MODULE dummy_mitem; space = (unsigned long) ((sizeof(BSAVE_DEFINSTANCES_MODULE) * DefinstancesBinaryData(theEnv)->ModuleCount) + (sizeof(BSAVE_DEFINSTANCES) * DefinstancesBinaryData(theEnv)->DefinstancesCount)); GenWrite((void *) &space,(unsigned long) sizeof(unsigned long),fp); /* ================================= Write out each definstances module ================================= */ DefinstancesBinaryData(theEnv)->DefinstancesCount = 0L; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { theModuleItem = (DEFINSTANCES_MODULE *) GetModuleItem(theEnv,theModule,FindModuleItem(theEnv,"definstances")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&dummy_mitem.header,&theModuleItem->header); GenWrite((void *) &dummy_mitem,(unsigned long) sizeof(BSAVE_DEFINSTANCES_MODULE),fp); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } /* ========================== Write out each definstances ========================== */ DoForAllConstructs(theEnv,BsaveDefinstances,DefinstancesData(theEnv)->DefinstancesModuleIndex, FALSE,(void *) fp); RestoreBloadCount(theEnv,&DefinstancesBinaryData(theEnv)->ModuleCount); RestoreBloadCount(theEnv,&DefinstancesBinaryData(theEnv)->DefinstancesCount); } /*************************************************** NAME : BsaveDefinstances DESCRIPTION : Bsaves a definstances INPUTS : 1) The definstances 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Definstances saved NOTES : None ***************************************************/ static void BsaveDefinstances( void *theEnv, struct constructHeader *theDefinstances, void *userBuffer) { DEFINSTANCES *dptr = (DEFINSTANCES *) theDefinstances; BSAVE_DEFINSTANCES dummy_df; AssignBsaveConstructHeaderVals(&dummy_df.header,&dptr->header); if (dptr->mkinstance != NULL) { dummy_df.mkinstance = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(dptr->mkinstance); } else dummy_df.mkinstance = -1L; GenWrite((void *) &dummy_df,(unsigned long) sizeof(BSAVE_DEFINSTANCES),(FILE *) userBuffer); } #endif /*********************************************************************** NAME : BloadStorageDefinstances DESCRIPTION : This routine space required for definstances structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageDefinstances( void *theEnv) { unsigned long space; GenReadBinary(theEnv,(void *) &space,(unsigned long) sizeof(unsigned long)); if (space == 0L) return; GenReadBinary(theEnv,(void *) &DefinstancesBinaryData(theEnv)->ModuleCount,(unsigned long) sizeof(unsigned long)); GenReadBinary(theEnv,(void *) &DefinstancesBinaryData(theEnv)->DefinstancesCount,(unsigned long) sizeof(unsigned long)); if (DefinstancesBinaryData(theEnv)->ModuleCount == 0L) { DefinstancesBinaryData(theEnv)->ModuleArray = NULL; DefinstancesBinaryData(theEnv)->DefinstancesArray = NULL; return; } space = (unsigned long) (DefinstancesBinaryData(theEnv)->ModuleCount * sizeof(DEFINSTANCES_MODULE)); DefinstancesBinaryData(theEnv)->ModuleArray = (DEFINSTANCES_MODULE *) genlongalloc(theEnv,space); if (DefinstancesBinaryData(theEnv)->DefinstancesCount == 0L) { DefinstancesBinaryData(theEnv)->DefinstancesArray = NULL; return; } space = (unsigned long) (DefinstancesBinaryData(theEnv)->DefinstancesCount * sizeof(DEFINSTANCES)); DefinstancesBinaryData(theEnv)->DefinstancesArray = (DEFINSTANCES *) genlongalloc(theEnv,space); } /********************************************************************* NAME : BloadDefinstances DESCRIPTION : This routine reads definstances information from a binary file This routine moves through the definstances binary array updating pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pointers reset from array indices NOTES : Assumes all loading is finished ********************************************************************/ static void BloadDefinstances( void *theEnv) { unsigned long space; GenReadBinary(theEnv,(void *) &space,(unsigned long) sizeof(unsigned long)); BloadandRefresh(theEnv,DefinstancesBinaryData(theEnv)->ModuleCount,sizeof(BSAVE_DEFINSTANCES_MODULE),UpdateDefinstancesModule); BloadandRefresh(theEnv,DefinstancesBinaryData(theEnv)->DefinstancesCount,sizeof(BSAVE_DEFINSTANCES),UpdateDefinstances); } /******************************************************* NAME : UpdateDefinstancesModule DESCRIPTION : Updates definstances module with binary load data - sets pointers from offset information INPUTS : 1) A pointer to the bloaded data 2) The index of the binary array element to update RETURNS : Nothing useful SIDE EFFECTS : Definstances moudle pointers updated NOTES : None *******************************************************/ static void UpdateDefinstancesModule( void *theEnv, void *buf, long obji) { BSAVE_DEFINSTANCES_MODULE *bdptr; bdptr = (BSAVE_DEFINSTANCES_MODULE *) buf; UpdateDefmoduleItemHeader(theEnv,&bdptr->header,&DefinstancesBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(DEFINSTANCES),(void *) DefinstancesBinaryData(theEnv)->DefinstancesArray); } /*************************************************** NAME : UpdateDefinstances DESCRIPTION : Updates definstances with binary load data - sets pointers from offset information INPUTS : 1) A pointer to the bloaded data 2) The index of the binary array element to update RETURNS : Nothing useful SIDE EFFECTS : Definstances pointers upadted NOTES : None ***************************************************/ static void UpdateDefinstances( void *theEnv, void *buf, long obji) { BSAVE_DEFINSTANCES *bdptr; DEFINSTANCES *dfiptr; bdptr = (BSAVE_DEFINSTANCES *) buf; dfiptr = (DEFINSTANCES *) &DefinstancesBinaryData(theEnv)->DefinstancesArray[obji]; UpdateConstructHeader(theEnv,&bdptr->header,&dfiptr->header, (int) sizeof(DEFINSTANCES_MODULE),(void *) DefinstancesBinaryData(theEnv)->ModuleArray, (int) sizeof(DEFINSTANCES),(void *) DefinstancesBinaryData(theEnv)->DefinstancesArray); dfiptr->mkinstance = ExpressionPointer(bdptr->mkinstance); dfiptr->busy = 0; } /*************************************************************** NAME : ClearDefinstancesBload DESCRIPTION : Release all binary-loaded definstances structure arrays Resets definstances list to NULL INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : Definstances name symbol counts decremented ***************************************************************/ static void ClearDefinstancesBload( void *theEnv) { register long i; unsigned long space; space = (unsigned long) (sizeof(DEFINSTANCES_MODULE) * DefinstancesBinaryData(theEnv)->ModuleCount); if (space == 0L) return; genlongfree(theEnv,(void *) DefinstancesBinaryData(theEnv)->ModuleArray,space); DefinstancesBinaryData(theEnv)->ModuleArray = NULL; DefinstancesBinaryData(theEnv)->ModuleCount = 0L; for (i = 0L ; i < DefinstancesBinaryData(theEnv)->DefinstancesCount ; i++) UnmarkConstructHeader(theEnv,&DefinstancesBinaryData(theEnv)->DefinstancesArray[i].header); space = (unsigned long) (sizeof(DEFINSTANCES) * DefinstancesBinaryData(theEnv)->DefinstancesCount); if (space == 0L) return; genlongfree(theEnv,(void *) DefinstancesBinaryData(theEnv)->DefinstancesArray,space); DefinstancesBinaryData(theEnv)->DefinstancesArray = NULL; DefinstancesBinaryData(theEnv)->DefinstancesCount = 0L; } #endif clips-6.24/clipssrc/classinf.h0000755000175000017500000001211410441130171014474 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_classinf #define _H_classinf #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSINF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define ClassAbstractP(theEnv,a) EnvClassAbstractP(theEnv,a) #define ClassReactiveP(theEnv,a) EnvClassReactiveP(theEnv,a) #define ClassSlots(theEnv,a,b,c) EnvClassSlots(theEnv,a,b,c) #define ClassSubclasses(theEnv,a,b,c) EnvClassSubclasses(theEnv,a,b,c) #define ClassSuperclasses(theEnv,a,b,c) EnvClassSuperclasses(theEnv,a,b,c) #define SlotAllowedValues(theEnv,a,b,c) EnvSlotAllowedValues(theEnv,a,b,c) #define SlotAllowedClasses(theEnv,a,b,c) EnvSlotAllowedClasses(theEnv,a,b,c) #define SlotCardinality(theEnv,a,b,c) EnvSlotCardinality(theEnv,a,b,c) #define SlotFacets(theEnv,a,b,c) EnvSlotFacets(theEnv,a,b,c) #define SlotRange(theEnv,a,b,c) EnvSlotRange(theEnv,a,b,c) #define SlotSources(theEnv,a,b,c) EnvSlotSources(theEnv,a,b,c) #define SlotTypes(theEnv,a,b,c) EnvSlotTypes(theEnv,a,b,c) #define GetDefmessageHandlerList(theEnv,a,b,c) EnvGetDefmessageHandlerList(theEnv,a,b,c) #else #define ClassAbstractP(a) EnvClassAbstractP(GetCurrentEnvironment(),a) #define ClassReactiveP(a) EnvClassReactiveP(GetCurrentEnvironment(),a) #define ClassSlots(a,b,c) EnvClassSlots(GetCurrentEnvironment(),a,b,c) #define ClassSubclasses(a,b,c) EnvClassSubclasses(GetCurrentEnvironment(),a,b,c) #define ClassSuperclasses(a,b,c) EnvClassSuperclasses(GetCurrentEnvironment(),a,b,c) #define SlotAllowedValues(a,b,c) EnvSlotAllowedValues(GetCurrentEnvironment(),a,b,c) #define SlotAllowedClasses(a,b,c) EnvSlotAllowedClasses(GetCurrentEnvironment(),a,b,c) #define SlotCardinality(a,b,c) EnvSlotCardinality(GetCurrentEnvironment(),a,b,c) #define SlotFacets(a,b,c) EnvSlotFacets(GetCurrentEnvironment(),a,b,c) #define SlotRange(a,b,c) EnvSlotRange(GetCurrentEnvironment(),a,b,c) #define SlotSources(a,b,c) EnvSlotSources(GetCurrentEnvironment(),a,b,c) #define SlotTypes(a,b,c) EnvSlotTypes(GetCurrentEnvironment(),a,b,c) #define GetDefmessageHandlerList(a,b,c) EnvGetDefmessageHandlerList(GetCurrentEnvironment(),a,b,c) #endif LOCALE intBool ClassAbstractPCommand(void *); #if DEFRULE_CONSTRUCT LOCALE intBool ClassReactivePCommand(void *); #endif LOCALE void *ClassInfoFnxArgs(void *,char *,int *); LOCALE void ClassSlotsCommand(void *,DATA_OBJECT *); LOCALE void ClassSuperclassesCommand(void *,DATA_OBJECT *); LOCALE void ClassSubclassesCommand(void *,DATA_OBJECT *); LOCALE void GetDefmessageHandlersListCmd(void *,DATA_OBJECT *); LOCALE void SlotFacetsCommand(void *,DATA_OBJECT *); LOCALE void SlotSourcesCommand(void *,DATA_OBJECT *); LOCALE void SlotTypesCommand(void *,DATA_OBJECT *); LOCALE void SlotAllowedValuesCommand(void *,DATA_OBJECT *); LOCALE void SlotAllowedClassesCommand(void *,DATA_OBJECT *); LOCALE void SlotRangeCommand(void *,DATA_OBJECT *); LOCALE void SlotCardinalityCommand(void *,DATA_OBJECT *); LOCALE intBool EnvClassAbstractP(void *,void *); #if DEFRULE_CONSTRUCT LOCALE intBool EnvClassReactiveP(void *,void *); #endif LOCALE void EnvClassSlots(void *,void *,DATA_OBJECT *,int); LOCALE void EnvGetDefmessageHandlerList(void *,void *,DATA_OBJECT *,int); LOCALE void EnvClassSuperclasses(void *,void *,DATA_OBJECT *,int); LOCALE void EnvClassSubclasses(void *,void *,DATA_OBJECT *,int); LOCALE void ClassSubclassAddresses(void *,void *,DATA_OBJECT *,int); LOCALE void EnvSlotFacets(void *,void *,char *,DATA_OBJECT *); LOCALE void EnvSlotSources(void *,void *,char *,DATA_OBJECT *); LOCALE void EnvSlotTypes(void *,void *,char *,DATA_OBJECT *); LOCALE void EnvSlotAllowedValues(void *,void *,char *,DATA_OBJECT *); LOCALE void EnvSlotAllowedClasses(void *,void *,char *,DATA_OBJECT *); LOCALE void EnvSlotRange(void *,void *,char *,DATA_OBJECT *); LOCALE void EnvSlotCardinality(void *,void *,char *,DATA_OBJECT *); #endif clips-6.24/clipssrc/._symblcmp.h0000400000175000017500000000075407422634616014751 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco,5:,5:pNNTTFD#FMWBBMPSRclips-6.24/clipssrc/emathfun.h0000755000175000017500000000765707422634640014540 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* EXTENDED MATH FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for numerous extended math */ /* functions including cos, sin, tan, sec, csc, cot, acos, */ /* asin, atan, asec, acsc, acot, cosh, sinh, tanh, sech, */ /* csch, coth, acosh, asinh, atanh, asech, acsch, acoth, */ /* mod, exp, log, log10, sqrt, pi, deg-rad, rad-deg, */ /* deg-grad, grad-deg, **, and round. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_emathfun #define _H_emathfun #ifdef LOCALE #undef LOCALE #endif #ifdef _EMATHFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ExtendedMathFunctionDefinitions(void *theEnv); #if EX_MATH LOCALE double CosFunction(void *); LOCALE double SinFunction(void *); LOCALE double TanFunction(void *); LOCALE double SecFunction(void *); LOCALE double CscFunction(void *); LOCALE double CotFunction(void *); LOCALE double AcosFunction(void *); LOCALE double AsinFunction(void *); LOCALE double AtanFunction(void *); LOCALE double AsecFunction(void *); LOCALE double AcscFunction(void *); LOCALE double AcotFunction(void *); LOCALE double CoshFunction(void *); LOCALE double SinhFunction(void *); LOCALE double TanhFunction(void *); LOCALE double SechFunction(void *); LOCALE double CschFunction(void *); LOCALE double CothFunction(void *); LOCALE double AcoshFunction(void *); LOCALE double AsinhFunction(void *); LOCALE double AtanhFunction(void *); LOCALE double AsechFunction(void *); LOCALE double AcschFunction(void *); LOCALE double AcothFunction(void *); LOCALE long RoundFunction(void *); LOCALE void ModFunction(void *,DATA_OBJECT_PTR); LOCALE double ExpFunction(void *); LOCALE double LogFunction(void *); LOCALE double Log10Function(void *); LOCALE double SqrtFunction(void *); LOCALE double PiFunction(void *); LOCALE double DegRadFunction(void *); LOCALE double RadDegFunction(void *); LOCALE double DegGradFunction(void *); LOCALE double GradDegFunction(void *); LOCALE double PowFunction(void *); #endif #endif clips-6.24/clipssrc/insfun.c0000755000175000017500000013252610441602227014207 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INSTANCE FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Internal instance manipulation routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Link error occurs for the SlotExistError */ /* function when OBJECT_SYSTEM is set to 0 in */ /* setup.h. DR0865 */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved EvaluateAndStoreInDataObject to */ /* evaluatn.c */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "cstrnchk.h" #include "engine.h" #include "envrnmnt.h" #include "inscom.h" #include "insmngr.h" #include "memalloc.h" #include "modulutl.h" #include "msgcom.h" #include "msgfun.h" #include "prccode.h" #include "router.h" #include "utility.h" #if DEFRULE_CONSTRUCT #include "drive.h" #include "objrtmch.h" #endif #define _INSFUN_SOURCE_ #include "insfun.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define BIG_PRIME 11329 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static INSTANCE_TYPE *FindImportedInstance(void *,struct defmodule *,struct defmodule *,INSTANCE_TYPE *); #if DEFRULE_CONSTRUCT static void NetworkModifyForSharedSlot(void *,int,DEFCLASS *,SLOT_DESC *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : EnvIncrementInstanceCount DESCRIPTION : Increments instance busy count - prevents it from being deleted INPUTS : The address of the instance RETURNS : Nothing useful SIDE EFFECTS : Count set NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvIncrementInstanceCount( void *theEnv, void *vptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((INSTANCE_TYPE *) vptr)->busy++; } /*************************************************** NAME : EnvDecrementInstanceCount DESCRIPTION : Decrements instance busy count - might allow it to be deleted INPUTS : The address of the instance RETURNS : Nothing useful SIDE EFFECTS : Count set NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvDecrementInstanceCount( void *theEnv, void *vptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((INSTANCE_TYPE *) vptr)->busy--; } /*************************************************** NAME : InitializeInstanceTable DESCRIPTION : Initializes instance hash table to all NULL addresses INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Hash table initialized NOTES : None ***************************************************/ globle void InitializeInstanceTable( void *theEnv) { register int i; InstanceData(theEnv)->InstanceTable = (INSTANCE_TYPE **) gm2(theEnv,(int) (sizeof(INSTANCE_TYPE *) * INSTANCE_TABLE_HASH_SIZE)); for (i = 0 ; i < INSTANCE_TABLE_HASH_SIZE ; i++) InstanceData(theEnv)->InstanceTable[i] = NULL; } /******************************************************* NAME : CleanupInstances DESCRIPTION : Iterates through instance garbage list looking for nodes that have become unused - and purges them INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Non-busy instance garbage nodes deleted NOTES : None *******************************************************/ globle void CleanupInstances( void *theEnv) { IGARBAGE *gprv,*gtmp,*dump; if (InstanceData(theEnv)->MaintainGarbageInstances) return; gprv = NULL; gtmp = InstanceData(theEnv)->InstanceGarbageList; while (gtmp != NULL) { if ((gtmp->ins->busy == 0) && (gtmp->ins->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) #if DEFRULE_CONSTRUCT && (gtmp->ins->header.busyCount == 0) #endif ) { UtilityData(theEnv)->EphemeralItemCount -= 2; UtilityData(theEnv)->EphemeralItemSize -= InstanceSizeHeuristic(gtmp->ins) + sizeof(IGARBAGE); DecrementSymbolCount(theEnv,gtmp->ins->name); rtn_struct(theEnv,instance,gtmp->ins); if (gprv == NULL) InstanceData(theEnv)->InstanceGarbageList = gtmp->nxt; else gprv->nxt = gtmp->nxt; dump = gtmp; gtmp = gtmp->nxt; rtn_struct(theEnv,igarbage,dump); } else { gprv = gtmp; gtmp = gtmp->nxt; } } } /******************************************************* NAME : HashInstance DESCRIPTION : Generates a hash index for a given instance name INPUTS : The address of the instance name SYMBOL_HN RETURNS : The hash index value SIDE EFFECTS : None NOTES : Counts on the fact that the symbol has already been hashed into the symbol table - uses that hash value multiplied by a prime for a new hash *******************************************************/ globle unsigned HashInstance( SYMBOL_HN *cname) { unsigned long tally; tally = ((unsigned long) cname->bucket) * BIG_PRIME; return((unsigned) (tally % INSTANCE_TABLE_HASH_SIZE)); } /*************************************************** NAME : DestroyAllInstances DESCRIPTION : Deallocates all instances, reinitializes hash table and resets class instance pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : All instances deallocated NOTES : None ***************************************************/ globle void DestroyAllInstances( void *theEnv) { INSTANCE_TYPE *iptr; int svmaintain; SaveCurrentModule(theEnv); svmaintain = InstanceData(theEnv)->MaintainGarbageInstances; InstanceData(theEnv)->MaintainGarbageInstances = TRUE; iptr = InstanceData(theEnv)->InstanceList; while (iptr != NULL) { EnvSetCurrentModule(theEnv,(void *) iptr->cls->header.whichModule->theModule); DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,iptr,NULL,NULL); iptr = iptr->nxtList; while ((iptr != NULL) ? iptr->garbage : FALSE) iptr = iptr->nxtList; } InstanceData(theEnv)->MaintainGarbageInstances = svmaintain; RestoreCurrentModule(theEnv); } /****************************************************** NAME : RemoveInstanceData DESCRIPTION : Deallocates all the data objects in instance slots and then dealloactes the slots themeselves INPUTS : The instance RETURNS : Nothing useful SIDE EFFECTS : Instance slots removed NOTES : An instance made with CopyInstanceData will have shared values removed in all cases because they are not "real" instances. Instance class busy count decremented ******************************************************/ globle void RemoveInstanceData( void *theEnv, INSTANCE_TYPE *ins) { register unsigned i; INSTANCE_SLOT *sp; DecrementDefclassBusyCount(theEnv,(void *) ins->cls); for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) { sp = ins->slotAddresses[i]; if ((sp == &sp->desc->sharedValue) ? (--sp->desc->sharedCount == 0) : TRUE) { if (sp->desc->multiple) { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) sp->value); AddToMultifieldList(theEnv,(MULTIFIELD_PTR) sp->value); } else AtomDeinstall(theEnv,(int) sp->type,sp->value); sp->value = NULL; } } if (ins->cls->instanceSlotCount != 0) { rm(theEnv,(void *) ins->slotAddresses, (ins->cls->instanceSlotCount * sizeof(INSTANCE_SLOT *))); if (ins->cls->localInstanceSlotCount != 0) rm(theEnv,(void *) ins->slots, (ins->cls->localInstanceSlotCount * sizeof(INSTANCE_SLOT))); } ins->slots = NULL; ins->slotAddresses = NULL; } /*************************************************************************** NAME : FindInstanceBySymbol DESCRIPTION : Looks up a specified instance in the instance hash table INPUTS : The symbol for the name of the instance RETURNS : The address of the found instance, NULL otherwise SIDE EFFECTS : None NOTES : An instance is searched for by name first in the current module - then in imported modules according to the order given in the current module's definition ***************************************************************************/ globle INSTANCE_TYPE *FindInstanceBySymbol( void *theEnv, SYMBOL_HN *moduleAndInstanceName) { unsigned modulePosition,searchImports; SYMBOL_HN *moduleName,*instanceName; struct defmodule *currentModule,*theModule; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /* ======================================= Instance names of the form [] are searched for only in the current module ======================================= */ modulePosition = FindModuleSeparator(ValueToString(moduleAndInstanceName)); if (modulePosition == FALSE) { theModule = currentModule; instanceName = moduleAndInstanceName; searchImports = FALSE; } /* ========================================= Instance names of the form [::] are searched for in the current module and imported modules in the definition order ========================================= */ else if (modulePosition == 1) { theModule = currentModule; instanceName = ExtractConstructName(theEnv,modulePosition,ValueToString(moduleAndInstanceName)); searchImports = TRUE; } /* ============================================= Instance names of the form [::] are searched for in the specified module ============================================= */ else { moduleName = ExtractModuleName(theEnv,modulePosition,ValueToString(moduleAndInstanceName)); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName)); instanceName = ExtractConstructName(theEnv,modulePosition,ValueToString(moduleAndInstanceName)); if (theModule == NULL) return(NULL); searchImports = FALSE; } return(FindInstanceInModule(theEnv,instanceName,theModule,currentModule,searchImports)); } /*************************************************** NAME : FindInstanceInModule DESCRIPTION : Finds an instance of the given name in the given module in scope of the given current module (will also search imported modules if specified) INPUTS : 1) The instance name (no module) 2) The module to search 3) The currently active module 4) A flag indicating whether to search imported modules of given module as well RETURNS : The instance (NULL if none found) SIDE EFFECTS : None NOTES : None ***************************************************/ globle INSTANCE_TYPE *FindInstanceInModule( void *theEnv, SYMBOL_HN *instanceName, struct defmodule *theModule, struct defmodule *currentModule, unsigned searchImports) { INSTANCE_TYPE *startInstance,*ins; /* =============================== Find the first instance of the correct name in the hash chain =============================== */ startInstance = InstanceData(theEnv)->InstanceTable[HashInstance(instanceName)]; while (startInstance != NULL) { if (startInstance->name == instanceName) break; startInstance = startInstance->nxtHash; } if (startInstance == NULL) return(NULL); /* =========================================== Look for the instance in the specified module - if the class of the found instance is in scope of the current module, we have found the instance =========================================== */ for (ins = startInstance ; (ins != NULL) ? (ins->name == startInstance->name) : FALSE ; ins = ins->nxtHash) if ((ins->cls->header.whichModule->theModule == theModule) && DefclassInScope(theEnv,ins->cls,currentModule)) return(ins); /* ================================ For :: formats, we need to search imported modules too ================================ */ if (searchImports == FALSE) return(NULL); MarkModulesAsUnvisited(theEnv); return(FindImportedInstance(theEnv,theModule,currentModule,startInstance)); } /******************************************************************** NAME : FindInstanceSlot DESCRIPTION : Finds an instance slot by name INPUTS : 1) The address of the instance 2) The symbolic name of the slot RETURNS : The address of the slot, NULL if not found SIDE EFFECTS : None NOTES : None ********************************************************************/ globle INSTANCE_SLOT *FindInstanceSlot( void *theEnv, INSTANCE_TYPE *ins, SYMBOL_HN *sname) { register int i; i = FindInstanceTemplateSlot(theEnv,ins->cls,sname); return((i != -1) ? ins->slotAddresses[i] : NULL); } /******************************************************************** NAME : FindInstanceTemplateSlot DESCRIPTION : Performs a search on an class's instance template slot array to find a slot by name INPUTS : 1) The address of the class 2) The symbolic name of the slot RETURNS : The index of the slot, -1 if not found SIDE EFFECTS : None NOTES : The slot's unique id is used as index into the slot map array. ********************************************************************/ globle int FindInstanceTemplateSlot( void *theEnv, DEFCLASS *cls, SYMBOL_HN *sname) { int sid; sid = FindSlotNameID(theEnv,sname); if (sid == -1) return(-1); if (sid > (int) cls->maxSlotNameID) return(-1); return((int) cls->slotNameMap[sid] - 1); } /******************************************************* NAME : PutSlotValue DESCRIPTION : Evaluates new slot-expression and stores it as a multifield variable for the slot. INPUTS : 1) The address of the instance (NULL if no trace-messages desired) 2) The address of the slot 3) The address of the value 4) DATA_OBJECT_PTR to store the set value 5) The command doing the put- RETURNS : FALSE on errors, or TRUE SIDE EFFECTS : Old value deleted and new one allocated Old value symbols deinstalled New value symbols installed NOTES : None *******************************************************/ globle int PutSlotValue( void *theEnv, INSTANCE_TYPE *ins, INSTANCE_SLOT *sp, DATA_OBJECT *val, DATA_OBJECT *setVal, char *theCommand) { if (ValidSlotValue(theEnv,val,sp->desc,ins,theCommand) == FALSE) { SetpType(setVal,SYMBOL); SetpValue(setVal,EnvFalseSymbol(theEnv)); return(FALSE); } return(DirectPutSlotValue(theEnv,ins,sp,val,setVal)); } /******************************************************* NAME : DirectPutSlotValue DESCRIPTION : Evaluates new slot-expression and stores it as a multifield variable for the slot. INPUTS : 1) The address of the instance (NULL if no trace-messages desired) 2) The address of the slot 3) The address of the value 4) DATA_OBJECT_PTR to store the set value RETURNS : FALSE on errors, or TRUE SIDE EFFECTS : Old value deleted and new one allocated Old value symbols deinstalled New value symbols installed NOTES : None *******************************************************/ globle int DirectPutSlotValue( void *theEnv, INSTANCE_TYPE *ins, INSTANCE_SLOT *sp, DATA_OBJECT *val, DATA_OBJECT *setVal) { register long i,j; /* 6.04 Bug Fix */ #if DEFRULE_CONSTRUCT int sharedTraversalID; INSTANCE_SLOT *bsp,**spaddr; #endif DATA_OBJECT tmpVal; SetpType(setVal,SYMBOL); SetpValue(setVal,EnvFalseSymbol(theEnv)); if (val == NULL) { SystemError(theEnv,"INSFUN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } else if (GetpValue(val) == ProceduralPrimitiveData(theEnv)->NoParamValue) { if (sp->desc->dynamicDefault) { val = &tmpVal; if (!EvaluateAndStoreInDataObject(theEnv,sp->desc->multiple, (EXPRESSION *) sp->desc->defaultValue,val,TRUE)) return(FALSE); } else val = (DATA_OBJECT *) sp->desc->defaultValue; } #if DEFRULE_CONSTRUCT if (EngineData(theEnv)->JoinOperationInProgress && sp->desc->reactive && (ins->cls->reactive || sp->desc->shared)) { PrintErrorID(theEnv,"INSFUN",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot modify reactive instance slots while\n"); EnvPrintRouter(theEnv,WERROR," pattern-matching is in process.\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } /* ============================================= If we are about to change a slot of an object which is a basis for a firing rule, we need to make sure that slot is copied first ============================================= */ if (ins->basisSlots != NULL) { spaddr = &ins->slotAddresses[ins->cls->slotNameMap[sp->desc->slotName->id] - 1]; bsp = ins->basisSlots + (spaddr - ins->slotAddresses); if (bsp->value == NULL) { bsp->type = sp->type; bsp->value = sp->value; if (sp->desc->multiple) MultifieldInstall(theEnv,(MULTIFIELD_PTR) bsp->value); else AtomInstall(theEnv,(int) bsp->type,bsp->value); } } #endif if (sp->desc->multiple == 0) { AtomDeinstall(theEnv,(int) sp->type,sp->value); /* ====================================== Assumed that multfield already checked to be of cardinality 1 ====================================== */ if (GetpType(val) == MULTIFIELD) { sp->type = GetMFType(GetpValue(val),GetpDOBegin(val)); sp->value = GetMFValue(GetpValue(val),GetpDOBegin(val)); } else { sp->type = val->type; sp->value = val->value; } AtomInstall(theEnv,(int) sp->type,sp->value); SetpType(setVal,sp->type); SetpValue(setVal,sp->value); } else { MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) sp->value); AddToMultifieldList(theEnv,(MULTIFIELD_PTR) sp->value); sp->type = MULTIFIELD; if (val->type == MULTIFIELD) { sp->value = CreateMultifield2(theEnv,(unsigned long) GetpDOLength(val)); for (i = 1 , j = GetpDOBegin(val) ; i <= GetpDOLength(val) ; i++ , j++) { SetMFType(sp->value,i,GetMFType(val->value,j)); SetMFValue(sp->value,i,GetMFValue(val->value,j)); } } else { sp->value = CreateMultifield2(theEnv,1L); SetMFType(sp->value,1,(short) val->type); SetMFValue(sp->value,1,val->value); } MultifieldInstall(theEnv,(struct multifield *) sp->value); SetpType(setVal,MULTIFIELD); SetpValue(setVal,sp->value); SetpDOBegin(setVal,1); SetpDOEnd(setVal,GetMFLength(sp->value)); } /* ================================================== 6.05 Bug fix - any slot set directly or indirectly by a slot override or other side-effect during an instance initialization should not have its default value set ================================================== */ sp->override = ins->initializeInProgress; #if DEBUGGING_FUNCTIONS if (ins->cls->traceSlots) { if (sp->desc->shared) EnvPrintRouter(theEnv,WTRACE,"::= shared slot "); else EnvPrintRouter(theEnv,WTRACE,"::= local slot "); EnvPrintRouter(theEnv,WTRACE,ValueToString(sp->desc->slotName->name)); EnvPrintRouter(theEnv,WTRACE," in instance "); EnvPrintRouter(theEnv,WTRACE,ValueToString(ins->name)); EnvPrintRouter(theEnv,WTRACE," <- "); if (sp->type != MULTIFIELD) PrintAtom(theEnv,WTRACE,(int) sp->type,sp->value); else PrintMultifield(theEnv,WTRACE,(MULTIFIELD_PTR) sp->value,0, (long) (GetInstanceSlotLength(sp) - 1),TRUE); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif InstanceData(theEnv)->ChangesToInstances = TRUE; #if DEFRULE_CONSTRUCT if (ins->cls->reactive && sp->desc->reactive) { /* ============================================ If we have changed a shared slot, we need to perform a Rete update for every instance which contains this slot ============================================ */ if (sp->desc->shared) { sharedTraversalID = GetTraversalID(theEnv); if (sharedTraversalID != -1) { NetworkModifyForSharedSlot(theEnv,sharedTraversalID,sp->desc->cls,sp->desc); ReleaseTraversalID(theEnv); } else { PrintErrorID(theEnv,"INSFUN",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to pattern-match on shared slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name)); EnvPrintRouter(theEnv,WERROR," in class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sp->desc->cls)); EnvPrintRouter(theEnv,WERROR,".\n"); } } else ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sp->desc->slotName->id); } #endif return(TRUE); } /******************************************************************* NAME : ValidSlotValue DESCRIPTION : Determines if a value is appropriate for a slot-value INPUTS : 1) The value buffer 2) Slot descriptor 3) Instance for which slot is being checked (can be NULL) 4) Buffer holding printout of the offending command (if NULL assumes message-handler is executing and calls PrintHandler for CurrentCore instead) RETURNS : TRUE if value is OK, FALSE otherwise SIDE EFFECTS : Sets EvaluationError if slot is not OK NOTES : Examines all fields of a multi-field *******************************************************************/ globle int ValidSlotValue( void *theEnv, DATA_OBJECT *val, SLOT_DESC *sd, INSTANCE_TYPE *ins, char *theCommand) { register int violationCode; /* =================================== Special NoParamValue means to reset slot to default value =================================== */ if (GetpValue(val) == ProceduralPrimitiveData(theEnv)->NoParamValue) return(TRUE); if ((sd->multiple == 0) && (val->type == MULTIFIELD) && (GetpDOLength(val) != 1)) { PrintErrorID(theEnv,"INSFUN",7,FALSE); PrintDataObject(theEnv,WERROR,val); EnvPrintRouter(theEnv,WERROR," illegal for single-field "); PrintSlot(theEnv,WERROR,sd,ins,theCommand); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (val->type == RVOID) { PrintErrorID(theEnv,"INSFUN",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Void function illegal value for "); PrintSlot(theEnv,WERROR,sd,ins,theCommand); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (EnvGetDynamicConstraintChecking(theEnv)) { violationCode = ConstraintCheckDataObject(theEnv,val,sd->constraint); if (violationCode != NO_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,FALSE); if ((GetpType(val) == MULTIFIELD) && (sd->multiple == 0)) PrintAtom(theEnv,WERROR,GetMFType(GetpValue(val),GetpDOBegin(val)), GetMFValue(GetpValue(val),GetpDOEnd(val))); else PrintDataObject(theEnv,WERROR,val); EnvPrintRouter(theEnv,WERROR," for "); PrintSlot(theEnv,WERROR,sd,ins,theCommand); ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0, violationCode,sd->constraint,FALSE); SetEvaluationError(theEnv,TRUE); return(FALSE); } } return(TRUE); } /******************************************************** NAME : CheckInstance DESCRIPTION : Checks to see if the first argument to a function is a valid instance INPUTS : Name of the calling function RETURNS : The address of the instance SIDE EFFECTS : EvaluationError set and messages printed on errors NOTES : Used by Initialize and ModifyInstance ********************************************************/ globle INSTANCE_TYPE *CheckInstance( void *theEnv, char *func) { INSTANCE_TYPE *ins; DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,func,0); SetEvaluationError(theEnv,TRUE); return(NULL); } } else if ((temp.type == INSTANCE_NAME) || (temp.type == SYMBOL)) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins == NULL) { NoInstanceError(theEnv,ValueToString(temp.value),func); return(NULL); } } else { PrintErrorID(theEnv,"INSFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expected a valid instance in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } return(ins); } /*************************************************** NAME : NoInstanceError DESCRIPTION : Prints out an appropriate error message when an instance cannot be found for a function INPUTS : 1) The instance name 2) The function name RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void NoInstanceError( void *theEnv, char *iname, char *func) { PrintErrorID(theEnv,"INSFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No such instance "); EnvPrintRouter(theEnv,WERROR,iname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } /*************************************************** NAME : StaleInstanceAddress DESCRIPTION : Prints out an appropriate error message when an instance address is no longer valid INPUTS : The function name RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void StaleInstanceAddress( void *theEnv, char *func, int whichArg) { PrintErrorID(theEnv,"INSFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Invalid instance-address in function "); EnvPrintRouter(theEnv,WERROR,func); if (whichArg > 0) { EnvPrintRouter(theEnv,WERROR,", argument #"); PrintLongInteger(theEnv,WERROR,(long) whichArg); } EnvPrintRouter(theEnv,WERROR,".\n"); } /********************************************************************** NAME : EnvGetInstancesChanged DESCRIPTION : Returns whether instances have changed (any were added/deleted or slot values were changed) since last time flag was set to FALSE INPUTS : None RETURNS : The instances-changed flag SIDE EFFECTS : None NOTES : Used by interfaces to update instance windows **********************************************************************/ globle int EnvGetInstancesChanged( void *theEnv) { return(InstanceData(theEnv)->ChangesToInstances); } /******************************************************* NAME : EnvSetInstancesChanged DESCRIPTION : Sets instances-changed flag (see above) INPUTS : The value (TRUE or FALSE) RETURNS : Nothing useful SIDE EFFECTS : The flag is set NOTES : None *******************************************************/ globle void EnvSetInstancesChanged( void *theEnv, int changed) { InstanceData(theEnv)->ChangesToInstances = changed; } /******************************************************************* NAME : PrintSlot DESCRIPTION : Displays the name and origin of a slot INPUTS : 1) The logical output name 2) The slot descriptor 3) The instance source (can be NULL) 4) Buffer holding printout of the offending command (if NULL assumes message-handler is executing and calls PrintHandler for CurrentCore instead) RETURNS : Nothing useful SIDE EFFECTS : Message printed NOTES : None *******************************************************************/ globle void PrintSlot( void *theEnv, char *logName, SLOT_DESC *sd, INSTANCE_TYPE *ins, char *theCommand) { EnvPrintRouter(theEnv,logName,"slot "); EnvPrintRouter(theEnv,logName,ValueToString(sd->slotName->name)); if (ins != NULL) { EnvPrintRouter(theEnv,logName," of instance ["); EnvPrintRouter(theEnv,logName,ValueToString(ins->name)); EnvPrintRouter(theEnv,logName,"]"); } else if (sd->cls != NULL) { EnvPrintRouter(theEnv,logName," of class "); EnvPrintRouter(theEnv,logName,EnvGetDefclassName(theEnv,(void *) sd->cls)); } EnvPrintRouter(theEnv,logName," found in "); if (theCommand != NULL) EnvPrintRouter(theEnv,logName,theCommand); else PrintHandler(theEnv,logName,MessageHandlerData(theEnv)->CurrentCore->hnd,FALSE); } /***************************************************** NAME : PrintInstanceNameAndClass DESCRIPTION : Displays an instance's name and class INPUTS : 1) Logical name of output 2) The instance 3) Flag indicating whether to print carriage-return at end RETURNS : Nothing useful SIDE EFFECTS : Instnace name and class printed NOTES : None *****************************************************/ globle void PrintInstanceNameAndClass( void *theEnv, char *logicalName, INSTANCE_TYPE *theInstance, intBool linefeedFlag) { EnvPrintRouter(theEnv,logicalName,"["); EnvPrintRouter(theEnv,logicalName,EnvGetInstanceName(theEnv,(void *) theInstance)); EnvPrintRouter(theEnv,logicalName,"] of "); PrintClassName(theEnv,logicalName,theInstance->cls,linefeedFlag); } /*************************************************** NAME : PrintInstanceName DESCRIPTION : Used by the rule system commands such as (matches) and (agenda) to print out the name of an instance INPUTS : 1) The logical output name 2) A pointer to the instance RETURNS : Nothing useful SIDE EFFECTS : Name of instance printed NOTES : None ***************************************************/ globle void PrintInstanceName( void *theEnv, char *logName, void *vins) { INSTANCE_TYPE *ins; ins = (INSTANCE_TYPE *) vins; if (ins->garbage) { EnvPrintRouter(theEnv,logName,"name)); EnvPrintRouter(theEnv,logName,"]>"); } else { EnvPrintRouter(theEnv,logName,"["); EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins))); EnvPrintRouter(theEnv,logName,"]"); } } /*************************************************** NAME : PrintInstanceLongForm DESCRIPTION : Used by kernel to print instance addresses INPUTS : 1) The logical output name 2) A pointer to the instance RETURNS : Nothing useful SIDE EFFECTS : Address of instance printed NOTES : None ***************************************************/ globle void PrintInstanceLongForm( void *theEnv, char *logName, void *vins) { INSTANCE_TYPE *ins = (INSTANCE_TYPE *) vins; if (PrintUtilityData(theEnv)->InstanceAddressesToNames) { if (ins == &InstanceData(theEnv)->DummyInstance) EnvPrintRouter(theEnv,logName,"\"\""); else { EnvPrintRouter(theEnv,logName,"["); EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins))); EnvPrintRouter(theEnv,logName,"]"); } } else { if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logName,"\""); if (ins == &InstanceData(theEnv)->DummyInstance) EnvPrintRouter(theEnv,logName,""); else if (ins->garbage) { EnvPrintRouter(theEnv,logName,"name)); EnvPrintRouter(theEnv,logName,">"); } else { EnvPrintRouter(theEnv,logName,""); } if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logName,"\""); } } #if DEFRULE_CONSTRUCT /*************************************************** NAME : DecrementObjectBasisCount DESCRIPTION : Decrements the basis count of an object indicating that it is in use by the partial match of the currently executing rule INPUTS : The instance address RETURNS : Nothing useful SIDE EFFECTS : Basis count decremented and basis copy (possibly) deleted NOTES : When the count goes to zero, the basis copy of the object (if any) is deleted. ***************************************************/ globle void DecrementObjectBasisCount( void *theEnv, void *vins) { INSTANCE_TYPE *ins; register unsigned i; ins = (INSTANCE_TYPE *) vins; ins->header.busyCount--; if (ins->header.busyCount == 0) { if (ins->garbage) RemoveInstanceData(theEnv,ins); if (ins->cls->instanceSlotCount != 0) { for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) if (ins->basisSlots[i].value != NULL) { if (ins->basisSlots[i].desc->multiple) MultifieldDeinstall(theEnv,(struct multifield *) ins->basisSlots[i].value); else AtomDeinstall(theEnv,(int) ins->basisSlots[i].type, ins->basisSlots[i].value); } rm(theEnv,(void *) ins->basisSlots, (ins->cls->instanceSlotCount * sizeof(INSTANCE_SLOT))); ins->basisSlots = NULL; } } } /*************************************************** NAME : IncrementObjectBasisCount DESCRIPTION : Increments the basis count of an object indicating that it is in use by the partial match of the currently executing rule If this the count was zero, allocate an array of extra instance slots for use by slot variables INPUTS : The instance address RETURNS : Nothing useful SIDE EFFECTS : Basis count incremented NOTES : None ***************************************************/ globle void IncrementObjectBasisCount( void *theEnv, void *vins) { INSTANCE_TYPE *ins; register unsigned i; ins = (INSTANCE_TYPE *) vins; if (ins->header.busyCount == 0) { if (ins->cls->instanceSlotCount != 0) { ins->basisSlots = (INSTANCE_SLOT *) gm2(theEnv,(sizeof(INSTANCE_SLOT) * ins->cls->instanceSlotCount)); for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) { ins->basisSlots[i].desc = ins->slotAddresses[i]->desc; ins->basisSlots[i].value = NULL; } } } ins->header.busyCount++; } /*************************************************** NAME : MatchObjectFunction DESCRIPTION : Filters an instance through the object pattern network Used for incremental resets in binary loads and run-time modules INPUTS : The instance RETURNS : Nothing useful SIDE EFFECTS : Instance pattern-matched NOTES : None ***************************************************/ globle void MatchObjectFunction( void *theEnv, void *vins) { ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) vins,-1); } /*************************************************** NAME : NetworkSynchronized DESCRIPTION : Determines if state of instance is consistent with last push through pattern-matching network INPUTS : The instance RETURNS : TRUE if instance has not changed since last push through the Rete network, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool NetworkSynchronized( void *theEnv, void *vins) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((INSTANCE_TYPE *) vins)->reteSynchronized); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : FindImportedInstance DESCRIPTION : Searches imported modules for an instance of the correct name The imports are searched recursively in the order of the module definition INPUTS : 1) The module for which to search imported modules 2) The currently active module 3) The first instance of the correct name (cannot be NULL) RETURNS : An instance of the correct name imported from another module which is in scope of the current module SIDE EFFECTS : None NOTES : None *****************************************************/ static INSTANCE_TYPE *FindImportedInstance( void *theEnv, struct defmodule *theModule, struct defmodule *currentModule, INSTANCE_TYPE *startInstance) { struct portItem *importList; INSTANCE_TYPE *ins; if (theModule->visitedFlag) return(NULL); theModule->visitedFlag = TRUE; importList = theModule->importList; while (importList != NULL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(importList->moduleName)); for (ins = startInstance ; (ins != NULL) ? (ins->name == startInstance->name) : FALSE ; ins = ins->nxtHash) if ((ins->cls->header.whichModule->theModule == theModule) && DefclassInScope(theEnv,ins->cls,currentModule)) return(ins); ins = FindImportedInstance(theEnv,theModule,currentModule,startInstance); if (ins != NULL) return(ins); importList = importList->next; } /* ======================================================== Make sure instances of system classes are always visible ======================================================== */ for (ins = startInstance ; (ins != NULL) ? (ins->name == startInstance->name) : FALSE ; ins = ins->nxtHash) if (ins->cls->system) return(ins); return(NULL); } #if DEFRULE_CONSTRUCT /***************************************************** NAME : NetworkModifyForSharedSlot DESCRIPTION : Performs a Rete network modify for all instances which contain a specific shared slot INPUTS : 1) The traversal id to use when recursively entering subclasses to prevent duplicate examinations of a class 2) The class 3) The descriptor for the shared slot RETURNS : Nothing useful SIDE EFFECTS : Instances which contain the shared slot are filtered through the Rete network via a retract/assert NOTES : Assumes traversal id has been established *****************************************************/ static void NetworkModifyForSharedSlot( void *theEnv, int sharedTraversalID, DEFCLASS *cls, SLOT_DESC *sd) { INSTANCE_TYPE *ins; register unsigned i; /* ================================================ Make sure we haven't already examined this class ================================================ */ if (TestTraversalID(cls->traversalRecord,sharedTraversalID)) return; SetTraversalID(cls->traversalRecord,sharedTraversalID); /* =========================================== If the instances of this class contain the shared slot, send update events to the Rete network for all of its instances =========================================== */ if ((sd->slotName->id > cls->maxSlotNameID) ? FALSE : ((cls->slotNameMap[sd->slotName->id] == 0) ? FALSE : (cls->instanceTemplate[cls->slotNameMap[sd->slotName->id] - 1] == sd))) { for (ins = cls->instanceList ; ins != NULL ; ins = ins->nxtClass) ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sd->slotName->id); } /* ================================== Check the subclasses of this class ================================== */ for (i = 0 ; i < cls->directSubclasses.classCount ; i++) NetworkModifyForSharedSlot(theEnv,sharedTraversalID,cls->directSubclasses.classArray[i],sd); } #endif #endif clips-6.24/clipssrc/._rulebsc.h0000400000175000017500000000075410441150735014550 0ustar jfsjfsMac OS X  2 RTEXT????`aTTFH Monaco0z0z;,,TTFS FMWBBMPSRclips-6.24/clipssrc/rulelhs.h0000755000175000017500000000332107422634626014373 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFRULE LHS PARSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Coordinates parsing of the LHS conditional */ /* elements of a rule. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_rulelhs #define _H_rulelhs #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_reorder #include "reorder.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RULELHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct lhsParseNode *ParseRuleLHS(void *,char *,struct token *,char *); LOCALE void PropagatePatternType(struct lhsParseNode *,struct patternParser *); #endif clips-6.24/clipssrc/dffnxbin.h0000755000175000017500000000360507422634621014513 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_dffnxbin #define _H_dffnxbin #if DEFFUNCTION_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "dffnxfun.h" #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFNXBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupDeffunctionsBload(void *); LOCALE void *BloadDeffunctionModuleReference(void *,int); #define DFFNXBIN_DATA 24 struct deffunctionBinaryData { DEFFUNCTION *DeffunctionArray; long DeffunctionCount; long ModuleCount; DEFFUNCTION_MODULE *ModuleArray; }; #define DeffunctionBinaryData(theEnv) ((struct deffunctionBinaryData *) GetEnvironmentData(theEnv,DFFNXBIN_DATA)) #define DeffunctionPointer(i) (((i) == -1L) ? NULL : (DEFFUNCTION *) &DeffunctionBinaryData(theEnv)->DeffunctionArray[i]) #endif #endif clips-6.24/clipssrc/._rulecstr.c0000400000175000017500000000452210441151030014731 0ustar jfsjfsMac OS X  2 R TEXTR*chn rulecstr.crol PanelTCmr.txt.docTEXTR*ch p)zi " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH MonacoDDFclips-6.24/clipssrc/._clsltpsr.c0000400000175000017500000000075410441130250014740 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacow)w)}vXTTF/B"FMWBBMPSRclips-6.24/clipssrc/rulecmp.h0000755000175000017500000000332007422634623014360 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFRULE CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_rulecmp #define _H_rulecmp #include "conscomp.h" #ifndef _H_extnfunc #include "extnfunc.h" #endif #define JoinPrefix() ArbitraryPrefix(DefruleData(theEnv)->DefruleCodeItem,2) #ifdef LOCALE #undef LOCALE #endif #ifdef _RULECMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefruleCompilerSetup(void *); LOCALE void DefruleCModuleReference(void *,FILE *,int,int,int); #ifndef _RULECMP_SOURCE_ extern struct CodeGeneratorItem *DefruleCodeItem; #endif #endif clips-6.24/clipssrc/classcom.c0000755000175000017500000006677110441602050014513 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* CLASS COMMANDS MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Kernel Interface Commands for Object System */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "argacces.h" #include "classfun.h" #include "classini.h" #include "envrnmnt.h" #include "modulutl.h" #include "msgcom.h" #include "router.h" #define _CLASSCOM_SOURCE_ #include "classcom.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if (! BLOAD_ONLY) && (! RUN_TIME) && DEBUGGING_FUNCTIONS static void SaveDefclass(void *,struct constructHeader *,void *); #endif static char *GetClassDefaultsModeName(unsigned short); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************************* NAME : EnvFindDefclass DESCRIPTION : Looks up a specified class in the class hash table (Only looks in current or specified module) INPUTS : The name-string of the class (including module) RETURNS : The address of the found class, NULL otherwise SIDE EFFECTS : None NOTES : None ******************************************************************/ globle void *EnvFindDefclass( void *theEnv, char *classAndModuleName) { SYMBOL_HN *classSymbol = NULL; DEFCLASS *cls; struct defmodule *theModule = NULL; char *className; SaveCurrentModule(theEnv); className = ExtractModuleAndConstructName(theEnv,classAndModuleName); if (className != NULL) { classSymbol = FindSymbolHN(theEnv,ExtractModuleAndConstructName(theEnv,classAndModuleName)); theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } RestoreCurrentModule(theEnv); if (classSymbol == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if (cls->header.name == classSymbol) { if (cls->system || (cls->header.whichModule->theModule == theModule)) return(cls->installed ? (void *) cls : NULL); } cls = cls->nxtHash; } return(NULL); } /*************************************************** NAME : LookupDefclassByMdlOrScope DESCRIPTION : Finds a class anywhere (if module is specified) or in current or imported modules INPUTS : The class name RETURNS : The class (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : Assumes no two classes of the same name are ever in the same scope ***************************************************/ globle DEFCLASS *LookupDefclassByMdlOrScope( void *theEnv, char *classAndModuleName) { DEFCLASS *cls; char *className; SYMBOL_HN *classSymbol; struct defmodule *theModule; if (FindModuleSeparator(classAndModuleName) == FALSE) return(LookupDefclassInScope(theEnv,classAndModuleName)); SaveCurrentModule(theEnv); className = ExtractModuleAndConstructName(theEnv,classAndModuleName); theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); RestoreCurrentModule(theEnv); if(className == NULL) return(NULL); if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if ((cls->header.name == classSymbol) && (cls->header.whichModule->theModule == theModule)) return(cls->installed ? cls : NULL); cls = cls->nxtHash; } return(NULL); } /**************************************************** NAME : LookupDefclassInScope DESCRIPTION : Finds a class in current or imported modules (module specifier is not allowed) INPUTS : The class name RETURNS : The class (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : Assumes no two classes of the same name are ever in the same scope ****************************************************/ globle DEFCLASS *LookupDefclassInScope( void *theEnv, char *className) { DEFCLASS *cls; SYMBOL_HN *classSymbol; if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if ((cls->header.name == classSymbol) && DefclassInScope(theEnv,cls,NULL)) return(cls->installed ? cls : NULL); cls = cls->nxtHash; } return(NULL); } /****************************************************** NAME : LookupDefclassAnywhere DESCRIPTION : Finds a class in specified (or any) module INPUTS : 1) The module (NULL if don't care) 2) The class name (module specifier in name not allowed) RETURNS : The class (NULL if not found) SIDE EFFECTS : None NOTES : Does *not* generate an error if multiple classes of the same name exist as do the other lookup functions ******************************************************/ globle DEFCLASS *LookupDefclassAnywhere( void *theEnv, struct defmodule *theModule, char *className) { DEFCLASS *cls; SYMBOL_HN *classSymbol; if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if ((cls->header.name == classSymbol) && ((theModule == NULL) || (cls->header.whichModule->theModule == theModule))) return(cls->installed ? cls : NULL); cls = cls->nxtHash; } return(NULL); } /*************************************************** NAME : DefclassInScope DESCRIPTION : Determines if a defclass is in scope of the given module INPUTS : 1) The defclass 2) The module (NULL for current module) RETURNS : TRUE if in scope, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ #if IBM_TBC && (! DEFMODULE_CONSTRUCT) #pragma argsused #endif globle intBool DefclassInScope( void *theEnv, DEFCLASS *theDefclass, struct defmodule *theModule) { #if DEFMODULE_CONSTRUCT int moduleID; char *scopeMap; scopeMap = (char *) ValueToBitMap(theDefclass->scopeMap); if (theModule == NULL) theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); moduleID = (int) theModule->bsaveID; return(TestBitMap(scopeMap,moduleID) ? TRUE : FALSE); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv,theDefclass,theModule) #endif return(TRUE); #endif } /*********************************************************** NAME : EnvGetNextDefclass DESCRIPTION : Finds first or next defclass INPUTS : The address of the current defclass RETURNS : The address of the next defclass (NULL if none) SIDE EFFECTS : None NOTES : If ptr == NULL, the first defclass is returned. ***********************************************************/ globle void *EnvGetNextDefclass( void *theEnv, void *ptr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DefclassData(theEnv)->DefclassModuleIndex)); } /*************************************************** NAME : EnvIsDefclassDeletable DESCRIPTION : Determines if a defclass can be deleted INPUTS : Address of the defclass RETURNS : TRUE if deletable, FALSE otherwise SIDE EFFECTS : None NOTES : None ***************************************************/ globle intBool EnvIsDefclassDeletable( void *theEnv, void *ptr) { DEFCLASS *cls; if (! ConstructsDeletable(theEnv)) { return FALSE; } cls = (DEFCLASS *) ptr; if (cls->system == 1) return(FALSE); #if (! BLOAD_ONLY) && (! RUN_TIME) return((IsClassBeingUsed(cls) == FALSE) ? TRUE : FALSE); #else return FALSE; #endif } /************************************************************* NAME : UndefclassCommand DESCRIPTION : Deletes a class and its subclasses, as well as their associated instances INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (undefclass | *) *************************************************************/ globle void UndefclassCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefclass",DefclassData(theEnv)->DefclassConstruct); } /******************************************************** NAME : EnvUndefclass DESCRIPTION : Deletes the named defclass INPUTS : None RETURNS : TRUE if deleted, or FALSE SIDE EFFECTS : Defclass and handlers removed NOTES : Interface for AddConstruct() ********************************************************/ globle intBool EnvUndefclass( void *theEnv, void *theDefclass) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,theDefclass) #endif #if RUN_TIME || BLOAD_ONLY return(FALSE); #else DEFCLASS *cls; cls = (DEFCLASS *) theDefclass; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return(FALSE); #endif if (cls == NULL) return(RemoveAllUserClasses(theEnv)); return(DeleteClassUAG(theEnv,cls)); #endif } #if DEBUGGING_FUNCTIONS /********************************************************* NAME : PPDefclassCommand DESCRIPTION : Displays the pretty print form of a class to the wdialog router. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Syntax : (ppdefclass ) *********************************************************/ globle void PPDefclassCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefclass",DefclassData(theEnv)->DefclassConstruct); } /*************************************************** NAME : ListDefclassesCommand DESCRIPTION : Displays all defclass names INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Defclass names printed NOTES : H/L Interface ***************************************************/ globle void ListDefclassesCommand( void *theEnv) { ListConstructCommand(theEnv,"list-defclasses",DefclassData(theEnv)->DefclassConstruct); } /*************************************************** NAME : EnvListDefclasses DESCRIPTION : Displays all defclass names INPUTS : 1) The logical name of the output 2) The module RETURNS : Nothing useful SIDE EFFECTS : Defclass names printed NOTES : C Interface ***************************************************/ globle void EnvListDefclasses( void *theEnv, char *logicalName, struct defmodule *theModule) { ListConstruct(theEnv,DefclassData(theEnv)->DefclassConstruct,logicalName,theModule); } /********************************************************* NAME : EnvGetDefclassWatchInstances DESCRIPTION : Determines if deletions/creations of instances of this class will generate trace messages or not INPUTS : A pointer to the class RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDefclassWatchInstances( void *theEnv, void *theClass) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) theClass)->traceInstances); } /********************************************************* NAME : EnvSetDefclassWatchInstances DESCRIPTION : Sets the trace to ON/OFF for the creation/deletion of instances of the class INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the class RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the class set NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDefclassWatchInstances( void *theEnv, unsigned newState, void *theClass) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (((DEFCLASS *) theClass)->abstract) return; ((DEFCLASS *) theClass)->traceInstances = newState; } /********************************************************* NAME : EnvGetDefclassWatchSlots DESCRIPTION : Determines if changes to slots of instances of this class will generate trace messages or not INPUTS : A pointer to the class RETURNS : TRUE if a trace is active, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDefclassWatchSlots( void *theEnv, void *theClass) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) theClass)->traceSlots); } /********************************************************** NAME : EnvSetDefclassWatchSlots DESCRIPTION : Sets the trace to ON/OFF for the changes to slots of instances of the class INPUTS : 1) TRUE to set the trace on, FALSE to set it off 2) A pointer to the class RETURNS : Nothing useful SIDE EFFECTS : Watch flag for the class set NOTES : None **********************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDefclassWatchSlots( void *theEnv, unsigned newState, void *theClass) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((DEFCLASS *) theClass)->traceSlots = newState; } /****************************************************************** NAME : DefclassWatchAccess DESCRIPTION : Parses a list of class names passed by AddWatchItem() and sets the traces accordingly INPUTS : 1) A code indicating which trace flag is to be set 0 - Watch instance creation/deletion 1 - Watch slot changes to instances 2) The value to which to set the trace flags 3) A list of expressions containing the names of the classes for which to set traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags set in specified classes NOTES : Accessory function for AddWatchItem() ******************************************************************/ globle unsigned DefclassWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { if (code) return(ConstructSetWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,newState,argExprs, EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots)); else return(ConstructSetWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,newState,argExprs, EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances)); } /*********************************************************************** NAME : DefclassWatchPrint DESCRIPTION : Parses a list of class names passed by AddWatchItem() and displays the traces accordingly INPUTS : 1) The logical name of the output 2) A code indicating which trace flag is to be examined 0 - Watch instance creation/deletion 1 - Watch slot changes to instances 3) A list of expressions containing the names of the classes for which to examine traces RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Watch flags displayed for specified classes NOTES : Accessory function for AddWatchItem() ***********************************************************************/ globle unsigned DefclassWatchPrint( void *theEnv, char *logName, int code, EXPRESSION *argExprs) { if (code) return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs, EnvGetDefclassWatchSlots,EnvSetDefclassWatchSlots)); else return(ConstructPrintWatchAccess(theEnv,DefclassData(theEnv)->DefclassConstruct,logName,argExprs, EnvGetDefclassWatchInstances,EnvSetDefclassWatchInstances)); } #endif /********************************************************* NAME : GetDefclassListFunction DESCRIPTION : Groups names of all defclasses into a multifield variable INPUTS : A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Multifield set to list of classes NOTES : None *********************************************************/ globle void GetDefclassListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-defclass-list",returnValue,DefclassData(theEnv)->DefclassConstruct); } /*************************************************************** NAME : EnvGetDefclassList DESCRIPTION : Groups all defclass names into a multifield list INPUTS : 1) A data object buffer to hold the multifield result 2) The module from which to obtain defclasses RETURNS : Nothing useful SIDE EFFECTS : Multifield allocated and filled NOTES : External C access ***************************************************************/ globle void EnvGetDefclassList( void *theEnv, DATA_OBJECT *returnValue, struct defmodule *theModule) { GetConstructList(theEnv,returnValue,DefclassData(theEnv)->DefclassConstruct,theModule); } /***************************************************** NAME : HasSuperclass DESCRIPTION : Determines if class-2 is a superclass of class-1 INPUTS : 1) Class-1 2) Class-2 RETURNS : TRUE if class-2 is a superclass of class-1, FALSE otherwise SIDE EFFECTS : None NOTES : None *****************************************************/ globle int HasSuperclass( DEFCLASS *c1, DEFCLASS *c2) { register unsigned i; for (i = 1 ; i < c1->allSuperclasses.classCount ; i++) if (c1->allSuperclasses.classArray[i] == c2) return(TRUE); return(FALSE); } /******************************************************************** NAME : CheckClassAndSlot DESCRIPTION : Checks class and slot argument for various functions INPUTS : 1) Name of the calling function 2) Buffer for class address RETURNS : Slot symbol, NULL on errors SIDE EFFECTS : None NOTES : None ********************************************************************/ globle SYMBOL_HN *CheckClassAndSlot( void *theEnv, char *func, DEFCLASS **cls) { DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,func,1,SYMBOL,&temp) == FALSE) return(NULL); *cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (*cls == NULL) { ClassExistError(theEnv,func,DOToString(temp)); return(NULL); } if (EnvArgTypeCheck(theEnv,func,2,SYMBOL,&temp) == FALSE) return(NULL); return((SYMBOL_HN *) GetValue(temp)); } #if (! BLOAD_ONLY) && (! RUN_TIME) /*************************************************** NAME : SaveDefclasses DESCRIPTION : Prints pretty print form of defclasses to specified output INPUTS : The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ #if IBM_TBC && (! DEBUGGING_FUNCTIONS) #pragma argsused #endif globle void SaveDefclasses( void *theEnv, void *theModule, char *logName) { #if DEBUGGING_FUNCTIONS DoForAllConstructsInModule(theEnv,theModule,SaveDefclass,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) logName); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv,theModule,logName) #endif #endif } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if (! BLOAD_ONLY) && (! RUN_TIME) && DEBUGGING_FUNCTIONS /*************************************************** NAME : SaveDefclass DESCRIPTION : Writes out the pretty-print forms of a class and all its handlers INPUTS : 1) The class 2) The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : Class and handlers written NOTES : None ***************************************************/ static void SaveDefclass( void *theEnv, struct constructHeader *theDefclass, void *userBuffer) { char *logName = (char *) userBuffer; unsigned hnd; char *ppForm; ppForm = EnvGetDefclassPPForm(theEnv,(void *) theDefclass); if (ppForm != NULL) { PrintInChunks(theEnv,logName,ppForm); EnvPrintRouter(theEnv,logName,"\n"); hnd = EnvGetNextDefmessageHandler(theEnv,(void *) theDefclass,0); while (hnd != 0) { ppForm = EnvGetDefmessageHandlerPPForm(theEnv,(void *) theDefclass,hnd); if (ppForm != NULL) { PrintInChunks(theEnv,logName,ppForm); EnvPrintRouter(theEnv,logName,"\n"); } hnd = EnvGetNextDefmessageHandler(theEnv,(void *) theDefclass,hnd); } } } #endif /***********************************************/ /* EnvSetClassDefaultsMode: Allows the setting */ /* of the class defaults mode. */ /***********************************************/ globle unsigned short EnvSetClassDefaultsMode( void *theEnv, unsigned short value) { unsigned short ov; ov = DefclassData(theEnv)->ClassDefaultsMode; DefclassData(theEnv)->ClassDefaultsMode = value; return(ov); } /****************************************/ /* EnvGetClassDefaultsMode: Returns the */ /* value of the class defaults mode. */ /****************************************/ globle unsigned short EnvGetClassDefaultsMode( void *theEnv) { return(DefclassData(theEnv)->ClassDefaultsMode); } /***************************************************/ /* GetClassDefaultsModeCommand: H/L access routine */ /* for the get-class-defaults-mode command. */ /***************************************************/ globle void *GetClassDefaultsModeCommand( void *theEnv) { EnvArgCountCheck(theEnv,"get-class-defaults-mode",EXACTLY,0); return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); } /***************************************************/ /* SetClassDefaultsModeCommand: H/L access routine */ /* for the set-class-defaults-mode command. */ /***************************************************/ globle void *SetClassDefaultsModeCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; unsigned short oldMode; oldMode = DefclassData(theEnv)->ClassDefaultsMode; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if (EnvArgCountCheck(theEnv,"set-class-defaults-mode",EXACTLY,1) == -1) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); } if (EnvArgTypeCheck(theEnv,"set-class-defaults-mode",1,SYMBOL,&argPtr) == FALSE) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); } argument = DOToString(argPtr); /*=============================================*/ /* Set the strategy to the specified strategy. */ /*=============================================*/ if (strcmp(argument,"conservation") == 0) { EnvSetClassDefaultsMode(theEnv,CONSERVATION_MODE); } else if (strcmp(argument,"convenience") == 0) { EnvSetClassDefaultsMode(theEnv,CONVENIENCE_MODE); } else { ExpectedTypeError1(theEnv,"set-class-defaults-mode",1, "symbol with value conservation or convenience"); return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv)))); } /*===================================*/ /* Return the old value of the mode. */ /*===================================*/ return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetClassDefaultsModeName(oldMode))); } /*******************************************************************/ /* GetClassDefaultsModeName: Given the integer value corresponding */ /* to a specified class defaults mode, return a character string */ /* of the class defaults mode's name. */ /*******************************************************************/ static char *GetClassDefaultsModeName( unsigned short mode) { char *sname; switch (mode) { case CONSERVATION_MODE: sname = "conservation"; break; case CONVENIENCE_MODE: sname = "convenience"; break; default: sname = "unknown"; break; } return(sname); } #endif clips-6.24/clipssrc/._factbin.h0000400000175000017500000000012207422634767014525 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/evaluatn.c0000755000175000017500000010571110441602154014517 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EVALUATION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for evaluating expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EvaluateAndStoreInDataObject function. */ /* */ /*************************************************************/ #define _EVALUATN_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include #include "setup.h" #include "commline.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "extnfunc.h" #include "prcdrfun.h" #include "multifld.h" #include "factmngr.h" #include "prntutil.h" #include "exprnpsr.h" #include "utility.h" #include "proflfun.h" #include "sysdep.h" #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #endif #if OBJECT_SYSTEM #include "object.h" #endif #include "evaluatn.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void PropagateReturnAtom(void *,int,void *); /**************************************************/ /* InitializeEvaluationData: Allocates environment */ /* data for expression evaluation. */ /**************************************************/ globle void InitializeEvaluationData( void *theEnv) { AllocateEnvironmentData(theEnv,EVALUATION_DATA,sizeof(struct evaluationData),NULL); } /**************************************************************/ /* EvaluateExpression: Evaluates an expression. Returns FALSE */ /* if no errors occurred during evaluation, otherwise TRUE. */ /**************************************************************/ globle int EvaluateExpression( void *theEnv, struct expr *problem, DATA_OBJECT_PTR returnValue) { struct expr *oldArgument; struct FunctionDefinition *fptr; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif if (problem == NULL) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return(EvaluationData(theEnv)->EvaluationError); } switch (problem->type) { case STRING: case SYMBOL: case FLOAT: case INTEGER: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif case EXTERNAL_ADDRESS: returnValue->type = problem->type; returnValue->value = problem->value; break; case FCALL: { fptr = (struct FunctionDefinition *) problem->value; #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &fptr->usrData, ProfileFunctionData(theEnv)->ProfileUserFunctions); #endif oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = problem; switch(fptr->returnValueType) { case 'v' : if (fptr->environmentAware) { (* (void (*)(void *)) fptr->functionPointer)(theEnv); } else { (* (void (*)(void)) fptr->functionPointer)(); } returnValue->type = RVOID; returnValue->value = EnvFalseSymbol(theEnv); break; case 'b' : returnValue->type = SYMBOL; if (fptr->environmentAware) { if ((* (int (*)(void *)) fptr->functionPointer)(theEnv)) returnValue->value = EnvTrueSymbol(theEnv); else returnValue->value = EnvFalseSymbol(theEnv); } else { if ((* (int (*)(void)) fptr->functionPointer)()) returnValue->value = EnvTrueSymbol(theEnv); else returnValue->value = EnvFalseSymbol(theEnv); } break; case 'a' : returnValue->type = EXTERNAL_ADDRESS; if (fptr->environmentAware) { returnValue->value = (* (void *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (* (void *(*)(void)) fptr->functionPointer)(); } break; case 'i' : returnValue->type = INTEGER; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddLong(theEnv,(long) (* (int (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddLong(theEnv,(long) (* (int (*)(void)) fptr->functionPointer)()); } break; case 'l' : returnValue->type = INTEGER; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddLong(theEnv,(* (long int (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddLong(theEnv,(* (long int (*)(void)) fptr->functionPointer)()); } break; case 'f' : returnValue->type = FLOAT; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddDouble(theEnv,(double) (* (float (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddDouble(theEnv,(double) (* (float (*)(void)) fptr->functionPointer)()); } break; case 'd' : returnValue->type = FLOAT; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddDouble(theEnv,(* (double (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddDouble(theEnv,(* (double (*)(void)) fptr->functionPointer)()); } break; case 's' : returnValue->type = STRING; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; case 'w' : returnValue->type = SYMBOL; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; #if OBJECT_SYSTEM case 'x' : returnValue->type = INSTANCE_ADDRESS; if (fptr->environmentAware) { returnValue->value = (* (void *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (* (void *(*)(void)) fptr->functionPointer)(); } break; case 'o' : returnValue->type = INSTANCE_NAME; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; #endif case 'c' : { char cbuff[2]; if (fptr->environmentAware) { cbuff[0] = (* (char (*)(void *)) fptr->functionPointer)(theEnv); } else { cbuff[0] = (* (char (*)(void)) fptr->functionPointer)(); } cbuff[1] = EOS; returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,cbuff); break; } case 'j' : case 'k' : case 'm' : case 'n' : case 'u' : if (fptr->environmentAware) { (* (void (*)(void *,DATA_OBJECT_PTR)) fptr->functionPointer)(theEnv,returnValue); } else { (* (void (*)(DATA_OBJECT_PTR)) fptr->functionPointer)(returnValue); } break; default : SystemError(theEnv,"EVALUATN",2); EnvExitRouter(theEnv,EXIT_FAILURE); break; } #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif EvaluationData(theEnv)->CurrentExpression = oldArgument; break; } case MULTIFIELD: returnValue->type = MULTIFIELD; returnValue->value = ((DATA_OBJECT_PTR) (problem->value))->value; returnValue->begin = ((DATA_OBJECT_PTR) (problem->value))->begin; returnValue->end = ((DATA_OBJECT_PTR) (problem->value))->end; break; case MF_VARIABLE: case SF_VARIABLE: if (GetBoundVariable(theEnv,returnValue,(SYMBOL_HN *) problem->value) == FALSE) { PrintErrorID(theEnv,"EVALUATN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(problem->value)); EnvPrintRouter(theEnv,WERROR," is unbound\n"); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); } break; default: if (EvaluationData(theEnv)->PrimitivesArray[problem->type] == NULL) { SystemError(theEnv,"EVALUATN",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (EvaluationData(theEnv)->PrimitivesArray[problem->type]->copyToEvaluate) { returnValue->type = problem->type; returnValue->value = problem->value; break; } if (EvaluationData(theEnv)->PrimitivesArray[problem->type]->evaluateFunction == NULL) { SystemError(theEnv,"EVALUATN",4); EnvExitRouter(theEnv,EXIT_FAILURE); } oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = problem; #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &EvaluationData(theEnv)->PrimitivesArray[problem->type]->usrData, ProfileFunctionData(theEnv)->ProfileUserFunctions); #endif (*EvaluationData(theEnv)->PrimitivesArray[problem->type]->evaluateFunction)(theEnv,problem->value,returnValue); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif EvaluationData(theEnv)->CurrentExpression = oldArgument; break; } PropagateReturnValue(theEnv,returnValue); return(EvaluationData(theEnv)->EvaluationError); } /******************************************/ /* InstallPrimitive: Installs a primitive */ /* data type in the primitives array. */ /******************************************/ globle void InstallPrimitive( void *theEnv, struct entityRecord *thePrimitive, int whichPosition) { if (EvaluationData(theEnv)->PrimitivesArray[whichPosition] != NULL) { SystemError(theEnv,"EVALUATN",5); EnvExitRouter(theEnv,EXIT_FAILURE); } EvaluationData(theEnv)->PrimitivesArray[whichPosition] = thePrimitive; } /******************************************************/ /* SetEvaluationError: Sets the EvaluationError flag. */ /******************************************************/ globle void SetEvaluationError( void *theEnv, int value) { EvaluationData(theEnv)->EvaluationError = value; if (value == TRUE) { EvaluationData(theEnv)->HaltExecution = TRUE; } } /*********************************************************/ /* GetEvaluationError: Returns the EvaluationError flag. */ /*********************************************************/ globle int GetEvaluationError( void *theEnv) { return(EvaluationData(theEnv)->EvaluationError); } /**************************************************/ /* SetHaltExecution: Sets the HaltExecution flag. */ /**************************************************/ globle void SetHaltExecution( void *theEnv, int value) { EvaluationData(theEnv)->HaltExecution = value; } /*****************************************************/ /* GetHaltExecution: Returns the HaltExecution flag. */ /*****************************************************/ globle int GetHaltExecution( void *theEnv) { return(EvaluationData(theEnv)->HaltExecution); } /******************************************************/ /* ReturnValues: Returns a linked list of DATA_OBJECT */ /* structures to the pool of free memory. */ /******************************************************/ globle void ReturnValues( void *theEnv, DATA_OBJECT_PTR garbagePtr) { DATA_OBJECT_PTR nextPtr; while (garbagePtr != NULL) { nextPtr = garbagePtr->next; ValueDeinstall(theEnv,garbagePtr); rtn_struct(theEnv,dataObject,garbagePtr); garbagePtr = nextPtr; } } /***************************************************/ /* PrintDataObject: Prints a DATA_OBJECT structure */ /* to the specified logical name. */ /***************************************************/ globle void PrintDataObject( void *theEnv, char *fileid, DATA_OBJECT_PTR argPtr) { switch(argPtr->type) { case RVOID: case SYMBOL: case STRING: case INTEGER: case FLOAT: case EXTERNAL_ADDRESS: case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif PrintAtom(theEnv,fileid,argPtr->type,argPtr->value); break; case MULTIFIELD: PrintMultifield(theEnv,fileid,(struct multifield *) argPtr->value, argPtr->begin,argPtr->end,TRUE); break; default: if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type] != NULL) { if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction) { (*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction)(theEnv,fileid,argPtr->value); break; } else if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction) { (*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction)(theEnv,fileid,argPtr->value); break; } } EnvPrintRouter(theEnv,fileid,"type); EnvPrintRouter(theEnv,fileid,">"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); break; } } /****************************************************/ /* EnvSetMultifieldErrorValue: Creates a multifield */ /* value of length zero for error returns. */ /****************************************************/ globle void EnvSetMultifieldErrorValue( void *theEnv, DATA_OBJECT_PTR returnValue) { returnValue->type = MULTIFIELD; returnValue->value = EnvCreateMultifield(theEnv,0L); returnValue->begin = 1; returnValue->end = 0; } /**************************************************/ /* ValueInstall: Increments the appropriate count */ /* (in use) values for a DATA_OBJECT structure. */ /**************************************************/ globle void ValueInstall( void *theEnv, DATA_OBJECT *vPtr) { if (vPtr->type == MULTIFIELD) MultifieldInstall(theEnv,(struct multifield *) vPtr->value); else AtomInstall(theEnv,vPtr->type,vPtr->value); } /****************************************************/ /* ValueDeinstall: Decrements the appropriate count */ /* (in use) values for a DATA_OBJECT structure. */ /****************************************************/ globle void ValueDeinstall( void *theEnv, DATA_OBJECT *vPtr) { if (vPtr->type == MULTIFIELD) MultifieldDeinstall(theEnv,(struct multifield *) vPtr->value); else AtomDeinstall(theEnv,vPtr->type,vPtr->value); } /*****************************************/ /* AtomInstall: Increments the reference */ /* count of an atomic data type. */ /*****************************************/ globle void AtomInstall( void *theEnv, int type, void *vPtr) { switch (type) { case SYMBOL: case STRING: #if DEFGLOBAL_CONSTRUCT case GBL_VARIABLE: #endif #if OBJECT_SYSTEM case INSTANCE_NAME: #endif IncrementSymbolCount(vPtr); break; case FLOAT: IncrementFloatCount(vPtr); break; case INTEGER: IncrementIntegerCount(vPtr); break; case MULTIFIELD: MultifieldInstall(theEnv,(struct multifield *) vPtr); break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr); else if (EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount) { (*EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount)(theEnv,vPtr); } break; } } /*******************************************/ /* AtomDeinstall: Decrements the reference */ /* count of an atomic data type. */ /*******************************************/ globle void AtomDeinstall( void *theEnv, int type, void *vPtr) { switch (type) { case SYMBOL: case STRING: #if DEFGLOBAL_CONSTRUCT case GBL_VARIABLE: #endif #if OBJECT_SYSTEM case INSTANCE_NAME: #endif DecrementSymbolCount(theEnv,(SYMBOL_HN *) vPtr); break; case FLOAT: DecrementFloatCount(theEnv,(FLOAT_HN *) vPtr); break; case INTEGER: DecrementIntegerCount(theEnv,(INTEGER_HN *) vPtr); break; case MULTIFIELD: MultifieldDeinstall(theEnv,(struct multifield *) vPtr); break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) DecrementBitMapCount(theEnv,(BITMAP_HN *) vPtr); else if (EvaluationData(theEnv)->PrimitivesArray[type]->decrementBusyCount) { (*EvaluationData(theEnv)->PrimitivesArray[type]->decrementBusyCount)(theEnv,vPtr); } } } /*********************************************************************/ /* PropagateReturnValue: Decrements the associated depth for a value */ /* stored in a DATA_OBJECT structure. In effect, the values */ /* returned by certain evaluations (such as a deffunction call) */ /* are passed up to the previous depth of evaluation. The return */ /* value's depth is decremented so that it will not be garbage */ /* collected along with other items that are no longer needed from */ /* the evaluation that generated the return value. */ /*********************************************************************/ globle void PropagateReturnValue( void *theEnv, DATA_OBJECT *vPtr) { unsigned long i; /* 6.04 Bug Fix */ struct multifield *theSegment; struct field *theMultifield; if (vPtr->type != MULTIFIELD) { PropagateReturnAtom(theEnv,vPtr->type,vPtr->value); } else { theSegment = (struct multifield *) vPtr->value; if (theSegment->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) theSegment->depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth; theMultifield = theSegment->theFields; for (i = 0; i < theSegment->multifieldLength; i++) { PropagateReturnAtom(theEnv,theMultifield[i].type,theMultifield[i].value); } } } /*****************************************/ /* PropagateReturnAtom: Support function */ /* for PropagateReturnValue. */ /*****************************************/ static void PropagateReturnAtom( void *theEnv, int type, void *value) { switch (type) { case INTEGER : case FLOAT : case SYMBOL : case STRING : #if OBJECT_SYSTEM case INSTANCE_NAME : #endif if (((SYMBOL_HN *) value)->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) { ((SYMBOL_HN *) value)->depth = EvaluationData(theEnv)->CurrentEvaluationDepth; } break; #if OBJECT_SYSTEM case INSTANCE_ADDRESS : if (((INSTANCE_TYPE *) value)->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) { ((INSTANCE_TYPE *) value)->depth = EvaluationData(theEnv)->CurrentEvaluationDepth; } break; #endif case FACT_ADDRESS : if (((int) ((struct fact *) value)->depth) > EvaluationData(theEnv)->CurrentEvaluationDepth) { ((struct fact *) value)->depth = (unsigned) EvaluationData(theEnv)->CurrentEvaluationDepth; } break; } } #if DEFFUNCTION_CONSTRUCT || DEFGENERIC_CONSTRUCT /********************************************/ /* EnvFunctionCall: Allows Deffunctions and */ /* Generic Functions to be called from C. */ /* Allows only constants as arguments. */ /********************************************/ globle int EnvFunctionCall( void *theEnv, char *name, char *args, DATA_OBJECT *result) { FUNCTION_REFERENCE theReference; /*=======================================*/ /* Call the function if it can be found. */ /*=======================================*/ if (GetFunctionReference(theEnv,name,&theReference)) { return(FunctionCall2(theEnv,&theReference,args,result)); } /*=========================================================*/ /* Otherwise signal an error if a deffunction, defgeneric, */ /* or user defined function doesn't exist that matches */ /* the specified function name. */ /*=========================================================*/ PrintErrorID(theEnv,"EVALUATN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"No function, generic function or deffunction of name "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR," exists for external call.\n"); return(TRUE); } /********************************************/ /* FunctionCall2: Allows Deffunctions and */ /* Generic Functions to be called from C. */ /* Allows only constants as arguments. */ /********************************************/ globle int FunctionCall2( void *theEnv, FUNCTION_REFERENCE *theReference, char *args, DATA_OBJECT *result) { EXPRESSION *argexps; int error = FALSE; /*=============================================*/ /* Force periodic cleanup if the function call */ /* was executed from an embedded application. */ /*=============================================*/ if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } /*========================*/ /* Reset the error state. */ /*========================*/ if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE); EvaluationData(theEnv)->EvaluationError = FALSE; /*======================================*/ /* Initialize the default return value. */ /*======================================*/ result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); /*============================*/ /* Parse the argument string. */ /*============================*/ argexps = ParseConstantArguments(theEnv,args,&error); if (error == TRUE) return(TRUE); /*====================*/ /* Call the function. */ /*====================*/ theReference->argList = argexps; error = EvaluateExpression(theEnv,theReference,result); /*========================*/ /* Return the expression. */ /*========================*/ ReturnExpression(theEnv,argexps); theReference->argList = NULL; /*==========================*/ /* Return the error status. */ /*==========================*/ return(error); } #endif /***************************************************/ /* CopyDataObject: Copies the values from a source */ /* DATA_OBJECT to a destination DATA_OBJECT. */ /***************************************************/ globle void CopyDataObject( void *theEnv, DATA_OBJECT *dst, DATA_OBJECT *src, int garbageMultifield) { if (src->type != MULTIFIELD) { dst->type = src->type; dst->value = src->value; } else { DuplicateMultifield(theEnv,dst,src); if (garbageMultifield) { AddToMultifieldList(theEnv,(struct multifield *) dst->value); } } } /***********************************************/ /* TransferDataObjectValues: Copies the values */ /* directly from a source DATA_OBJECT to a */ /* destination DATA_OBJECT. */ /***********************************************/ globle void TransferDataObjectValues( DATA_OBJECT *dst, DATA_OBJECT *src) { dst->type = src->type; dst->value = src->value; dst->begin = src->begin; dst->end = src->end; dst->supplementalInfo = src->supplementalInfo; dst->next = src->next; } /************************************************************************/ /* ConvertValueToExpression: Converts the value stored in a data object */ /* into an expression. For multifield values, a chain of expressions */ /* is generated and the chain is linked by the nextArg field. For a */ /* single field value, a single expression is created. */ /************************************************************************/ globle struct expr *ConvertValueToExpression( void *theEnv, DATA_OBJECT *theValue) { long i; struct expr *head = NULL, *last = NULL, *newItem; if (GetpType(theValue) != MULTIFIELD) { return(GenConstant(theEnv,GetpType(theValue),GetpValue(theValue))); } for (i = GetpDOBegin(theValue); i <= GetpDOEnd(theValue); i++) { newItem = GenConstant(theEnv,GetMFType(GetpValue(theValue),i), GetMFValue(GetpValue(theValue),i)); if (last == NULL) head = newItem; else last->nextArg = newItem; last = newItem; } if (head == NULL) return(GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"))); return(head); } /****************************************/ /* GetAtomicHashValue: Returns the hash */ /* value for an atomic data type. */ /****************************************/ unsigned int GetAtomicHashValue( unsigned short type, void *value, int position) { unsigned int tvalue; union { double fv; unsigned int liv; } fis; switch (type) { case FLOAT: fis.fv = ValueToDouble(value); tvalue = fis.liv; break; case INTEGER: tvalue = (unsigned int) ValueToLong(value); break; case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif case EXTERNAL_ADDRESS: tvalue = (unsigned int) value; break; case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif case SYMBOL: tvalue = ((SYMBOL_HN *) value)->bucket; break; default: tvalue = type; } if (position < 0) return(tvalue); return((unsigned int) (tvalue * (position + 29))); } /***********************************************************/ /* FunctionReferenceExpression: Returns an expression with */ /* an appropriate expression reference to the specified */ /* name if it is the name of a deffunction, defgeneric, */ /* or user/system defined function. */ /***********************************************************/ globle struct expr *FunctionReferenceExpression( void *theEnv, char *name) { #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif struct FunctionDefinition *fptr; /*=====================================================*/ /* Check to see if the function call is a deffunction. */ /*=====================================================*/ #if DEFFUNCTION_CONSTRUCT if ((dptr = (void *) LookupDeffunctionInScope(theEnv,name)) != NULL) { return(GenConstant(theEnv,PCALL,dptr)); } #endif /*====================================================*/ /* Check to see if the function call is a defgeneric. */ /*====================================================*/ #if DEFGENERIC_CONSTRUCT if ((gfunc = (void *) LookupDefgenericInScope(theEnv,name)) != NULL) { return(GenConstant(theEnv,GCALL,gfunc)); } #endif /*======================================*/ /* Check to see if the function call is */ /* a system or user defined function. */ /*======================================*/ if ((fptr = FindFunction(theEnv,name)) != NULL) { return(GenConstant(theEnv,FCALL,fptr)); } /*===================================================*/ /* The specified function name is not a deffunction, */ /* defgeneric, or user/system defined function. */ /*===================================================*/ return(NULL); } /******************************************************************/ /* GetFunctionReference: Fills an expression with an appropriate */ /* expression reference to the specified name if it is the */ /* name of a deffunction, defgeneric, or user/system defined */ /* function. */ /******************************************************************/ globle intBool GetFunctionReference( void *theEnv, char *name, FUNCTION_REFERENCE *theReference) { #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif struct FunctionDefinition *fptr; theReference->nextArg = NULL; theReference->argList = NULL; theReference->type = RVOID; theReference->value = NULL; /*=====================================================*/ /* Check to see if the function call is a deffunction. */ /*=====================================================*/ #if DEFFUNCTION_CONSTRUCT if ((dptr = (void *) LookupDeffunctionInScope(theEnv,name)) != NULL) { theReference->type = PCALL; theReference->value = dptr; return(TRUE); } #endif /*====================================================*/ /* Check to see if the function call is a defgeneric. */ /*====================================================*/ #if DEFGENERIC_CONSTRUCT if ((gfunc = (void *) LookupDefgenericInScope(theEnv,name)) != NULL) { theReference->type = GCALL; theReference->value = gfunc; return(TRUE); } #endif /*======================================*/ /* Check to see if the function call is */ /* a system or user defined function. */ /*======================================*/ if ((fptr = FindFunction(theEnv,name)) != NULL) { theReference->type = FCALL; theReference->value = fptr; return(TRUE); } /*===================================================*/ /* The specified function name is not a deffunction, */ /* defgeneric, or user/system defined function. */ /*===================================================*/ return(FALSE); } /*******************************************************/ /* DOsEqual: Determines if two DATA_OBJECTS are equal. */ /*******************************************************/ globle intBool DOsEqual( DATA_OBJECT_PTR dobj1, DATA_OBJECT_PTR dobj2) { if (GetpType(dobj1) != GetpType(dobj2)) { return(FALSE); } if (GetpType(dobj1) == MULTIFIELD) { if (MultifieldDOsEqual(dobj1,dobj2) == FALSE) { return(FALSE); } } else if (GetpValue(dobj1) != GetpValue(dobj2)) { return(FALSE); } return(TRUE); } /*********************************************************** NAME : EvaluateAndStoreInDataObject DESCRIPTION : Evaluates slot-value expressions and stores the result in a Kernel data object INPUTS : 1) Flag indicating if multifields are OK 2) The value-expression 3) The data object structure 4) Flag indicating if a multifield value should be placed on the garbage list. RETURNS : FALSE on errors, TRUE otherwise SIDE EFFECTS : Segment allocated for storing multifield values NOTES : None ***********************************************************/ globle int EvaluateAndStoreInDataObject( void *theEnv, int mfp, EXPRESSION *theExp, DATA_OBJECT *val, int garbageSegment) { val->type = MULTIFIELD; val->begin = 0; val->end = -1; if (theExp == NULL) { if (garbageSegment) val->value = EnvCreateMultifield(theEnv,0L); else val->value = CreateMultifield2(theEnv,0L); return(TRUE); } if ((mfp == 0) && (theExp->nextArg == NULL)) EvaluateExpression(theEnv,theExp,val); else StoreInMultifield(theEnv,val,theExp,garbageSegment); return(EvaluationData(theEnv)->EvaluationError ? FALSE : TRUE); } clips-6.24/clipssrc/rulelhs.c0000755000175000017500000011727610056713263014375 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* DEFRULE LHS PARSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Coordinates parsing of the LHS conditional */ /* elements of a rule. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _RULELHS_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "agenda.h" #include "argacces.h" #include "constant.h" #include "constrct.h" #include "constrnt.h" #include "cstrnchk.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "pattern.h" #include "reorder.h" #include "router.h" #include "ruledef.h" #include "scanner.h" #include "symbol.h" #include "rulelhs.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct lhsParseNode *RuleBodyParse(void *,char *,struct token *,char *,int *); static void DeclarationParse(void *,char *,char *,int *); static struct lhsParseNode *LHSPattern(void *,char *,int,char *,int *,int, struct token *,char *); static struct lhsParseNode *ConnectedPatternParse(void *,char *,struct token *,int *); static struct lhsParseNode *GroupPatterns(void *,char *,int,char *,int *); static struct lhsParseNode *TestPattern(void *,char *,int *); static struct lhsParseNode *AssignmentParse(void *,char *,SYMBOL_HN *,int *); static void TagLHSLogicalNodes(struct lhsParseNode *); static struct lhsParseNode *SimplePatternParse(void *,char *,struct token *,int *); static void ParseSalience(void *,char *,char *,int *); static void ParseAutoFocus(void *,char *,int *); /*******************************************************************/ /* ParseRuleLHS: Coordinates all the actions necessary for parsing */ /* the LHS of a rule including the reordering of pattern */ /* conditional elements to conform with the KB Rete topology. */ /*******************************************************************/ globle struct lhsParseNode *ParseRuleLHS( void *theEnv, char *readSource, struct token *theToken, char *ruleName) { struct lhsParseNode *theLHS; int result; int error = FALSE; /*========================================*/ /* Initialize salience parsing variables. */ /*========================================*/ PatternData(theEnv)->GlobalSalience = 0; PatternData(theEnv)->GlobalAutoFocus = FALSE; PatternData(theEnv)->SalienceExpression = NULL; /*============================*/ /* Set the indentation depth. */ /*============================*/ SetIndentDepth(theEnv,3); /*=====================================================*/ /* Get the raw representation for the LHS of the rule. */ /*=====================================================*/ theLHS = RuleBodyParse(theEnv,readSource,theToken,ruleName,&error); if (error) return(NULL); /*====================================================*/ /* Reorder the raw representation so that it consists */ /* of at most a single top level OR CE containing one */ /* or more AND CEs. */ /*====================================================*/ theLHS = ReorderPatterns(theEnv,theLHS,&result); /*================================*/ /* Return the LHS representation. */ /*================================*/ return(theLHS); } /*********************************************************/ /* RuleBodyParse: Parses the LHS of a rule, but does not */ /* reorder any of the LHS patterns to conform with the */ /* KB Rete Topology. */ /* */ /* ::= [] */ /* * */ /* => */ /*********************************************************/ static struct lhsParseNode *RuleBodyParse( void *theEnv, char *readSource, struct token *theToken, char *ruleName, int *error) { struct lhsParseNode *theNode, *otherNodes; /*=============================*/ /* Set the error return value. */ /*=============================*/ *error = FALSE; /*==================================================*/ /* If we're already at the separator, "=>", between */ /* the LHS and RHS, then the LHS is empty. */ /*==================================================*/ if ((theToken->type == SYMBOL) ? (strcmp(ValueToString(theToken->value),"=>") == 0) : FALSE) { return(NULL); } /*===========================================*/ /* Parse the first pattern as a special case */ /* (the declare statement is allowed). */ /*===========================================*/ theNode = LHSPattern(theEnv,readSource,SYMBOL,"=>",error,TRUE,theToken,ruleName); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } PPCRAndIndent(theEnv); /*======================================*/ /* Parse the other patterns in the LHS. */ /*======================================*/ otherNodes = GroupPatterns(theEnv,readSource,SYMBOL,"=>",error); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*================================================*/ /* Construct the final LHS by combining the first */ /* pattern with the remaining patterns. */ /*================================================*/ if (theNode == NULL) { theNode = otherNodes; } else { theNode->bottom = otherNodes; } /*=======================*/ /* Return the final LHS. */ /*=======================*/ return(theNode); } /********************************************************/ /* DeclarationParse: Parses a defrule declaration. */ /* */ /* ::= (declare +) */ /* */ /* ::= (salience ) */ /* ::= (auto-focus TRUE | FALSE) */ /********************************************************/ static void DeclarationParse( void *theEnv, char *readSource, char *ruleName, int *error) { struct token theToken; struct expr *packPtr; int notDone = TRUE; int salienceParsed = FALSE, autoFocusParsed = FALSE; /*===========================*/ /* Next token must be a '('. */ /*===========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; return; } /*==========================================*/ /* Continue parsing until there are no more */ /* valid rule property declarations. */ /*==========================================*/ while (notDone) { /*=============================================*/ /* The name of a rule property must be symbol. */ /*=============================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; } /*==============================================*/ /* Parse a salience declaration if encountered. */ /*==============================================*/ else if (strcmp(ValueToString(theToken.value),"salience") == 0) { if (salienceParsed) { AlreadyParsedErrorMessage(theEnv,"salience declaration",NULL); *error = TRUE; } else { ParseSalience(theEnv,readSource,ruleName,error); salienceParsed = TRUE; } } /*=================================================*/ /* Parse an auto-focus declaration if encountered. */ /* A global flag is used to indicate if the */ /* auto-focus feature for a rule was parsed. */ /*=================================================*/ else if (strcmp(ValueToString(theToken.value),"auto-focus") == 0) { if (autoFocusParsed) { AlreadyParsedErrorMessage(theEnv,"auto-focus declaration",NULL); *error = TRUE; } else { ParseAutoFocus(theEnv,readSource,error); autoFocusParsed = TRUE; } } /*==========================================*/ /* Otherwise the symbol does not correspond */ /* to a valid rule property. */ /*==========================================*/ else { SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; } /*=====================================*/ /* Return if an error was encountered. */ /*=====================================*/ if (*error) { ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; return; } /*=======================================*/ /* Both the salience and auto-focus rule */ /* properties are closed with a ')'. */ /*=======================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; return; } /*=============================================*/ /* The declare statement is closed with a ')'. */ /*=============================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type == RPAREN) notDone = FALSE; else if (theToken.type != LPAREN) { ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; SyntaxErrorMessage(theEnv,"declare statement"); *error = TRUE; return; } else { PPBackup(theEnv); SavePPBuffer(theEnv," ("); } } /*==========================================*/ /* Return the value of the salience through */ /* the global variable SalienceExpression. */ /*==========================================*/ packPtr = PackExpression(theEnv,PatternData(theEnv)->SalienceExpression); ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = packPtr; return; } /************************************************************/ /* ParseSalience: Parses the rest of a defrule salience */ /* declaration once the salience keyword has been parsed. */ /************************************************************/ static void ParseSalience( void *theEnv, char *readSource, char *ruleName, int *error) { int salience; DATA_OBJECT salienceValue; /*==============================*/ /* Get the salience expression. */ /*==============================*/ SavePPBuffer(theEnv," "); PatternData(theEnv)->SalienceExpression = ParseAtomOrExpression(theEnv,readSource,NULL); if (PatternData(theEnv)->SalienceExpression == NULL) { *error = TRUE; return; } /*============================================================*/ /* Evaluate the expression and determine if it is an integer. */ /*============================================================*/ SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,PatternData(theEnv)->SalienceExpression,&salienceValue)) { SalienceInformationError(theEnv,"defrule",ruleName); *error = TRUE; return; } if (salienceValue.type != INTEGER) { SalienceNonIntegerError(theEnv); *error = TRUE; return; } /*=======================================================*/ /* Salience number must be in the range -10000 to 10000. */ /*=======================================================*/ salience = (int) ValueToLong(salienceValue.value); if ((salience > MAX_DEFRULE_SALIENCE) || (salience < MIN_DEFRULE_SALIENCE)) { SalienceRangeError(theEnv,MIN_DEFRULE_SALIENCE,MAX_DEFRULE_SALIENCE); *error = TRUE; return; } /*==========================================*/ /* If the expression is a constant integer, */ /* don't bother storing the expression. */ /*==========================================*/ if (PatternData(theEnv)->SalienceExpression->type == INTEGER) { ReturnExpression(theEnv,PatternData(theEnv)->SalienceExpression); PatternData(theEnv)->SalienceExpression = NULL; } PatternData(theEnv)->GlobalSalience = salience; } /**************************************************************/ /* ParseAutoFocus: Parses the rest of a defrule auto-focus */ /* declaration once the auto-focus keyword has been parsed. */ /**************************************************************/ static void ParseAutoFocus( void *theEnv, char *readSource, int *error) { struct token theToken; /*========================================*/ /* The auto-focus value must be a symbol. */ /*========================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"auto-focus statement"); *error = TRUE; return; } /*====================================================*/ /* The auto-focus value must be either TRUE or FALSE. */ /* If a valid value is parsed, then set the value of */ /* the global variable GlobalAutoFocus. */ /*====================================================*/ if (strcmp(ValueToString(theToken.value),"TRUE") == 0) { PatternData(theEnv)->GlobalAutoFocus = TRUE; } else if (strcmp(ValueToString(theToken.value),"FALSE") == 0) { PatternData(theEnv)->GlobalAutoFocus = FALSE; } else { SyntaxErrorMessage(theEnv,"auto-focus statement"); *error = TRUE; } } /*****************************************************************/ /* LHSPattern: Parses a single conditional element found on the */ /* LHS of a rule. Conditonal element types include pattern CEs */ /* (which may be assigned to a variable), test CEs, not CEs, */ /* logical CEs, and CEs, and or CEs. */ /* */ /* ::= | */ /* | */ /* | | | */ /* | | */ /* | */ /*****************************************************************/ static struct lhsParseNode *LHSPattern( void *theEnv, char *readSource, int terminator, char *terminatorString, int *error, int allowDeclaration, struct token *firstToken, char *ruleName) { struct token theToken; struct lhsParseNode *theNode; /*=========================================================*/ /* Check to see if the first token has already been read. */ /* This should only occur for the first pattern in a rule. */ /*=========================================================*/ if (firstToken == NULL) GetToken(theEnv,readSource,&theToken); else CopyToken(&theToken,firstToken); /*=====================================================*/ /* A left parenthesis begins all CEs and declarations. */ /*=====================================================*/ if (theToken.type == LPAREN) { /*================================================*/ /* The first field of a pattern must be a symbol. */ /*================================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"the first field of a pattern"); *error = TRUE; return(NULL); } /*====================================*/ /* If this is the first CE of a rule, */ /* then a declare statement is valid. */ /*====================================*/ if (allowDeclaration && (strcmp(ValueToString(theToken.value),"declare") == 0)) { if (ruleName == NULL) SystemError(theEnv,"RULELHS",1); DeclarationParse(theEnv,readSource,ruleName,error); theNode = NULL; } /*==================================*/ /* Otherwise check for a *test* CE. */ /*==================================*/ else if (strcmp(ValueToString(theToken.value),"test") == 0) { theNode = TestPattern(theEnv,readSource,error); } /*============================================*/ /* Otherwise check for an *and*, *or*, *not*, */ /* *logical*, *exists*, or *forall* CE. */ /*============================================*/ else if ((strcmp(ValueToString(theToken.value),"and") == 0) || (strcmp(ValueToString(theToken.value),"logical") == 0) || (strcmp(ValueToString(theToken.value),"not") == 0) || (strcmp(ValueToString(theToken.value),"exists") == 0) || (strcmp(ValueToString(theToken.value),"forall") == 0) || (strcmp(ValueToString(theToken.value),"or") == 0)) { theNode = ConnectedPatternParse(theEnv,readSource,&theToken,error); } /*=================================*/ /* Otherwise parse a *pattern* CE. */ /*=================================*/ else { theNode = SimplePatternParse(theEnv,readSource,&theToken,error); } } /*=======================================*/ /* Check for a pattern address variable. */ /*=======================================*/ else if (theToken.type == SF_VARIABLE) { theNode = AssignmentParse(theEnv,readSource,(SYMBOL_HN *) theToken.value,error); } /*=================================================*/ /* Check for the group terminator (either a "=>" */ /* separating the LHS from the RHS or a ")" ending */ /* a CE containing other CEs such as an *and* CE). */ /*=================================================*/ else if ((theToken.type == terminator) ? (strcmp(theToken.printForm,terminatorString) == 0) : FALSE) { return(NULL); } /*====================================*/ /* Otherwise invalid syntax was used. */ /*====================================*/ else { SyntaxErrorMessage(theEnv,"defrule"); *error = TRUE; return(NULL); } /*================================*/ /* If an error occurred, free any */ /* allocated data structures. */ /*================================*/ if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*=========================*/ /* Return the LHS pattern. */ /*=========================*/ return(theNode); } /*********************************************************************/ /* ConnectedPatternParse: Handles parsing of the connected */ /* conditional elements (i.e. those conditional elements that may */ /* contain one or more other conditional elements). The connected */ /* conditional elements include the *and*, *or*, *not*, *logical*, */ /* *exists*, and *forall* CEs. This routine is entered with the */ /* parsing pointing to the name of the connected CE. It is exited */ /* with the parser pointing to the closing right parenthesis of */ /* the connected CE. */ /* */ /* ::= (and +) */ /* */ /* ::= (or +) */ /* */ /* ::= (logical +) */ /* */ /* ::= (not ) */ /* */ /* ::= (exists +) */ /* */ /* ::= (forall */ /* +) */ /*********************************************************************/ static struct lhsParseNode *ConnectedPatternParse( void *theEnv, char *readSource, struct token *theToken, int *error) { unsigned short connectorValue = 0; struct lhsParseNode *theNode, *tempNode, *theGroup; char *errorCE = NULL; int logical = FALSE; int tempValue; /*==========================================================*/ /* Use appropriate spacing for pretty printing of the rule. */ /*==========================================================*/ IncrementIndentDepth(theEnv,5); if (strcmp(ValueToString(theToken->value),"or") == 0) { connectorValue = OR_CE; errorCE = "the or conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"and") == 0) { connectorValue = AND_CE; errorCE = "the and conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"not") == 0) { connectorValue = NOT_CE; errorCE = "the not conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"exists") == 0) { connectorValue = EXISTS_CE; errorCE = "the exists conditional element"; PPCRAndIndent(theEnv); } else if (strcmp(ValueToString(theToken->value),"forall") == 0) { connectorValue = FORALL_CE; errorCE = "the forall conditional element"; PPCRAndIndent(theEnv); } else if (strcmp(ValueToString(theToken->value),"logical") == 0) { connectorValue = AND_CE; errorCE = "the logical conditional element"; logical = TRUE; PPCRAndIndent(theEnv); } /*=====================================================*/ /* The logical CE cannot be contained within a not CE. */ /*=====================================================*/ if (PatternData(theEnv)->WithinNotCE && logical) { PrintErrorID(theEnv,"RULELHS",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The logical CE cannot be used within a not/exists/forall CE.\n"); *error = TRUE; return(NULL); } /*=====================================================*/ /* Remember if we're currently within a *not* CE and */ /* then check to see if we're entering a new *not* CE. */ /*=====================================================*/ tempValue = PatternData(theEnv)->WithinNotCE; if ((connectorValue == NOT_CE) || (connectorValue == EXISTS_CE) || (connectorValue == FORALL_CE)) { PatternData(theEnv)->WithinNotCE = TRUE; } /*===========================================*/ /* Parse all of the CEs contained with the */ /* CE. A ) will terminate the end of the CE. */ /*===========================================*/ theGroup = GroupPatterns(theEnv,readSource,RPAREN,")",error); /*====================================*/ /* Restore the "with a *not* CE" flag */ /* and reset the indentation depth. */ /*====================================*/ PatternData(theEnv)->WithinNotCE = tempValue; DecrementIndentDepth(theEnv,5); /*============================================*/ /* If an error occured while parsing, return. */ /*============================================*/ if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theGroup); return(NULL); } /*=========================================================*/ /* If we parsed a *logical* CE, then mark the logical flag */ /* for all of the CEs contained within the logical CE. */ /*=========================================================*/ if (logical) TagLHSLogicalNodes(theGroup); /*=====================================================*/ /* All the connected CEs must contain at least one CE. */ /*=====================================================*/ if (theGroup == NULL) { SyntaxErrorMessage(theEnv,errorCE); *error = TRUE; return(NULL); } /*============================================*/ /* A not CE may not contain more than one CE. */ /*============================================*/ if ((connectorValue == NOT_CE) && (theGroup->bottom != NULL)) { SyntaxErrorMessage(theEnv,errorCE); ReturnLHSParseNodes(theEnv,theGroup); *error = TRUE; return(NULL); } /*============================================*/ /* A forall CE must contain at least two CEs. */ /*============================================*/ if ((connectorValue == FORALL_CE) && (theGroup->bottom == NULL)) { SyntaxErrorMessage(theEnv,errorCE); ReturnLHSParseNodes(theEnv,theGroup); *error = TRUE; return(NULL); } /*========================================================*/ /* Remove an "and" and "or" CE that only contains one CE. */ /*========================================================*/ if (((connectorValue == AND_CE) || (connectorValue == OR_CE)) && (theGroup->bottom == NULL)) { theGroup->logical = logical; return(theGroup); } /*===========================================================*/ /* Create the top most node which connects the CEs together. */ /*===========================================================*/ theNode = GetLHSParseNode(theEnv); theNode->logical = logical; /*======================================================*/ /* Attach and/or/not CEs directly to the top most node. */ /*======================================================*/ if ((connectorValue == AND_CE) || (connectorValue == OR_CE) || (connectorValue == NOT_CE)) { theNode->type = connectorValue; theNode->right = theGroup; } /*=================================================================*/ /* Wrap two not CEs around the patterns contained in an exists CE. */ /*=================================================================*/ else if (connectorValue == EXISTS_CE) { theNode->type = NOT_CE; theNode->right = GetLHSParseNode(theEnv); theNode->right->type = NOT_CE; theNode->right->logical = logical; if (theGroup->bottom != NULL) { theNode->right->right = GetLHSParseNode(theEnv); theNode->right->right->type = AND_CE; theNode->right->right->logical = logical; theNode->right->right->right = theGroup; } else { theNode->right->right = theGroup; } } /*==================================================*/ /* For a forall CE, wrap a not CE around all of the */ /* CEs and a not CE around the 2nd through nth CEs. */ /*==================================================*/ else if (connectorValue == FORALL_CE) { theNode->type = NOT_CE; tempNode = theGroup->bottom; theGroup->bottom = NULL; theNode->right = GetLHSParseNode(theEnv); theNode->right->type = AND_CE; theNode->right->logical = logical; theNode->right->right = theGroup; theGroup = tempNode; theNode->right->right->bottom = GetLHSParseNode(theEnv); theNode->right->right->bottom->type = NOT_CE; theNode->right->right->bottom->logical = logical; tempNode = theNode->right->right->bottom; if (theGroup->bottom == NULL) { tempNode->right = theGroup; } else { tempNode->right = GetLHSParseNode(theEnv); tempNode->right->type = AND_CE; tempNode->right->logical = logical; tempNode->right->right = theGroup; } } /*================*/ /* Return the CE. */ /*================*/ return(theNode); } /***********************************************/ /* GroupPatterns: Groups a series of connected */ /* conditional elements together. */ /***********************************************/ static struct lhsParseNode *GroupPatterns( void *theEnv, char *readSource, int terminator, char *terminatorString, int *error) { struct lhsParseNode *lastNode, *newNode, *theNode; lastNode = theNode = NULL; while (TRUE) { /*==================*/ /* Get the next CE. */ /*==================*/ newNode = LHSPattern(theEnv,readSource,terminator,terminatorString, error,FALSE,NULL,NULL); /*=======================================================*/ /* If an error occurred, release any LHS data structures */ /* previously allocated by this routine. */ /*=======================================================*/ if (*error) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*===============================================*/ /* A NULL value for the CE just parsed indicates */ /* that the terminator for the group of patterns */ /* was encountered (either a "=>" or a ")". */ /*===============================================*/ if (newNode == NULL) { PPBackup(theEnv); PPBackup(theEnv); if (terminator == RPAREN) { SavePPBuffer(theEnv,terminatorString); } else { PPCRAndIndent(theEnv); SavePPBuffer(theEnv,terminatorString); } return(theNode); } /*============================*/ /* Add the new CE to the list */ /* of CEs being grouped. */ /*============================*/ if (lastNode == NULL) { theNode = newNode; } else { lastNode->bottom = newNode; } lastNode = newNode; /*======================================*/ /* Fix the pretty print representation. */ /*======================================*/ PPCRAndIndent(theEnv); } } /**************************************************************/ /* TestPattern: Handles parsing of test conditional elements. */ /* */ /* ::= (test ) */ /**************************************************************/ static struct lhsParseNode *TestPattern( void *theEnv, char *readSource, int *error) { struct lhsParseNode *theNode; struct token theToken; struct expr *theExpression; /*================================================*/ /* Create the data specification for the test CE. */ /*================================================*/ SavePPBuffer(theEnv," "); theNode = GetLHSParseNode(theEnv); theNode->type = TEST_CE; theExpression = Function0Parse(theEnv,readSource); theNode->expression = ExpressionToLHSParseNodes(theEnv,theExpression); ReturnExpression(theEnv,theExpression); if (theNode->expression == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*=========================================================*/ /* Check for the closing right parenthesis of the test CE. */ /*=========================================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"test conditional element"); *error = TRUE; ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*=====================*/ /* Return the test CE. */ /*=====================*/ return(theNode); } /****************************************************************/ /* AssignmentParse: Finishes the parsing of pattern conditional */ /* elements that have been bound to a variable. */ /* */ /* ::= ? <- */ /****************************************************************/ static struct lhsParseNode *AssignmentParse( void *theEnv, char *readSource, SYMBOL_HN *factAddress, int *error) { struct lhsParseNode *theNode; struct token theToken; /*=====================================================*/ /* Patterns cannot be bound if they are with a not CE. */ /*=====================================================*/ if (PatternData(theEnv)->WithinNotCE) { PrintErrorID(theEnv,"RULELHS",2,TRUE); EnvPrintRouter(theEnv,WERROR,"A pattern CE cannot be bound to a pattern-address within a not CE\n"); *error = TRUE; return(NULL); } /*===============================================*/ /* Check for binder token, "<-", after variable. */ /*===============================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&theToken); if ((theToken.type == SYMBOL) ? (strcmp(ValueToString(theToken.value),"<-") != 0) : TRUE) { SyntaxErrorMessage(theEnv,"binding patterns"); *error = TRUE; return(NULL); } SavePPBuffer(theEnv," "); /*================================================*/ /* Check for opening left parenthesis of pattern. */ /*================================================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"binding patterns"); *error = TRUE; return(NULL); } /*======================================================*/ /* Parse the pattern and return the data specification. */ /*======================================================*/ GetToken(theEnv,readSource,&theToken); theNode = SimplePatternParse(theEnv,readSource,&theToken,error); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*=============================================*/ /* Store the name of the variable to which the */ /* pattern is bound and return the pattern. */ /*=============================================*/ theNode->value = (void *) factAddress; return(theNode); } /************************************************************/ /* TagLHSLogicalNodes: Marks all *and*, *or*, and *not* CEs */ /* contained within a logical CE as having the properties */ /* associated with a logical CE. */ /************************************************************/ static void TagLHSLogicalNodes( struct lhsParseNode *nodePtr) { while (nodePtr != NULL) { nodePtr->logical = TRUE; if ((nodePtr->type == AND_CE) || (nodePtr->type == OR_CE) || (nodePtr->type == NOT_CE)) { TagLHSLogicalNodes(nodePtr->right); } nodePtr = nodePtr->bottom; } } /***********************************************************/ /* SimplePatternParse: Parses a simple pattern (an opening */ /* parenthesis followed by one or more fields followed */ /* by a closing parenthesis). */ /* */ /* ::= | */ /* */ /***********************************************************/ static struct lhsParseNode *SimplePatternParse( void *theEnv, char *readSource, struct token *theToken, int *error) { struct lhsParseNode *theNode; struct patternParser *tempParser; /*=================================================*/ /* The first field of a pattern must be a symbol. */ /* In addition, the symbols ":" and "=" can not */ /* be used because they have special significance. */ /*=================================================*/ if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"the first field of a pattern"); *error = TRUE; return(NULL); } else if ((strcmp(ValueToString(theToken->value),"=") == 0) || (strcmp(ValueToString(theToken->value),":") == 0)) { SyntaxErrorMessage(theEnv,"the field field of a pattern"); *error = TRUE; return(NULL); } /*===============================================*/ /* Construct the topmost node of the pattern CE. */ /*===============================================*/ theNode = GetLHSParseNode(theEnv); theNode->type = PATTERN_CE; theNode->negated = FALSE; /*======================================================*/ /* Search for a pattern parser that claims the pattern. */ /*======================================================*/ for (tempParser = PatternData(theEnv)->ListOfPatternParsers; tempParser != NULL; tempParser = tempParser->next) { if ((*tempParser->recognizeFunction)((SYMBOL_HN *) theToken->value)) { theNode->patternType = tempParser; theNode->right = (*tempParser->parseFunction)(theEnv,readSource,theToken); if (theNode->right == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,theNode); return(NULL); } PropagatePatternType(theNode,tempParser); return(theNode); } } /*=================================*/ /* If a pattern parser couldn't be */ /* found, then signal an error. */ /*=================================*/ *error = TRUE; SyntaxErrorMessage(theEnv,"the field field of a pattern"); ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /**************************************************************/ /* PropagatePatternType: Sets the selfPattern field for all */ /* lhsParseNodes in a linked list of those data structures. */ /**************************************************************/ globle void PropagatePatternType( struct lhsParseNode *theLHS, struct patternParser *theParser) { while (theLHS != NULL) { theLHS->patternType = theParser; if (theLHS->right != NULL) PropagatePatternType(theLHS->right,theParser); if (theLHS->expression != NULL) PropagatePatternType(theLHS->expression,theParser); theLHS = theLHS->bottom; } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/dfinscmp.h0000755000175000017500000000303307422634756014524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Definstances Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_dfinscmp #define _H_dfinscmp #if DEFINSTANCES_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DFINSCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupDefinstancesCompiler(void *); LOCALE void DefinstancesCModuleReference(void *,FILE *,int,int,int); #endif #endif clips-6.24/clipssrc/tmpltcmp.c0000755000175000017500000003412510177533462014553 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.23 01/31/05 */ /* */ /* DEFTEMPLATE CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* deftemplate construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /*************************************************************/ #define _TMPLTCMP_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #define SlotPrefix() ArbitraryPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem,2) #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "factcmp.h" #include "cstrncmp.h" #include "tmpltdef.h" #include "envrnmnt.h" #include "tmpltcmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,char *,int,FILE *,int,int); static void SlotToCode(void *,FILE *,struct templateSlot *,int,int,int); static void DeftemplateModuleToCode(void *,FILE *,struct defmodule *,int,int,int); static void DeftemplateToCode(void *,FILE *,struct deftemplate *, int,int,int,int); static void CloseDeftemplateFiles(void *,FILE *,FILE *,FILE *,int); /*********************************************************/ /* DeftemplateCompilerSetup: Initializes the deftemplate */ /* construct for use with the constructs-to-c command. */ /*********************************************************/ globle void DeftemplateCompilerSetup( void *theEnv) { DeftemplateData(theEnv)->DeftemplateCodeItem = AddCodeGeneratorItem(theEnv,"deftemplate",0,NULL,NULL,ConstructToCode,3); } /*************************************************************/ /* ConstructToCode: Produces deftemplate code for a run-time */ /* module created using the constructs-to-c function. */ /*************************************************************/ static int ConstructToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct deftemplate *theTemplate; struct templateSlot *slotPtr; int slotCount = 0, slotArrayCount = 0, slotArrayVersion = 1; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int templateArrayCount = 0, templateArrayVersion = 1; FILE *slotFile = NULL, *moduleFile = NULL, *templateFile = NULL; /*==================================================*/ /* Include the appropriate deftemplate header file. */ /*==================================================*/ fprintf(headerFP,"#include \"tmpltdef.h\"\n"); /*=============================================================*/ /* Loop through all the modules, all the deftemplates, and all */ /* the deftemplate slots writing their C code representation */ /* to the file as they are traversed. */ /*=============================================================*/ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "struct deftemplateModule",ModulePrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDeftemplateFiles(theEnv,moduleFile,templateFile,slotFile,maxIndices); return(0); } DeftemplateModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices,moduleCount); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); /*=======================================================*/ /* Loop through each of the deftemplates in this module. */ /*=======================================================*/ theTemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); while (theTemplate != NULL) { templateFile = OpenFileIfNeeded(theEnv,templateFile,fileName,fileID,imageID,&fileCount, templateArrayVersion,headerFP, "struct deftemplate",ConstructPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), FALSE,NULL); if (templateFile == NULL) { CloseDeftemplateFiles(theEnv,moduleFile,templateFile,slotFile,maxIndices); return(0); } DeftemplateToCode(theEnv,templateFile,theTemplate,imageID,maxIndices, moduleCount,slotCount); templateArrayCount++; templateFile = CloseFileIfNeeded(theEnv,templateFile,&templateArrayCount,&templateArrayVersion, maxIndices,NULL,NULL); /*======================================================*/ /* Loop through each of the slots for this deftemplate. */ /*======================================================*/ slotPtr = theTemplate->slotList; while (slotPtr != NULL) { slotFile = OpenFileIfNeeded(theEnv,slotFile,fileName,fileID,imageID,&fileCount, slotArrayVersion,headerFP, "struct templateSlot",SlotPrefix(),FALSE,NULL); if (slotFile == NULL) { CloseDeftemplateFiles(theEnv,moduleFile,templateFile,slotFile,maxIndices); return(0); } SlotToCode(theEnv,slotFile,slotPtr,imageID,maxIndices,slotCount); slotCount++; slotArrayCount++; slotFile = CloseFileIfNeeded(theEnv,slotFile,&slotArrayCount,&slotArrayVersion, maxIndices,NULL,NULL); slotPtr = slotPtr->next; } theTemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theTemplate); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; moduleArrayCount++; } CloseDeftemplateFiles(theEnv,moduleFile,templateFile,slotFile,maxIndices); return(1); } /************************************************************/ /* CloseDeftemplateFiles: Closes all of the C files created */ /* for deftemplates. Called when an error occurs or when */ /* the deftemplates have all been written to the files. */ /************************************************************/ static void CloseDeftemplateFiles( void *theEnv, FILE *moduleFile, FILE *templateFile, FILE *slotFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (slotFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,slotFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (templateFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,templateFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /*************************************************************/ /* DeftemplateModuleToCode: Writes the C code representation */ /* of a single deftemplate module to the specified file. */ /*************************************************************/ #if IBM_TBC #pragma argsused #endif static void DeftemplateModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int moduleCount) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(moduleCount) #endif fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DeftemplateData(theEnv)->DeftemplateModuleIndex,ConstructPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem)); fprintf(theFile,"}"); } /************************************************************/ /* DeftemplateToCode: Writes the C code representation of a */ /* single deftemplate construct to the specified file. */ /************************************************************/ static void DeftemplateToCode( void *theEnv, FILE *theFile, struct deftemplate *theTemplate, int imageID, int maxIndices, int moduleCount, int slotCount) { /*====================*/ /* Deftemplate Header */ /*====================*/ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theTemplate->header,imageID,maxIndices, moduleCount,ModulePrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), ConstructPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem)); fprintf(theFile,","); /*===========*/ /* Slot List */ /*===========*/ if (theTemplate->slotList == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%d[%d],",SlotPrefix(), imageID, (slotCount / maxIndices) + 1, slotCount % maxIndices); } /*==========================================*/ /* Implied Flag, Watch Flag, In Scope Flag, */ /* Number of Slots, and Busy Count. */ /*==========================================*/ fprintf(theFile,"%d,0,0,%d,%ld,",theTemplate->implied,theTemplate->numberOfSlots,theTemplate->busyCount); /*=================*/ /* Pattern Network */ /*=================*/ if (theTemplate->patternNetwork == NULL) { fprintf(theFile,"NULL"); } else { FactPatternNodeReference(theEnv,theTemplate->patternNetwork,theFile,imageID,maxIndices); } /*============================================*/ /* Print the factList and lastFact references */ /* and close the structure. */ /*============================================*/ fprintf(theFile,",NULL,NULL}"); } /*****************************************************/ /* SlotToCode: Writes the C code representation of a */ /* single deftemplate slot to the specified file. */ /*****************************************************/ static void SlotToCode( void *theEnv, FILE *theFile, struct templateSlot *theSlot, int imageID, int maxIndices, int slotCount) { /*===========*/ /* Slot Name */ /*===========*/ fprintf(theFile,"{"); PrintSymbolReference(theEnv,theFile,theSlot->slotName); /*=============================*/ /* Multislot and Default Flags */ /*=============================*/ fprintf(theFile,",%d,%d,%d,%d,",theSlot->multislot,theSlot->noDefault, theSlot->defaultPresent,theSlot->defaultDynamic); /*=============*/ /* Constraints */ /*=============*/ PrintConstraintReference(theEnv,theFile,theSlot->constraints,imageID,maxIndices); /*===============*/ /* Default Value */ /*===============*/ fprintf(theFile,","); PrintHashedExpressionReference(theEnv,theFile,theSlot->defaultList,imageID,maxIndices); fprintf(theFile,","); /*===========*/ /* Next Slot */ /*===========*/ if (theSlot->next == NULL) { fprintf(theFile,"NULL}"); } else { fprintf(theFile,"&%s%d_%d[%d]}",SlotPrefix(),imageID, ((slotCount+1) / maxIndices) + 1, (slotCount+1) % maxIndices); } } /*****************************************************************/ /* DeftemplateCModuleReference: Writes the C code representation */ /* of a reference to a deftemplate module data structure. */ /*****************************************************************/ globle void DeftemplateCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]",ModulePrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /********************************************************************/ /* DeftemplateCConstructReference: Writes the C code representation */ /* of a reference to a deftemplate data structure. */ /********************************************************************/ globle void DeftemplateCConstructReference( void *theEnv, FILE *theFile, void *vTheTemplate, int imageID, int maxIndices) { struct deftemplate *theTemplate = (struct deftemplate *) vTheTemplate; if (theTemplate == NULL) { fprintf(theFile,"NULL"); } else { fprintf(theFile,"&%s%d_%ld[%ld]",ConstructPrefix(DeftemplateData(theEnv)->DeftemplateCodeItem), imageID, (theTemplate->header.bsaveID / maxIndices) + 1, theTemplate->header.bsaveID % maxIndices); } } #endif /* DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */ clips-6.24/clipssrc/._tmpltlhs.h0000400000175000017500000000012207422635011014745 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._tmpltfun.c0000400000175000017500000000075410443377406014765 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco^fC^fC<TTFLvFMPSRMWBBLclips-6.24/clipssrc/._userdata.c0000400000175000017500000000012207422635016014706 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/cstrcpsr.c0000755000175000017500000005741210441602114014543 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* CONSTRUCT PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parsing routines and utilities for parsing */ /* constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Made the construct redefinition message more */ /* prominent. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /*************************************************************/ #define _CSTRCPSR_SOURCE_ #include "setup.h" #if (! RUN_TIME) && (! BLOAD_ONLY) #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "router.h" #include "watch.h" #include "constrct.h" #include "prcdrpsr.h" #include "exprnpsr.h" #include "modulutl.h" #include "modulpsr.h" #include "sysdep.h" #include "utility.h" #include "cstrcpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int FindConstructBeginning(void *,char *,struct token *,int,int *); /************************************************************/ /* EnvLoad: C access routine for the load command. Returns */ /* 0 if the file couldn't be opened, -1 if the file was */ /* opened but an error occurred while loading constructs, */ /* and 1 if the file was opened and no errors occured */ /* while loading. */ /************************************************************/ globle int EnvLoad( void *theEnv, char *fileName) { FILE *theFile; int noErrorsDetected; /*=======================================*/ /* Open the file specified by file name. */ /*=======================================*/ if ((theFile = GenOpen(theEnv,fileName,"r")) == NULL) return(0); /*===================================================*/ /* Read in the constructs. Enabling fast load allows */ /* the router system to be bypassed for quicker load */ /* times. */ /*===================================================*/ SetFastLoad(theEnv,theFile); noErrorsDetected = LoadConstructsFromLogicalName(theEnv,(char *) theFile); SetFastLoad(theEnv,NULL); /*=================*/ /* Close the file. */ /*=================*/ GenClose(theEnv,theFile); /*========================================*/ /* If no errors occurred during the load, */ /* return 1, otherwise return -1. */ /*========================================*/ if (noErrorsDetected) return(1); return(-1); } /*****************************************************************/ /* LoadConstructsFromLogicalName: Loads a set of constructs into */ /* the current environment from a specified logical name. */ /*****************************************************************/ globle int LoadConstructsFromLogicalName( void *theEnv, char *readSource) { int constructFlag; struct token theToken; int noErrors = TRUE; int foundConstruct; /*=========================================*/ /* Reset the halt execution and evaluation */ /* error flags in preparation for parsing. */ /*=========================================*/ if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); /*========================================================*/ /* Find the beginning of the first construct in the file. */ /*========================================================*/ EvaluationData(theEnv)->CurrentEvaluationDepth++; GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors); /*==================================================*/ /* Parse the file until the end of file is reached. */ /*==================================================*/ while ((foundConstruct == TRUE) && (GetHaltExecution(theEnv) == FALSE)) { /*===========================================================*/ /* Clear the pretty print buffer in preparation for parsing. */ /*===========================================================*/ FlushPPBuffer(theEnv); /*======================*/ /* Parse the construct. */ /*======================*/ constructFlag = ParseConstruct(theEnv,ValueToString(theToken.value),readSource); /*==============================================================*/ /* If an error occurred while parsing, then find the beginning */ /* of the next construct (but don't generate any more error */ /* messages--in effect, skip everything until another construct */ /* is found). */ /*==============================================================*/ if (constructFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); noErrors = FALSE; GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,TRUE,&noErrors); } /*======================================================*/ /* Otherwise, find the beginning of the next construct. */ /*======================================================*/ else { GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors); } /*=====================================================*/ /* Yield time if necessary to foreground applications. */ /*=====================================================*/ if (foundConstruct) { IncrementSymbolCount(theToken.value); } EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); YieldTime(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth++; if (foundConstruct) { DecrementSymbolCount(theEnv,(SYMBOL_HN *) theToken.value); } } EvaluationData(theEnv)->CurrentEvaluationDepth--; /*========================================================*/ /* Print a carriage return if a single character is being */ /* printed to indicate constructs are being processed. */ /*========================================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") != TRUE) && GetPrintWhileLoading(theEnv)) #else if (GetPrintWhileLoading(theEnv)) #endif { EnvPrintRouter(theEnv,WDIALOG,"\n"); } /*=============================================================*/ /* Once the load is complete, destroy the pretty print buffer. */ /* This frees up any memory that was used to create the pretty */ /* print forms for constructs during parsing. Thus calls to */ /* the mem-used function will accurately reflect the amount of */ /* memory being used after a load command. */ /*=============================================================*/ DestroyPPBuffer(theEnv); /*==========================================================*/ /* Return a boolean flag which indicates whether any errors */ /* were encountered while loading the constructs. */ /*==========================================================*/ return(noErrors); } /********************************************************************/ /* FindConstructBeginning: Searches for a left parenthesis followed */ /* by the name of a valid construct. Used by the load command to */ /* find the next construct to be parsed. Returns TRUE is the */ /* beginning of a construct was found, otherwise FALSE. */ /********************************************************************/ static int FindConstructBeginning( void *theEnv, char *readSource, struct token *theToken, int errorCorrection, int *noErrors) { int leftParenthesisFound = FALSE; int firstAttempt = TRUE; /*===================================================*/ /* Process tokens until the beginning of a construct */ /* is found or there are no more tokens. */ /*===================================================*/ while (theToken->type != STOP) { /*=====================================================*/ /* Constructs begin with a left parenthesis. Make note */ /* that the opening parenthesis has been found. */ /*=====================================================*/ if (theToken->type == LPAREN) { leftParenthesisFound = TRUE; } /*=================================================================*/ /* The name of the construct follows the opening left parenthesis. */ /* If it is the name of a valid construct, then return TRUE. */ /* Otherwise, reset the flags to look for the beginning of a */ /* construct. If error correction is being performed (i.e. the */ /* last construct parsed had an error in it), then don't bother to */ /* print an error message, otherwise, print an error message. */ /*=================================================================*/ else if ((theToken->type == SYMBOL) && (leftParenthesisFound == TRUE)) { /*===========================================================*/ /* Is this a valid construct name (e.g., defrule, deffacts). */ /*===========================================================*/ if (FindConstruct(theEnv,ValueToString(theToken->value)) != NULL) return(TRUE); /*===============================================*/ /* The construct name is invalid. Print an error */ /* message if one hasn't already been printed. */ /*===============================================*/ if (firstAttempt && (! errorCorrection)) { errorCorrection = TRUE; *noErrors = FALSE; PrintErrorID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected the beginning of a construct.\n"); } /*======================================================*/ /* Indicate that an error has been found and that we're */ /* looking for a left parenthesis again. */ /*======================================================*/ firstAttempt = FALSE; leftParenthesisFound = FALSE; } /*====================================================================*/ /* Any token encountered other than a left parenthesis or a construct */ /* name following a left parenthesis is illegal. Again, if error */ /* correction is in progress, no error message is printed, otherwise, */ /* an error message is printed. */ /*====================================================================*/ else { if (firstAttempt && (! errorCorrection)) { errorCorrection = TRUE; *noErrors = FALSE; PrintErrorID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected the beginning of a construct.\n"); } firstAttempt = FALSE; leftParenthesisFound = FALSE; } /*============================================*/ /* Move on to the next token to be processed. */ /*============================================*/ GetToken(theEnv,readSource,theToken); } /*===================================================================*/ /* Couldn't find the beginning of a construct, so FALSE is returned. */ /*===================================================================*/ return(FALSE); } /***********************************************************/ /* ParseConstruct: Parses a construct. Returns an integer. */ /* -1 if the construct name has no parsing function, 0 */ /* if the construct was parsed successfully, and 1 if */ /* the construct was parsed unsuccessfully. */ /***********************************************************/ globle int ParseConstruct( void *theEnv, char *name, char *logicalName) { struct construct *currentPtr; int rv, ov; /*=================================*/ /* Look for a valid construct name */ /* (e.g. defrule, deffacts). */ /*=================================*/ currentPtr = FindConstruct(theEnv,name); if (currentPtr == NULL) return(-1); /*==================================*/ /* Prepare the parsing environment. */ /*==================================*/ ov = GetHaltExecution(theEnv); SetEvaluationError(theEnv,FALSE); SetHaltExecution(theEnv,FALSE); ClearParsedBindNames(theEnv); PushRtnBrkContexts(theEnv); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; EvaluationData(theEnv)->CurrentEvaluationDepth++; /*=======================================*/ /* Call the construct's parsing routine. */ /*=======================================*/ rv = (*currentPtr->parseFunction)(theEnv,logicalName); /*===============================*/ /* Restore environment settings. */ /*===============================*/ EvaluationData(theEnv)->CurrentEvaluationDepth--; PopRtnBrkContexts(theEnv); ClearParsedBindNames(theEnv); SetPPBufferStatus(theEnv,OFF); SetHaltExecution(theEnv,ov); /*==============================*/ /* Return the status of parsing */ /* the construct. */ /*==============================*/ return(rv); } /*********************************************************/ /* GetConstructNameAndComment: Get the name and comment */ /* field of a construct. Returns name of the construct */ /* if no errors are detected, otherwise returns NULL. */ /*********************************************************/ #if IBM_TBC && (! DEBUGGING_FUNCTIONS) #pragma argsused #endif globle SYMBOL_HN *GetConstructNameAndComment( void *theEnv, char *readSource, struct token *inputToken, char *constructName, void *(*findFunction)(void *,char *), int (*deleteFunction)(void *,void *), char *constructSymbol, int fullMessageCR, int getComment, int moduleNameAllowed) { #if (MAC_MCW || IBM_MCW || MAC_XCD) && (! DEBUGGING_FUNCTIONS) #pragma unused(fullMessageCR) #endif SYMBOL_HN *name, *moduleName; int redefining = FALSE; void *theConstruct; unsigned separatorPosition; struct defmodule *theModule; /*==========================*/ /* Next token should be the */ /* name of the construct. */ /*==========================*/ GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { PrintErrorID(theEnv,"CSTRCPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Missing name for "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," construct\n"); return(NULL); } name = (SYMBOL_HN *) inputToken->value; /*===============================*/ /* Determine the current module. */ /*===============================*/ separatorPosition = FindModuleSeparator(ValueToString(name)); if (separatorPosition) { if (moduleNameAllowed == FALSE) { SyntaxErrorMessage(theEnv,"module specifier"); return(NULL); } moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name)); if (moduleName == NULL) { SyntaxErrorMessage(theEnv,"construct name"); return(NULL); } theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName)); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName)); return(NULL); } EnvSetCurrentModule(theEnv,(void *) theModule); name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name)); if (name == NULL) { SyntaxErrorMessage(theEnv,"construct name"); return(NULL); } } /*=====================================================*/ /* If the module was not specified, record the current */ /* module name as part of the pretty-print form. */ /*=====================================================*/ else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (moduleNameAllowed) { PPBackup(theEnv); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule)); SavePPBuffer(theEnv,"::"); SavePPBuffer(theEnv,ValueToString(name)); } } /*==================================================================*/ /* Check for import/export conflicts from the construct definition. */ /*==================================================================*/ #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name))) { ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL); return(NULL); } #endif /*========================================================*/ /* Remove the construct if it is already in the knowledge */ /* base and we're not just checking syntax. */ /*========================================================*/ if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode)) { theConstruct = (*findFunction)(theEnv,ValueToString(name)); if (theConstruct != NULL) { redefining = TRUE; if (deleteFunction != NULL) { if ((*deleteFunction)(theEnv,theConstruct) == FALSE) { PrintErrorID(theEnv,"CSTRCPSR",4,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot redefine "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,ValueToString(name)); EnvPrintRouter(theEnv,WERROR," while it is in use.\n"); return(NULL); } } } } /*=============================================*/ /* If compilations are being watched, indicate */ /* that a construct is being compiled. */ /*=============================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode)) { if (redefining) { PrintWarningID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WDIALOG,"Redefining "); } else EnvPrintRouter(theEnv,WDIALOG,"Defining "); EnvPrintRouter(theEnv,WDIALOG,constructName); EnvPrintRouter(theEnv,WDIALOG,": "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(name)); if (fullMessageCR) EnvPrintRouter(theEnv,WDIALOG,"\n"); else EnvPrintRouter(theEnv,WDIALOG," "); } else #endif { if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode)) { EnvPrintRouter(theEnv,WDIALOG,constructSymbol); } } /*===============================*/ /* Get the comment if it exists. */ /*===============================*/ GetToken(theEnv,readSource,inputToken); if ((inputToken->type == STRING) && getComment) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,inputToken->printForm); GetToken(theEnv,readSource,inputToken); if (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,"\n "); SavePPBuffer(theEnv,inputToken->printForm); } } else if (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,"\n "); SavePPBuffer(theEnv,inputToken->printForm); } /*===================================*/ /* Return the name of the construct. */ /*===================================*/ return(name); } /****************************************/ /* RemoveConstructFromModule: Removes a */ /* construct from its module's list */ /****************************************/ globle void RemoveConstructFromModule( void *theEnv, struct constructHeader *theConstruct) { struct constructHeader *lastConstruct,*currentConstruct; /*==============================*/ /* Find the specified construct */ /* in the module's list. */ /*==============================*/ lastConstruct = NULL; currentConstruct = theConstruct->whichModule->firstItem; while (currentConstruct != theConstruct) { lastConstruct = currentConstruct; currentConstruct = currentConstruct->next; } /*========================================*/ /* If it wasn't there, something's wrong. */ /*========================================*/ if (currentConstruct == NULL) { SystemError(theEnv,"CSTRCPSR",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*==========================*/ /* Remove it from the list. */ /*==========================*/ if (lastConstruct == NULL) { theConstruct->whichModule->firstItem = theConstruct->next; } else { lastConstruct->next = theConstruct->next; } /*=================================================*/ /* Update the pointer to the last item in the list */ /* if the construct just deleted was at the end. */ /*=================================================*/ if (theConstruct == theConstruct->whichModule->lastItem) { theConstruct->whichModule->lastItem = lastConstruct; } } /******************************************************/ /* ImportExportConflictMessage: Generic error message */ /* for an import/export module conflict detected */ /* when a construct is being defined. */ /******************************************************/ globle void ImportExportConflictMessage( void *theEnv, char *constructName, char *itemName, char *causedByConstruct, char *causedByName) { PrintErrorID(theEnv,"CSTRCPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot define "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR," because of an import/export conflict"); if (causedByConstruct == NULL) EnvPrintRouter(theEnv,WERROR,".\n"); else { EnvPrintRouter(theEnv,WERROR," caused by the "); EnvPrintRouter(theEnv,WERROR,causedByConstruct); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,causedByName); EnvPrintRouter(theEnv,WERROR,".\n"); } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ clips-6.24/clipssrc/._tmpltbsc.h0000400000175000017500000000075410441151156014737 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z<,,TTFS FMWBBMPSRclips-6.24/clipssrc/ruledef.h0000755000175000017500000001242010441151105014320 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFRULE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic defrule primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* defrule data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_ruledef #define _H_ruledef #define GetDisjunctIndex(r) ((struct constructHeader *) r)->bsaveID struct defrule; struct defruleModule; #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_agenda #include "agenda.h" #endif #ifndef _H_network #include "network.h" #endif struct defrule { struct constructHeader header; int salience; int localVarCnt; unsigned int complexity : 11; unsigned int afterBreakpoint : 1; unsigned int watchActivation : 1; unsigned int watchFiring : 1; unsigned int autoFocus : 1; unsigned int executing : 1; struct expr *dynamicSalience; struct expr *actions; struct joinNode *logicalJoin; struct joinNode *lastJoin; struct defrule *disjunct; }; struct defruleModule { struct defmoduleItemHeader header; struct activation *agenda; }; #define DEFRULE_DATA 16 struct defruleData { struct construct *DefruleConstruct; int DefruleModuleIndex; long CurrentEntityTimeTag; #if DEBUGGING_FUNCTIONS unsigned WatchRules; int DeletedRuleDebugFlags; #endif #if DEVELOPER && (! RUN_TIME) && (! BLOAD_ONLY) unsigned WatchRuleAnalysis; #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefruleCodeItem; #endif }; #define EnvGetDefruleName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define EnvGetDefrulePPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define EnvDefruleModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define DefruleData(theEnv) ((struct defruleData *) GetEnvironmentData(theEnv,DEFRULE_DATA)) #define GetPreviousJoin(theJoin) \ (((theJoin)->joinFromTheRight) ? \ ((struct joinNode *) (theJoin)->rightSideEntryStructure) : \ ((theJoin)->lastLevel)) #define GetPatternForJoin(theJoin) \ (((theJoin)->joinFromTheRight) ? \ NULL : \ ((theJoin)->rightSideEntryStructure)) #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEDEF_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DefruleModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define FindDefrule(theEnv,a) EnvFindDefrule(theEnv,a) #define GetDefruleName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define GetDefrulePPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetNextDefrule(theEnv,a) EnvGetNextDefrule(theEnv,a) #define IsDefruleDeletable(theEnv,a) EnvIsDefruleDeletable(theEnv,a) #else #define DefruleModule(x) GetConstructModuleName((struct constructHeader *) x) #define FindDefrule(a) EnvFindDefrule(GetCurrentEnvironment(),a) #define GetDefruleName(x) GetConstructNameString((struct constructHeader *) x) #define GetDefrulePPForm(x) GetConstructPPForm(GetCurrentEnvironment(),(struct constructHeader *) x) #define GetNextDefrule(a) EnvGetNextDefrule(GetCurrentEnvironment(),a) #define IsDefruleDeletable(a) EnvIsDefruleDeletable(GetCurrentEnvironment(),a) #endif LOCALE void InitializeDefrules(void *); LOCALE void *EnvFindDefrule(void *,char *); LOCALE void *EnvGetNextDefrule(void *,void *); LOCALE struct defruleModule *GetDefruleModuleItem(void *,struct defmodule *); LOCALE intBool EnvIsDefruleDeletable(void *,void *); #endif clips-6.24/clipssrc/factrhs.c0000755000175000017500000005124407673515124014350 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* FACT RHS PATTERN PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a number of routines for parsing fact */ /* patterns typically found on the RHS of a rule (such as */ /* the assert command). Also contains some functions for */ /* parsing RHS slot values (used by functions such as */ /* assert, modify, and duplicate). */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Chris Culbert */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _FACTRHS_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include "constant.h" #include "envrnmnt.h" #include "extnfunc.h" #include "modulutl.h" #include "modulpsr.h" #include "pattern.h" #include "prntutil.h" #include "cstrcpsr.h" #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY #include "bload.h" #endif #include "tmpltpsr.h" #include "tmpltrhs.h" #include "tmpltutl.h" #include "exprnpsr.h" #include "strngrtr.h" #include "router.h" #include "factrhs.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE static void NoSuchTemplateError(void *,char *); #endif #if (! RUN_TIME) /**********************************************************************/ /* BuildRHSAssert: Parses zero or more RHS fact patterns (the format */ /* which is used by the assert command and the deffacts construct). */ /* Each of the RHS patterns is attached to an assert command and if */ /* there is more than one assert command, then a progn command is */ /* wrapped around all of the assert commands. */ /**********************************************************************/ globle struct expr *BuildRHSAssert( void *theEnv, char *logicalName, struct token *theToken, int *error, int atLeastOne, int readFirstParen, char *whereParsed) { struct expr *lastOne, *nextOne, *assertList, *stub; *error = FALSE; /*===============================================================*/ /* If the first parenthesis of the RHS fact pattern has not been */ /* read yet, then get the next token. If a right parenthesis is */ /* encountered then exit (however, set the error return value if */ /* at least one fact was expected). */ /*===============================================================*/ if (readFirstParen == FALSE) { if (theToken->type == RPAREN) { if (atLeastOne) { *error = TRUE; SyntaxErrorMessage(theEnv,whereParsed); } return(NULL); } } /*================================================*/ /* Parse the facts until no more are encountered. */ /*================================================*/ lastOne = assertList = NULL; while ((nextOne = GetRHSPattern(theEnv,logicalName,theToken, error,FALSE,readFirstParen, TRUE,RPAREN)) != NULL) { PPCRAndIndent(theEnv); stub = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"assert")); stub->argList = nextOne; nextOne = stub; if (lastOne == NULL) { assertList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; readFirstParen = TRUE; } /*======================================================*/ /* If an error was detected while parsing, then return. */ /*======================================================*/ if (*error) { ReturnExpression(theEnv,assertList); return(NULL); } /*======================================*/ /* Fix the pretty print representation. */ /*======================================*/ if (theToken->type == RPAREN) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } /*==============================================================*/ /* If no facts are being asserted then return NULL. In addition */ /* if at least one fact was required, then signal an error. */ /*==============================================================*/ if (assertList == NULL) { if (atLeastOne) { *error = TRUE; SyntaxErrorMessage(theEnv,whereParsed); } return(NULL); } /*===============================================*/ /* If more than one fact is being asserted, then */ /* wrap the assert commands within a progn call. */ /*===============================================*/ if (assertList->nextArg != NULL) { stub = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"progn")); stub->argList = assertList; assertList = stub; } /*==========================================================*/ /* Return the expression for asserting the specified facts. */ /*==========================================================*/ return(assertList); } #endif /***************************************************************/ /* GetRHSPattern: Parses a single RHS fact pattern. The return */ /* value is the fact just parsed (or NULL if the delimiter */ /* for no more facts is the first token parsed). If an error */ /* occurs, then the error flag passed as an argument is set. */ /***************************************************************/ globle struct expr *GetRHSPattern( void *theEnv, char *readSource, struct token *tempToken, int *error, int constantsOnly, int readFirstParen, int checkFirstParen, int endType) { struct expr *lastOne = NULL; struct expr *nextOne, *firstOne, *argHead = NULL; int printError, count; struct deftemplate *theDeftemplate; struct symbolHashNode *templateName; /*=================================================*/ /* Get the opening parenthesis of the RHS pattern. */ /*=================================================*/ *error = FALSE; if (readFirstParen) GetToken(theEnv,readSource,tempToken); if (checkFirstParen) { if (tempToken->type == endType) return(NULL); if (tempToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"RHS patterns"); *error = TRUE; return(NULL); } } /*======================================================*/ /* The first field of an asserted fact must be a symbol */ /* (but not = or : which have special significance). */ /*======================================================*/ GetToken(theEnv,readSource,tempToken); if (tempToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"first field of a RHS pattern"); *error = TRUE; return(NULL); } else if ((strcmp(ValueToString(tempToken->value),"=") == 0) || (strcmp(ValueToString(tempToken->value),":") == 0)) { SyntaxErrorMessage(theEnv,"first field of a RHS pattern"); *error = TRUE; return(NULL); } /*=========================================================*/ /* Check to see if the relation name is a reserved symbol. */ /*=========================================================*/ templateName = (struct symbolHashNode *) tempToken->value; if (ReservedPatternSymbol(theEnv,ValueToString(templateName),NULL)) { ReservedPatternSymbolErrorMsg(theEnv,ValueToString(templateName),"a relation name"); *error = TRUE; return(NULL); } /*============================================================*/ /* A module separator in the name is illegal in this context. */ /*============================================================*/ if (FindModuleSeparator(ValueToString(templateName))) { IllegalModuleSpecifierMessage(theEnv); *error = TRUE; return(NULL); } /*=============================================================*/ /* Determine if there is an associated deftemplate. If so, let */ /* the deftemplate parsing functions parse the RHS pattern and */ /* then return the fact pattern that was parsed. */ /*=============================================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,ValueToString(templateName), &count,TRUE,NULL); if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",ValueToString(templateName)); *error = TRUE; return(NULL); } /*======================================================*/ /* If no deftemplate exists with the specified relation */ /* name, then create an implied deftemplate. */ /*======================================================*/ if (theDeftemplate == NULL) #if (! BLOAD_ONLY) && (! RUN_TIME) { #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { NoSuchTemplateError(theEnv,ValueToString(templateName)); *error = TRUE; return(NULL); } #endif #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,"deftemplate",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(templateName))) { ImportExportConflictMessage(theEnv,"implied deftemplate",ValueToString(templateName),NULL,NULL); *error = TRUE; return(NULL); } #endif if (! ConstructData(theEnv)->CheckSyntaxMode) { theDeftemplate = CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) templateName,TRUE); } } #else { NoSuchTemplateError(theEnv,ValueToString(templateName)); *error = TRUE; return(NULL); } #endif /*=========================================*/ /* If an explicit deftemplate exists, then */ /* parse the fact as a deftemplate fact. */ /*=========================================*/ if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE)) { firstOne = GenConstant(theEnv,DEFTEMPLATE_PTR,theDeftemplate); firstOne->nextArg = ParseAssertTemplate(theEnv,readSource,tempToken, error,endType, constantsOnly,theDeftemplate); if (*error) { ReturnExpression(theEnv,firstOne); firstOne = NULL; } return(firstOne); } /*========================================*/ /* Parse the fact as an ordered RHS fact. */ /*========================================*/ firstOne = GenConstant(theEnv,DEFTEMPLATE_PTR,theDeftemplate); #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(theEnv," "); #endif while ((nextOne = GetAssertArgument(theEnv,readSource,tempToken, error,endType,constantsOnly,&printError)) != NULL) { if (argHead == NULL) argHead = nextOne; else lastOne->nextArg = nextOne; lastOne = nextOne; #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(theEnv," "); #endif } /*===========================================================*/ /* If an error occurred, set the error flag and return NULL. */ /*===========================================================*/ if (*error) { if (printError) SyntaxErrorMessage(theEnv,"RHS patterns"); ReturnExpression(theEnv,firstOne); ReturnExpression(theEnv,argHead); return(NULL); } /*=====================================*/ /* Fix the pretty print representation */ /* of the RHS ordered fact. */ /*=====================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tempToken->printForm); #endif /*==========================================================*/ /* Ordered fact assertions are processed by stuffing all of */ /* the fact's proposition (except the relation name) into a */ /* single multifield slot. */ /*==========================================================*/ firstOne->nextArg = GenConstant(theEnv,FACT_STORE_MULTIFIELD,AddBitMap(theEnv,(void *) "\0",1)); firstOne->nextArg->argList = argHead; /*==============================*/ /* Return the RHS ordered fact. */ /*==============================*/ return(firstOne); } /********************************************************************/ /* GetAssertArgument: Parses a single RHS slot value and returns an */ /* expression representing the value. When parsing a deftemplate */ /* slot, the slot name has already been parsed when this function */ /* is called. NULL is returned if a slot or fact delimiter is */ /* encountered. In the event of a parse error, the error flag */ /* passed as an argument is set. */ /********************************************************************/ globle struct expr *GetAssertArgument( void *theEnv, char *logicalName, struct token *theToken, int *error, int endType, int constantsOnly, int *printError) { #if ! RUN_TIME struct expr *nextField; #else struct expr *nextField = NULL; #endif /*=================================================*/ /* Read in the first token of the slot's value. If */ /* the end delimiter is encountered, then return. */ /*=================================================*/ *printError = TRUE; GetToken(theEnv,logicalName,theToken); if (theToken->type == endType) return(NULL); /*=============================================================*/ /* If an equal sign of left parenthesis was parsed, then parse */ /* a function which is to be evaluated to determine the slot's */ /* value. The equal sign corresponds to the return value */ /* constraint which can be used in LHS fact patterns. The */ /* equal sign is no longer necessary on either the LHS or RHS */ /* of a rule to indicate that a function is being evaluated to */ /* determine its value either for assignment or pattern */ /* matching. */ /*=============================================================*/ if ((theToken->type == SYMBOL) ? (strcmp(ValueToString(theToken->value),"=") == 0) : (theToken->type == LPAREN)) { if (constantsOnly) { *error = TRUE; return(NULL); } #if ! RUN_TIME if (theToken->type == LPAREN) nextField = Function1Parse(theEnv,logicalName); else nextField = Function0Parse(theEnv,logicalName); if (nextField == NULL) #endif { *printError = FALSE; *error = TRUE; } #if ! RUN_TIME else { theToken->type= RPAREN; theToken->value = (void *) EnvAddSymbol(theEnv,")"); theToken->printForm = ")"; } #endif return(nextField); } /*==================================================*/ /* Constants are always allowed as RHS slot values. */ /*==================================================*/ if ((theToken->type == SYMBOL) || (theToken->type == STRING) || #if OBJECT_SYSTEM (theToken->type == INSTANCE_NAME) || #endif (theToken->type == FLOAT) || (theToken->type == INTEGER)) { return(GenConstant(theEnv,theToken->type,theToken->value)); } /*========================================*/ /* Variables are also allowed as RHS slot */ /* values under some circumstances. */ /*========================================*/ if ((theToken->type == SF_VARIABLE) || #if DEFGLOBAL_CONSTRUCT (theToken->type == GBL_VARIABLE) || (theToken->type == MF_GBL_VARIABLE) || #endif (theToken->type == MF_VARIABLE)) { if (constantsOnly) { *error = TRUE; return(NULL); } return(GenConstant(theEnv,theToken->type,theToken->value)); } /*==========================================================*/ /* If none of the other cases have been satisfied, then the */ /* token parsed is not appropriate for a RHS slot value. */ /*==========================================================*/ *error = TRUE; return(NULL); } /****************************************************/ /* StringToFact: Converts the string representation */ /* of a fact to a fact data structure. */ /****************************************************/ globle struct fact *StringToFact( void *theEnv, char *str) { struct token theToken; struct fact *factPtr; unsigned numberOfFields = 0, whichField; struct expr *assertArgs, *tempPtr; int error = FALSE; DATA_OBJECT theResult; /*=========================================*/ /* Open a string router and parse the fact */ /* using the router as an input source. */ /*=========================================*/ SetEvaluationError(theEnv,FALSE); OpenStringSource(theEnv,"assert_str",str,0); assertArgs = GetRHSPattern(theEnv,"assert_str",&theToken, &error,FALSE,TRUE, TRUE,RPAREN); CloseStringSource(theEnv,"assert_str"); /*===========================================*/ /* Check for errors or the use of variables. */ /*===========================================*/ if ((assertArgs == NULL) && (! error)) { SyntaxErrorMessage(theEnv,"RHS patterns"); ReturnExpression(theEnv,assertArgs); return(NULL); } if (error) { ReturnExpression(theEnv,assertArgs); return(NULL); } if (ExpressionContainsVariables(assertArgs,FALSE)) { LocalVariableErrorMessage(theEnv,"the assert-string function"); SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,assertArgs); return(NULL); } /*=======================================================*/ /* Count the number of fields needed for the fact and */ /* create a fact data structure of the appropriate size. */ /*=======================================================*/ for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg) { numberOfFields++; } factPtr = (struct fact *) CreateFactBySize(theEnv,numberOfFields); factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value; /*=============================================*/ /* Copy the fields to the fact data structure. */ /*=============================================*/ ExpressionInstall(theEnv,assertArgs); /* DR0836 */ whichField = 0; for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg) { EvaluateExpression(theEnv,tempPtr,&theResult); factPtr->theProposition.theFields[whichField].type = theResult.type; factPtr->theProposition.theFields[whichField].value = theResult.value; whichField++; } ExpressionDeinstall(theEnv,assertArgs); /* DR0836 */ ReturnExpression(theEnv,assertArgs); /*==================*/ /* Return the fact. */ /*==================*/ return(factPtr); } #if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE /*********************************************************/ /* NoSuchTemplateError: Prints out an error message */ /* in a BLOAD_ONLY, RUN_TIME or bload active environment */ /* when an implied deftemplate cannot be created for */ /* an assert */ /*********************************************************/ static void NoSuchTemplateError( void *theEnv, char *templateName) { PrintErrorID(theEnv,"FACTRHS",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Template "); EnvPrintRouter(theEnv,WERROR,templateName); EnvPrintRouter(theEnv,WERROR," does not exist for assert.\n"); } #endif /* RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/._rulebld.h0000400000175000017500000000012207422634552014540 0ustar jfsjfsMac OS X  2 RTEXT???? clips-6.24/clipssrc/filecom.h0000755000175000017500000000654310441143503014324 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FILE COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for file commands including */ /* batch, dribble-on, dribble-off, save, load, bsave, and */ /* bload. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_filecom #define _H_filecom #ifdef LOCALE #undef LOCALE #endif #ifdef _FILECOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DribbleActive(theEnv) EnvDribbleActive(theEnv) #define DribbleOn(theEnv,a) EnvDribbleOn(theEnv,a) #define DribbleOff(theEnv) EnvDribbleOff(theEnv) #define BatchStar(theEnv,a) EnvBatchStar(theEnv,a) #else #define DribbleActive() EnvDribbleActive(GetCurrentEnvironment()) #define DribbleOn(a) EnvDribbleOn(GetCurrentEnvironment(),a) #define DribbleOff() EnvDribbleOff(GetCurrentEnvironment()) #define BatchStar(a) EnvBatchStar(GetCurrentEnvironment(),a) #endif LOCALE void FileCommandDefinitions(void *); LOCALE intBool EnvDribbleOn(void *,char *); LOCALE intBool EnvDribbleActive(void *); LOCALE intBool EnvDribbleOff(void *); LOCALE void SetDribbleStatusFunction(void *,int (*)(void *,int)); LOCALE int LLGetcBatch(void *,char *,int); LOCALE int Batch(void *,char *); LOCALE int OpenBatch(void *,char *,int); LOCALE int OpenStringBatch(void *,char *,char *,int); LOCALE int RemoveBatch(void *); LOCALE intBool BatchActive(void *); LOCALE void CloseAllBatchSources(void *); LOCALE int BatchCommand(void *); LOCALE int BatchStarCommand(void *); LOCALE int EnvBatchStar(void *,char *); LOCALE int LoadCommand(void *); LOCALE int LoadStarCommand(void *); LOCALE int SaveCommand(void *); LOCALE int DribbleOnCommand(void *); LOCALE int DribbleOffCommand(void *); #endif clips-6.24/clipssrc/tmpltbin.c0000755000175000017500000006313710171403615014537 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* DEFTEMPLATE BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* deftemplate construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /*************************************************************/ #define _TMPLTBIN_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "bload.h" #include "bsave.h" #include "factbin.h" #include "cstrnbin.h" #include "factmngr.h" #include "tmpltpsr.h" #include "tmpltdef.h" #include "tmpltutl.h" #include "envrnmnt.h" #include "tmpltbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateDeftemplateModule(void *,void *,long); static void UpdateDeftemplate(void *,void *,long); static void UpdateDeftemplateSlot(void *,void *,long); static void ClearBload(void *); static void DeallocateDeftemplateBloadData(void *); /***********************************************/ /* DeftemplateBinarySetup: Installs the binary */ /* save/load feature for deftemplates. */ /***********************************************/ globle void DeftemplateBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,TMPLTBIN_DATA,sizeof(struct deftemplateBinaryData),DeallocateDeftemplateBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"deftemplate",0,BsaveFind,NULL, BsaveStorage,BsaveBinaryItem, BloadStorage,BloadBinaryItem, ClearBload); #endif #if (BLOAD || BLOAD_ONLY) AddBinaryItem(theEnv,"deftemplate",0,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /***********************************************************/ /* DeallocateDeftemplateBloadData: Deallocates environment */ /* data for the deftemplate bsave functionality. */ /***********************************************************/ static void DeallocateDeftemplateBloadData( void *theEnv) { unsigned long space; space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule); if (space != 0) genlongfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->ModuleArray,space); space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate); if (space != 0) genlongfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray,space); space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot); if (space != 0) genlongfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->SlotArray,space); } #if BLOAD_AND_BSAVE /**************************************************************/ /* BsaveFind: Counts the number of data structures which must */ /* be saved in the binary image for the deftemplates in the */ /* current environment. */ /**************************************************************/ static void BsaveFind( void *theEnv) { struct deftemplate *theDeftemplate; struct templateSlot *theSlot; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DeftemplateBinaryData(theEnv)->NumberOfDeftemplates); SaveBloadCount(theEnv,DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots); SaveBloadCount(theEnv,DeftemplateBinaryData(theEnv)->NumberOfTemplateModules); /*==================================================*/ /* Set the count of deftemplates, deftemplate slots */ /* and deftemplate module data structures to zero. */ /*==================================================*/ DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0; DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0; DeftemplateBinaryData(theEnv)->NumberOfTemplateModules = 0; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*============================================*/ /* Set the current module to the module being */ /* examined and increment the number of */ /* deftemplate modules encountered. */ /*============================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); DeftemplateBinaryData(theEnv)->NumberOfTemplateModules++; /*======================================================*/ /* Loop through each deftemplate in the current module. */ /*======================================================*/ for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { /*======================================================*/ /* Initialize the construct header for the binary save. */ /*======================================================*/ MarkConstructHeaderNeededItems(&theDeftemplate->header, DeftemplateBinaryData(theEnv)->NumberOfDeftemplates++); /*=============================================================*/ /* Loop through each slot in the deftemplate, incrementing the */ /* slot count and marking the slot names as needed symbols. */ /*=============================================================*/ for (theSlot = theDeftemplate->slotList; theSlot != NULL; theSlot = theSlot->next) { DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots++; theSlot->slotName->neededSymbol = TRUE; } } } } /*********************************************************/ /* BsaveStorage: Writes out the storage requirements for */ /* all deftemplate structures to the binary file. */ /*********************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { unsigned long space; /*========================================================================*/ /* Three data structures are saved as part of a deftemplate binary image: */ /* the deftemplate data structure, the deftemplateModule data structure, */ /* and the templateSlot data structure. The data structures associated */ /* with default values and constraints are not save with the deftemplate */ /* portion of the binary image. */ /*========================================================================*/ space = sizeof(long) * 3; GenWrite(&space,(unsigned long) sizeof(long int),fp); GenWrite(&DeftemplateBinaryData(theEnv)->NumberOfDeftemplates,(unsigned long) sizeof(long int),fp); GenWrite(&DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots,(unsigned long) sizeof(long int),fp); GenWrite(&DeftemplateBinaryData(theEnv)->NumberOfTemplateModules,(unsigned long) sizeof(long int),fp); } /***********************************************/ /* BsaveBinaryItem: Writes out all deftemplate */ /* structures to the binary file. */ /***********************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { unsigned long space; struct deftemplate *theDeftemplate; struct bsaveDeftemplate tempDeftemplate; struct templateSlot *theSlot; struct bsaveTemplateSlot tempTemplateSlot; struct bsaveDeftemplateModule tempTemplateModule; struct defmodule *theModule; struct deftemplateModule *theModuleItem; /*============================================================*/ /* Write out the amount of space taken up by the deftemplate, */ /* deftemplateModule, and templateSlot data structures in the */ /* binary image. */ /*============================================================*/ space = (DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct bsaveDeftemplate)) + (DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct bsaveTemplateSlot)) + (DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct bsaveDeftemplateModule)); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); /*===================================================*/ /* Write out each deftemplate module data structure. */ /*===================================================*/ DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); theModuleItem = (struct deftemplateModule *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"deftemplate")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&tempTemplateModule.header, &theModuleItem->header); GenWrite(&tempTemplateModule,(unsigned long) sizeof(struct bsaveDeftemplateModule),fp); } /*============================================*/ /* Write out each deftemplate data structure. */ /*============================================*/ DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { AssignBsaveConstructHeaderVals(&tempDeftemplate.header, &theDeftemplate->header); tempDeftemplate.implied = theDeftemplate->implied; tempDeftemplate.numberOfSlots = theDeftemplate->numberOfSlots; tempDeftemplate.patternNetwork = BsaveFactPatternIndex(theDeftemplate->patternNetwork); if (theDeftemplate->slotList != NULL) { tempDeftemplate.slotList = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots; } else tempDeftemplate.slotList = -1L; GenWrite(&tempDeftemplate,(unsigned long) sizeof(struct bsaveDeftemplate),fp); DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots += theDeftemplate->numberOfSlots; } } /*=============================================*/ /* Write out each templateSlot data structure. */ /*=============================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { for (theSlot = theDeftemplate->slotList; theSlot != NULL; theSlot = theSlot->next) { tempTemplateSlot.constraints = ConstraintIndex(theSlot->constraints); tempTemplateSlot.slotName = theSlot->slotName->bucket; tempTemplateSlot.multislot = theSlot->multislot; tempTemplateSlot.noDefault = theSlot->noDefault; tempTemplateSlot.defaultPresent = theSlot->defaultPresent; tempTemplateSlot.defaultDynamic = theSlot->defaultDynamic; tempTemplateSlot.defaultList = HashedExpressionIndex(theEnv,theSlot->defaultList); if (theSlot->next != NULL) tempTemplateSlot.next = 0L; else tempTemplateSlot.next = -1L; GenWrite(&tempTemplateSlot,(unsigned long) sizeof(struct bsaveTemplateSlot),fp); } } } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of deftemplates, deftemplate modules, and deftemplate slots */ /* in the binary image (these were overwritten by the binary */ /* save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfDeftemplates); RestoreBloadCount(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots); RestoreBloadCount(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateModules); } #endif /* BLOAD_AND_BSAVE */ /****************************************************/ /* BloadStorage: Allocates storage requirements for */ /* the deftemplates used by this binary image. */ /****************************************************/ static void BloadStorage( void *theEnv) { unsigned long int space; /*=========================================================*/ /* Determine the number of deftemplate, deftemplateModule, */ /* and templateSlot data structures to be read. */ /*=========================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfDeftemplates,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateModules,(unsigned long) sizeof(long int)); /*====================================*/ /* Allocate the space needed for the */ /* deftemplateModule data structures. */ /*====================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfTemplateModules == 0) { DeftemplateBinaryData(theEnv)->DeftemplateArray = NULL; DeftemplateBinaryData(theEnv)->SlotArray = NULL; DeftemplateBinaryData(theEnv)->ModuleArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule); DeftemplateBinaryData(theEnv)->ModuleArray = (struct deftemplateModule *) genlongalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* deftemplate data structures. */ /*===================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfDeftemplates == 0) { DeftemplateBinaryData(theEnv)->DeftemplateArray = NULL; DeftemplateBinaryData(theEnv)->SlotArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate); DeftemplateBinaryData(theEnv)->DeftemplateArray = (struct deftemplate *) genlongalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* templateSlot data structures. */ /*===================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots == 0) { DeftemplateBinaryData(theEnv)->SlotArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot); DeftemplateBinaryData(theEnv)->SlotArray = (struct templateSlot *) genlongalloc(theEnv,space); } /********************************************************/ /* BloadBinaryItem: Loads and refreshes the deftemplate */ /* constructs used by this binary image. */ /********************************************************/ static void BloadBinaryItem( void *theEnv) { unsigned long int space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); /*===============================================*/ /* Read in the deftemplateModule data structures */ /* and refresh the pointers. */ /*===============================================*/ BloadandRefresh(theEnv,DeftemplateBinaryData(theEnv)->NumberOfTemplateModules,(unsigned) sizeof(struct bsaveDeftemplateModule), UpdateDeftemplateModule); /*===============================================*/ /* Read in the deftemplateModule data structures */ /* and refresh the pointers. */ /*===============================================*/ BloadandRefresh(theEnv,DeftemplateBinaryData(theEnv)->NumberOfDeftemplates,(unsigned) sizeof(struct bsaveDeftemplate), UpdateDeftemplate); /*==========================================*/ /* Read in the templateSlot data structures */ /* and refresh the pointers. */ /*==========================================*/ BloadandRefresh(theEnv,DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots,(unsigned) sizeof(struct bsaveTemplateSlot), UpdateDeftemplateSlot); } /**************************************************/ /* UpdateDeftemplateModule: Bload refresh routine */ /* for deftemplateModule data structures. */ /**************************************************/ static void UpdateDeftemplateModule( void *theEnv, void *buf, long obji) { struct bsaveDeftemplateModule *bdmPtr; bdmPtr = (struct bsaveDeftemplateModule *) buf; UpdateDefmoduleItemHeader(theEnv,&bdmPtr->header,&DeftemplateBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(struct deftemplate), (void *) DeftemplateBinaryData(theEnv)->DeftemplateArray); } /********************************************/ /* UpdateDeftemplate: Bload refresh routine */ /* for deftemplate data structures. */ /********************************************/ static void UpdateDeftemplate( void *theEnv, void *buf, long obji) { struct deftemplate *theDeftemplate; struct bsaveDeftemplate *bdtPtr; bdtPtr = (struct bsaveDeftemplate *) buf; theDeftemplate = (struct deftemplate *) &DeftemplateBinaryData(theEnv)->DeftemplateArray[obji]; UpdateConstructHeader(theEnv,&bdtPtr->header,&theDeftemplate->header, (int) sizeof(struct deftemplateModule),(void *) DeftemplateBinaryData(theEnv)->ModuleArray, (int) sizeof(struct deftemplate),(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray); if (bdtPtr->slotList != -1L) { theDeftemplate->slotList = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[bdtPtr->slotList]; } else { theDeftemplate->slotList = NULL; } if (bdtPtr->patternNetwork != -1L) { theDeftemplate->patternNetwork = (struct factPatternNode *) BloadFactPatternPointer(bdtPtr->patternNetwork); } else { theDeftemplate->patternNetwork = NULL; } theDeftemplate->implied = bdtPtr->implied; #if DEBUGGING_FUNCTIONS theDeftemplate->watch = FactData(theEnv)->WatchFacts; #endif theDeftemplate->inScope = FALSE; theDeftemplate->numberOfSlots = (unsigned short) bdtPtr->numberOfSlots; theDeftemplate->factList = NULL; theDeftemplate->lastFact = NULL; } /************************************************/ /* UpdateDeftemplateSlot: Bload refresh routine */ /* for templateSlot data structures. */ /************************************************/ static void UpdateDeftemplateSlot( void *theEnv, void *buf, long obji) { struct templateSlot *theSlot; struct bsaveTemplateSlot *btsPtr; btsPtr = (struct bsaveTemplateSlot *) buf; theSlot = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji]; theSlot->slotName = SymbolPointer(btsPtr->slotName); IncrementSymbolCount(theSlot->slotName); theSlot->defaultList = HashedExpressionPointer(btsPtr->defaultList); theSlot->constraints = ConstraintPointer(btsPtr->constraints); theSlot->multislot = btsPtr->multislot; theSlot->noDefault = btsPtr->noDefault; theSlot->defaultPresent = btsPtr->defaultPresent; theSlot->defaultDynamic = btsPtr->defaultDynamic; if (btsPtr->next != -1L) { theSlot->next = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji + 1]; } else { theSlot->next = NULL; } } /*****************************************/ /* ClearBload: Deftemplate clear routine */ /* when a binary load is in effect. */ /*****************************************/ static void ClearBload( void *theEnv) { unsigned long int space; int i; /*=============================================*/ /* Decrement in use counters for atomic values */ /* contained in the construct headers. */ /*=============================================*/ for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfDeftemplates; i++) { UnmarkConstructHeader(theEnv,&DeftemplateBinaryData(theEnv)->DeftemplateArray[i].header); } /*=======================================*/ /* Decrement in use counters for symbols */ /* used as slot names. */ /*=======================================*/ for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots; i++) { DecrementSymbolCount(theEnv,DeftemplateBinaryData(theEnv)->SlotArray[i].slotName); } /*======================================================================*/ /* Deallocate the space used for the deftemplateModule data structures. */ /*======================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule); if (space != 0) genlongfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->ModuleArray,space); DeftemplateBinaryData(theEnv)->NumberOfTemplateModules = 0; /*================================================================*/ /* Deallocate the space used for the deftemplate data structures. */ /*================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate); if (space != 0) genlongfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray,space); DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0; /*=================================================================*/ /* Deallocate the space used for the templateSlot data structures. */ /*=================================================================*/ space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot); if (space != 0) genlongfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->SlotArray,space); DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0; /*======================================*/ /* Create the initial-fact deftemplate. */ /*======================================*/ #if (! BLOAD_ONLY) CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE); #endif } /************************************************************/ /* BloadDeftemplateModuleReference: Returns the deftemplate */ /* module pointer for use with the bload function. */ /************************************************************/ globle void *BloadDeftemplateModuleReference( void *theEnv, int theIndex) { return ((void *) &DeftemplateBinaryData(theEnv)->ModuleArray[theIndex]); } #endif /* DEFTEMPLATE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips-6.24/clipssrc/objcmp.c0000755000175000017500000015751310441602257014165 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Object System Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added environment parameter to GenClose. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && CONSTRUCT_COMPILER && (! RUN_TIME) #include "conscomp.h" #include "classcom.h" #include "classfun.h" #include "classini.h" #include "cstrncmp.h" #include "envrnmnt.h" #include "objrtfnx.h" #include "sysdep.h" #define _OBJCMP_SOURCE_ #include "objcmp.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MODULEI 0 #define CLASSI 1 #define LINKI 2 #define SLOTI 3 #define TSLOTI 4 #define OSLOTI 5 #define HANDLERI 6 #define OHANDLERI 7 #define SAVE_ITEMS 8 /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define ClassPrefix() ConstructPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem) #define ClassLinkPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,2) #define SlotPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,3) #define TemplateSlotPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,4) #define OrderedSlotPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,5) #define HandlerPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,6) #define OrderedHandlerPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,7) #define SlotNamePrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,8) #define SlotNameHashPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,9) #define ClassHashPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,10) #define ClassIDPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,11) #define MaxClassIDPrefix() ArbitraryPrefix(ObjectCompilerData(theEnv)->ObjectCodeItem,12) typedef struct { long classCount; unsigned short currentPartition; unsigned short slotCount; int maxIndices; } MARK_INFO; typedef union { struct { unsigned thePartition : 16; unsigned theOffset : 16; } theLocation; long theLong; } PACKED_LOCATION_INFO; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void ReadyObjectsForCode(void *); static void MarkDefclassAndSlots(void *,struct constructHeader *,void *); static void PrintSlotNameReference(void *,FILE *,SLOT_NAME *,int,int); static void InitObjectsCode(void *,FILE *,int,int); static int ObjectsToCode(void *,char *,int,FILE *,int,int); static int ClassIDMapToCode(void *,char *,int,FILE *,int,int,int *); static int ClassHashTableToCode(void *,char *,int,FILE *,int,int,int *); static int SlotNameHashTableToCode(void *,char *,int,FILE *,int,int,int *); static int SlotNameEntriesToCode(void *,char *,int,FILE *,int,int,int *); static void CloseObjectFiles(void *,FILE *[SAVE_ITEMS],int [SAVE_ITEMS], struct CodeGeneratorFile [SAVE_ITEMS],int); static void DefclassModuleToCode(void *,FILE *,struct defmodule *,int,int); static void SingleDefclassToCode(void *,FILE *,int,int,DEFCLASS *,int, int,int,int,int,int,int, int,int,int,int,int,int); static intBool InheritanceLinksToCode(void *,FILE **,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool SlotsToCode(void *,FILE **,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool TemplateSlotsToCode(void *,FILE **,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool OrderedSlotsToCode(void *,FILE **,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool HandlersToCode(void *,FILE **,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); static intBool OrderedHandlersToCode(void *,FILE **,char *,int,int,FILE *, int *,int,DEFCLASS *,int *, int *,int *,struct CodeGeneratorFile *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupObjectsCompiler DESCRIPTION : Initializes the construct compiler item for defclasses & handlers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item initialized NOTES : None ***************************************************/ globle void SetupObjectsCompiler( void *theEnv) { AllocateEnvironmentData(theEnv,OBJECT_COMPILER_DATA,sizeof(struct objectCompilerData),NULL); ObjectCompilerData(theEnv)->ObjectCodeItem = AddCodeGeneratorItem(theEnv,"objects",0,ReadyObjectsForCode, InitObjectsCode,ObjectsToCode,13); } /********************************************************* NAME : PrintClassReference DESCRIPTION : Writes out a reference to the class array INPUTS : 1) Output file pointer 2) Class address 3) Construct set image id 4) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Writes out class array reference to file NOTES : None *********************************************************/ globle void PrintClassReference( void *theEnv, FILE *fp, DEFCLASS *cls, int imageID, int maxIndices) { if (cls == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&%s%d_%d[%d]", ClassPrefix(), imageID, (int) ((cls->header.bsaveID / maxIndices) + 1), (int) (cls->header.bsaveID % maxIndices)); } /**************************************************** NAME : DefclassCModuleReference DESCRIPTION : Prints out a reference to a defclass 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 : Defclass module reference printed NOTES : None ****************************************************/ globle void DefclassCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(ObjectCompilerData(theEnv)->ObjectCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : ReadyObjectsForCode DESCRIPTION : Sets index of classes and slot name entries for use in compiled expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : BsaveIndices set NOTES : None *******************************************************/ static void ReadyObjectsForCode( void *theEnv) { MARK_INFO markInfo; register long i; register int j; SLOT_NAME *snp; markInfo.classCount = 0L; markInfo.currentPartition = 1; markInfo.slotCount = 0; /* ===================================== Gets the value of MaxIndices directly from the global in CONSCOMP.C ===================================== */ markInfo.maxIndices = ConstructCompilerData(theEnv)->MaxIndices; DoForAllConstructs(theEnv,MarkDefclassAndSlots,DefclassData(theEnv)->DefclassModuleIndex, FALSE,(void *) &markInfo); i = 0L; for (j = 0 ; j < SLOT_NAME_TABLE_HASH_SIZE ; j++) for (snp = DefclassData(theEnv)->SlotNameTable[j] ; snp != NULL ; snp = snp->nxt) snp->bsaveIndex = i++; } /************************************************************ NAME : MarkDefclassAndSlots DESCRIPTION : Sets the bsave indices of the classes for use in printing references to them later. Also, the partitions and offsets are predetermined for every slot and packed into a single long (the slot bsave index) for use in printing references to them later INPUTS : 1) The defclass 2) A buffer containing the info: a) Total number of classes counted so far b) The current partition # for slots c) The current offset in that partition d) The max # of elements in any array RETURNS : Nothing useful SIDE EFFECTS : Bsave indices of classes and slots set NOTES : The template slots are written at the same time as the real slots - thus the references must be predetermined ************************************************************/ #if IBM_TBC #pragma argsused #endif static void MarkDefclassAndSlots( void *theEnv, struct constructHeader *vTheDefclass, void *vTheBuffer) { DEFCLASS *theDefclass = (DEFCLASS *) vTheDefclass; MARK_INFO *markInfo = (MARK_INFO *) vTheBuffer; register unsigned i; PACKED_LOCATION_INFO theLocationInfo; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif theDefclass->header.bsaveID = markInfo->classCount++; for (i = 0 ; i < theDefclass->slotCount ; i++) { theLocationInfo.theLocation.thePartition = markInfo->currentPartition; theLocationInfo.theLocation.theOffset = markInfo->slotCount; theDefclass->slots[i].bsaveIndex = theLocationInfo.theLong; markInfo->slotCount++; if (markInfo->slotCount >= markInfo->maxIndices) { markInfo->currentPartition++; markInfo->slotCount = 0; } } } /************************************************************* NAME : PrintSlotNameReference DESCRIPTION : Writes out a reference to the slot name array INPUTS : 1) Output file pointer 2) Slot name address 3) Construct set image id 4) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Writes out slot name array reference to file NOTES : None *************************************************************/ static void PrintSlotNameReference( void *theEnv, FILE *fp, SLOT_NAME *snp, int imageID, int maxIndices) { if (snp == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&%s%d_%d[%d]", SlotNamePrefix(), imageID, (int) ((snp->bsaveIndex / maxIndices) + 1), (int) (snp->bsaveIndex % maxIndices)); } /******************************************************* NAME : InitObjectsCode DESCRIPTION : Writes out initialization code for generic functions INPUTS : 1) The initialization code file pointer 2) The construct set image id 3) The max number of indices allowed in an array for this construct set RETURNS : Nothing useful SIDE EFFECTS : Writes out initialization code NOTES : None *******************************************************/ #if IBM_TBC #pragma argsused #endif static void InitObjectsCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(maxIndices) #endif fprintf(initFP," ObjectsRunTimeInitialize(theEnv,%s%d_1,%s%d_1,%s%d_1,%s%d);\n", ClassHashPrefix(),imageID,SlotNameHashPrefix(),imageID, ClassIDPrefix(),imageID,MaxClassIDPrefix(),imageID); } /************************************************************* NAME : ObjectsToCode DESCRIPTION : Writes out static array code for classes, message-handlers, and associated structures 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 : -1 if no classes, 0 on errors, 1 if object system structures written SIDE EFFECTS : Code written to files NOTES : None *************************************************************/ static int ObjectsToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; DEFCLASS *theDefclass; register int i; int moduleCount = 0; int itemArrayCounts[SAVE_ITEMS]; int itemArrayVersions[SAVE_ITEMS]; FILE *itemFiles[SAVE_ITEMS]; int itemReopenFlags[SAVE_ITEMS]; struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS]; for (i = 0 ; i < SAVE_ITEMS ; i++) { itemArrayCounts[i] = 0; itemArrayVersions[i] = 1; itemFiles[i] = NULL; itemReopenFlags[i] = FALSE; itemCodeFiles[i].filePrefix = NULL; } fprintf(headerFP,"#include \"classcom.h\"\n"); fprintf(headerFP,"#include \"classini.h\"\n"); if (ClassIDMapToCode(theEnv,fileName,fileID,headerFP,imageID,maxIndices,&fileCount) == FALSE) return(0); if (ClassHashTableToCode(theEnv,fileName,fileID,headerFP,imageID,maxIndices,&fileCount) == FALSE) return(0); if (SlotNameHashTableToCode(theEnv,fileName,fileID,headerFP,imageID,maxIndices,&fileCount) == FALSE) return(0); if (SlotNameEntriesToCode(theEnv,fileName,fileID,headerFP,imageID,maxIndices,&fileCount) == FALSE) return(0); /* ============================================================= Loop through all the modules and all the defclasses writing their C code representation to the file as they are traversed ============================================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); itemFiles[MODULEI] = OpenFileIfNeeded(theEnv,itemFiles[MODULEI],fileName,fileID,imageID,&fileCount, itemArrayVersions[MODULEI],headerFP, "DEFCLASS_MODULE",ModulePrefix(ObjectCompilerData(theEnv)->ObjectCodeItem), itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]); if (itemFiles[MODULEI] == NULL) goto ObjectCodeError; DefclassModuleToCode(theEnv,itemFiles[MODULEI],theModule,imageID,maxIndices); itemFiles[MODULEI] = CloseFileIfNeeded(theEnv,itemFiles[MODULEI],&itemArrayCounts[MODULEI], &itemArrayVersions[MODULEI],maxIndices, &itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]); for (theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL) ; theDefclass != NULL ; theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) theDefclass)) { itemFiles[CLASSI] = OpenFileIfNeeded(theEnv,itemFiles[CLASSI],fileName,fileID,imageID,&fileCount, itemArrayVersions[CLASSI],headerFP, "DEFCLASS",ClassPrefix(), itemReopenFlags[CLASSI],&itemCodeFiles[CLASSI]); if (itemFiles[CLASSI] == NULL) goto ObjectCodeError; SingleDefclassToCode(theEnv,itemFiles[CLASSI],imageID,maxIndices, theDefclass,moduleCount, itemArrayVersions[LINKI],itemArrayCounts[LINKI], itemArrayVersions[SLOTI],itemArrayCounts[SLOTI], itemArrayVersions[TSLOTI],itemArrayCounts[TSLOTI], itemArrayVersions[OSLOTI],itemArrayCounts[OSLOTI], itemArrayVersions[HANDLERI],itemArrayCounts[HANDLERI], itemArrayVersions[OHANDLERI],itemArrayCounts[OHANDLERI]); itemArrayCounts[CLASSI]++; itemFiles[CLASSI] = CloseFileIfNeeded(theEnv,itemFiles[CLASSI],&itemArrayCounts[CLASSI], &itemArrayVersions[CLASSI],maxIndices, &itemReopenFlags[CLASSI],&itemCodeFiles[CLASSI]); if (InheritanceLinksToCode(theEnv,&itemFiles[LINKI],fileName,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[LINKI],&itemArrayCounts[LINKI], &itemReopenFlags[LINKI],&itemCodeFiles[LINKI]) == FALSE) goto ObjectCodeError; if (SlotsToCode(theEnv,&itemFiles[SLOTI],fileName,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[SLOTI],&itemArrayCounts[SLOTI], &itemReopenFlags[SLOTI],&itemCodeFiles[SLOTI]) == FALSE) goto ObjectCodeError; if (TemplateSlotsToCode(theEnv,&itemFiles[TSLOTI],fileName,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[TSLOTI],&itemArrayCounts[TSLOTI], &itemReopenFlags[TSLOTI],&itemCodeFiles[TSLOTI]) == FALSE) goto ObjectCodeError; if (OrderedSlotsToCode(theEnv,&itemFiles[OSLOTI],fileName,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[OSLOTI],&itemArrayCounts[OSLOTI], &itemReopenFlags[OSLOTI],&itemCodeFiles[OSLOTI]) == FALSE) goto ObjectCodeError; if (HandlersToCode(theEnv,&itemFiles[HANDLERI],fileName,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[HANDLERI],&itemArrayCounts[HANDLERI], &itemReopenFlags[HANDLERI],&itemCodeFiles[HANDLERI]) == FALSE) goto ObjectCodeError; if (OrderedHandlersToCode(theEnv,&itemFiles[OHANDLERI],fileName,fileID,imageID, headerFP,&fileCount,maxIndices,theDefclass, &itemArrayVersions[OHANDLERI],&itemArrayCounts[OHANDLERI], &itemReopenFlags[OHANDLERI],&itemCodeFiles[OHANDLERI]) == FALSE) goto ObjectCodeError; } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; itemArrayCounts[MODULEI]++; } CloseObjectFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices); return(1); ObjectCodeError: CloseObjectFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices); return(0); } /************************************************************ NAME : ClassIDMapToCode DESCRIPTION : Writes out class id map INPUTS : 1) Header file pointer 2) Output file pointer 3) The construct set image id 4) The max # of allowed indices 5) Caller's file count buffer RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Class ID Map and Max Indices Written NOTES : None ***********************************************************/ static int ClassIDMapToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { FILE *classIDMapFile = NULL; int classIDMapArrayCount, classIDMapArrayVersion = 1; classIDMapFile = OpenFileIfNeeded(theEnv,classIDMapFile,fileName,fileID,imageID,fileCount, classIDMapArrayVersion,headerFP, "DEFCLASS *",ClassIDPrefix(),FALSE,NULL); if (classIDMapFile == NULL) return(FALSE); for (classIDMapArrayCount = 0 ; classIDMapArrayCount < DefclassData(theEnv)->MaxClassID ; classIDMapArrayCount++) { if (classIDMapArrayCount > 0) fprintf(classIDMapFile,",\n"); PrintClassReference(theEnv,classIDMapFile,DefclassData(theEnv)->ClassIDMap[classIDMapArrayCount], imageID,maxIndices); } fprintf(classIDMapFile,"};\n\n"); fprintf(classIDMapFile,"unsigned %s%d = %u;\n", MaxClassIDPrefix(),imageID,(unsigned) DefclassData(theEnv)->MaxClassID); fprintf(headerFP,"extern unsigned %s%d;\n",MaxClassIDPrefix(),imageID); GenClose(theEnv,classIDMapFile); return(TRUE); } /************************************************************ NAME : ClassHashTableToCode DESCRIPTION : Writes out class hash table INPUTS : 1) Header file pointer 2) Output file pointer 3) The construct set image id 4) The max # of allowed indices 5) Caller's file count buffer RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Class Hash Table Written NOTES : None ***********************************************************/ static int ClassHashTableToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { FILE *classHashFile = NULL; int classHashArrayCount, classHashArrayVersion = 1; classHashFile = OpenFileIfNeeded(theEnv,classHashFile,fileName,fileID,imageID,fileCount, classHashArrayVersion,headerFP, "DEFCLASS *",ClassHashPrefix(),FALSE,NULL); if (classHashFile == NULL) return(FALSE); for (classHashArrayCount = 0 ; classHashArrayCount < CLASS_TABLE_HASH_SIZE ; classHashArrayCount++) { if (classHashArrayCount > 0) fprintf(classHashFile,",\n"); PrintClassReference(theEnv,classHashFile,DefclassData(theEnv)->ClassTable[classHashArrayCount], imageID,maxIndices); } CloseFileIfNeeded(theEnv,classHashFile,&classHashArrayCount, &classHashArrayVersion,classHashArrayCount,NULL,NULL); return(TRUE); } /************************************************************ NAME : SlotNameHashTableToCode DESCRIPTION : Writes out slot name entry hash table INPUTS : 1) Header file pointer 2) Output file pointer 3) The construct set image id 4) The max # of allowed indices 5) Caller's version number buffer RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slot Name Hash Table Written NOTES : None ***********************************************************/ static int SlotNameHashTableToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { FILE *slotNameHashFile = NULL; int slotNameHashArrayCount, slotNameHashArrayVersion = 1; slotNameHashFile = OpenFileIfNeeded(theEnv,slotNameHashFile,fileName,fileID, imageID,fileCount, slotNameHashArrayVersion,headerFP, "SLOT_NAME *",SlotNameHashPrefix(),FALSE,NULL); if (slotNameHashFile == NULL) return(FALSE); for (slotNameHashArrayCount = 0 ; slotNameHashArrayCount < SLOT_NAME_TABLE_HASH_SIZE ; slotNameHashArrayCount++) { if (slotNameHashArrayCount > 0) fprintf(slotNameHashFile,",\n"); PrintSlotNameReference(theEnv,slotNameHashFile,DefclassData(theEnv)->SlotNameTable[slotNameHashArrayCount], imageID,maxIndices); } CloseFileIfNeeded(theEnv,slotNameHashFile,&slotNameHashArrayCount, &slotNameHashArrayVersion,slotNameHashArrayCount, NULL,NULL); return(TRUE); } /************************************************************ NAME : SlotNameEntriesToCode DESCRIPTION : Writes out slot name entries INPUTS : 1) Header file pointer 2) Output file pointer 3) The construct set image id 4) The max # of allowed indices 5) Caller's version number buffer RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slot name entries Written NOTES : None ***********************************************************/ static int SlotNameEntriesToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices, int *fileCount) { FILE *slotNameFile = NULL; int slotNameArrayCount = 0, slotNameArrayVersion = 1; SLOT_NAME *snp; register unsigned i; for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) { for (snp = DefclassData(theEnv)->SlotNameTable[i] ; snp != NULL ; snp = snp->nxt) { slotNameFile = OpenFileIfNeeded(theEnv,slotNameFile,fileName,fileID, imageID,fileCount, slotNameArrayVersion,headerFP, "SLOT_NAME",SlotNamePrefix(),FALSE,NULL); if (slotNameFile == NULL) return(FALSE); fprintf(slotNameFile,"{ %u,1,%u,",snp->hashTableIndex,snp->id); PrintSymbolReference(theEnv,slotNameFile,snp->name); fprintf(slotNameFile,","); PrintSymbolReference(theEnv,slotNameFile,snp->putHandlerName); fprintf(slotNameFile,","); PrintSlotNameReference(theEnv,slotNameFile,snp->nxt,imageID,maxIndices); fprintf(slotNameFile,",0L }"); slotNameArrayCount++; slotNameFile = CloseFileIfNeeded(theEnv,slotNameFile,&slotNameArrayCount, &slotNameArrayVersion,maxIndices,NULL,NULL); } } if (slotNameFile != NULL) CloseFileIfNeeded(theEnv,slotNameFile,&slotNameArrayCount, &slotNameArrayVersion,slotNameArrayCount,NULL,NULL); return(TRUE); } /****************************************************** NAME : CloseObjectFiles DESCRIPTION : Closes construct compiler files for defclass structures INPUTS : 1) An array containing all the pertinent file pointers 2) An array containing all the pertinent file reopen flags 3) An array containing all the pertinent file name/id/version info 4) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Files closed NOTES : None *****************************************************/ static void CloseObjectFiles( void *theEnv, FILE *itemFiles[SAVE_ITEMS], int itemReopenFlags[SAVE_ITEMS], struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS], int maxIndices) { int count = maxIndices; int arrayVersion = 0; register int i; for (i = 0 ; i < SAVE_ITEMS ; i++) { count = maxIndices; itemFiles[i] = CloseFileIfNeeded(theEnv,itemFiles[i],&count,&arrayVersion, maxIndices,&itemReopenFlags[i], &itemCodeFiles[i]); } } /*************************************************** NAME : DefclassModuleToCode DESCRIPTION : Writes out the C values for a defclass module item INPUTS : 1) The output file 2) The module for the defclasses 3) The compile image id 4) The maximum number of elements in an array RETURNS : Nothing useful SIDE EFFECTS : Defclass module item written NOTES : None ***************************************************/ static void DefclassModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices) { fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefclassData(theEnv)->DefclassModuleIndex,ClassPrefix()); fprintf(theFile,"}"); } /**************************************************************** NAME : SingleDefclassToCode DESCRIPTION : Writes out a single defclass's data to the file INPUTS : 1) The output file 2) The compile image id 3) The maximum number of elements in an array 4) The defclass 5) The module index 6) The partition holding the defclass inheritance links 7) The relative index of the inheritance links in the partition 8) The partition holding the defclass slots 9) The relative index of the slots in the partition 10) The partition holding the defclass template slots 11) The relative index of the template slots in the partition 12) The partition holding the defclass ordered slot map 13) The relative index of the ordered slot map in the partition 14) The partition holding the defclass message-handlers 15) The relative index of the message-handlers in the partition 16) The partition holding the defclass ordered handler map 17) The relative index of the ordered handler map in the partition RETURNS : Nothing useful SIDE EFFECTS : Defclass data written NOTES : None ***************************************************************/ static void SingleDefclassToCode( void *theEnv, FILE *theFile, int imageID, int maxIndices, DEFCLASS *theDefclass, int moduleCount, int classLinkArrayVersion, int classLinkArrayCount, int slotArrayVersion, int slotArrayCount, int templateSlotArrayVersion, int templateSlotArrayCount, int orderedSlotArrayVersion, int orderedSlotArrayCount, int handlerArrayVersion, int handlerArrayCount, int orderedHandlerArrayVersion, int orderedHandlerArrayCount) { /* ================== Defclass Header ================== */ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefclass->header,imageID,maxIndices,moduleCount, ModulePrefix(ObjectCompilerData(theEnv)->ObjectCodeItem),ClassPrefix()); /* ========================= Defclass specific data ========================= */ fprintf(theFile,",1,%u,%u,%u,0,0,%u,0,%u,\n ", theDefclass->system,theDefclass->abstract, theDefclass->reactive,(unsigned) theDefclass->id, theDefclass->hashTableIndex); if (theDefclass->directSuperclasses.classCount > 0) fprintf(theFile,"{ %u,&%s%d_%d[%d] },", (unsigned) theDefclass->directSuperclasses.classCount, ClassLinkPrefix(), imageID,classLinkArrayVersion,classLinkArrayCount); else fprintf(theFile,"{ 0,NULL },"); classLinkArrayCount += theDefclass->directSuperclasses.classCount; if (theDefclass->directSubclasses.classCount > 0) fprintf(theFile,"{ %u,&%s%d_%d[%d] },", (unsigned) theDefclass->directSubclasses.classCount, ClassLinkPrefix(), imageID,classLinkArrayVersion,classLinkArrayCount); else fprintf(theFile,"{ 0,NULL },"); classLinkArrayCount += theDefclass->directSubclasses.classCount; if (theDefclass->allSuperclasses.classCount > 0) fprintf(theFile,"{ %u,&%s%d_%d[%d] },", (unsigned) theDefclass->allSuperclasses.classCount, ClassLinkPrefix(), imageID,classLinkArrayVersion,classLinkArrayCount); else fprintf(theFile,"{ 0,NULL },\n "); if (theDefclass->slots != NULL) fprintf(theFile,"&%s%d_%d[%d],", SlotPrefix(),imageID, slotArrayVersion,slotArrayCount); else fprintf(theFile,"NULL,"); if (theDefclass->instanceTemplate != NULL) fprintf(theFile,"&%s%d_%d[%d],", TemplateSlotPrefix(),imageID, templateSlotArrayVersion,templateSlotArrayCount); else fprintf(theFile,"NULL,"); if (theDefclass->slotNameMap != NULL) fprintf(theFile,"&%s%d_%d[%d],", OrderedSlotPrefix(),imageID, orderedSlotArrayVersion,orderedSlotArrayCount); else fprintf(theFile,"NULL,"); fprintf(theFile,"%u,%u,%u,%u,NULL,NULL,\n ", theDefclass->slotCount,theDefclass->localInstanceSlotCount, theDefclass->instanceSlotCount,theDefclass->maxSlotNameID); if (theDefclass->handlers != NULL) fprintf(theFile,"&%s%d_%d[%d],", HandlerPrefix(),imageID, handlerArrayVersion,handlerArrayCount); else fprintf(theFile,"NULL,"); if (theDefclass->handlerOrderMap != NULL) fprintf(theFile,"&%s%d_%d[%d],", OrderedHandlerPrefix(),imageID, orderedHandlerArrayVersion,orderedHandlerArrayCount); else fprintf(theFile,"NULL,"); fprintf(theFile,"%u,",theDefclass->handlerCount); PrintClassReference(theEnv,theFile,theDefclass->nxtHash,imageID,maxIndices); fprintf(theFile,","); PrintBitMapReference(theEnv,theFile,theDefclass->scopeMap); fprintf(theFile,",\"\"}"); } /*********************************************************** NAME : InheritanceLinksToCode DESCRIPTION : Prints out superclass/subclass inheritance links - all links for a particular class are guaranteed to be in the same array partition INPUTS : 1) A buffer for the inheritance links file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the links partition # 10) A buffer holding the links relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Inheritance links written NOTES : None ***********************************************************/ static intBool InheritanceLinksToCode( void *theEnv, FILE **classLinkFile, char *fileName, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *classLinkArrayVersion, int *classLinkArrayCount, int *reopenClassLinkFile, struct CodeGeneratorFile *classLinkCodeFile) { register unsigned i; int inheritanceLinkCount, linkPrinted = FALSE; inheritanceLinkCount = theDefclass->directSuperclasses.classCount + theDefclass->directSubclasses.classCount + theDefclass->allSuperclasses.classCount; if (inheritanceLinkCount == 0) return(TRUE); *classLinkFile = OpenFileIfNeeded(theEnv,*classLinkFile,fileName,fileID, imageID,fileCount, *classLinkArrayVersion,headerFP, "DEFCLASS *",ClassLinkPrefix(), *reopenClassLinkFile,classLinkCodeFile); if (*classLinkFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->directSuperclasses.classCount ; i++) { if (linkPrinted) fprintf(*classLinkFile,","); PrintClassReference(theEnv,*classLinkFile, theDefclass->directSuperclasses.classArray[i], imageID,maxIndices); linkPrinted = TRUE; } for (i = 0 ; i < theDefclass->directSubclasses.classCount ; i++) { if (linkPrinted) fprintf(*classLinkFile,","); PrintClassReference(theEnv,*classLinkFile, theDefclass->directSubclasses.classArray[i], imageID,maxIndices); linkPrinted = TRUE; } for (i = 0 ; i < theDefclass->allSuperclasses.classCount ; i++) { if (linkPrinted) fprintf(*classLinkFile,","); PrintClassReference(theEnv,*classLinkFile, theDefclass->allSuperclasses.classArray[i], imageID,maxIndices); linkPrinted = TRUE; } *classLinkArrayCount += inheritanceLinkCount; *classLinkFile = CloseFileIfNeeded(theEnv,*classLinkFile,classLinkArrayCount, classLinkArrayVersion,maxIndices, reopenClassLinkFile,classLinkCodeFile); return(TRUE); } /*********************************************************** NAME : SlotsToCode DESCRIPTION : Prints out slots - all slots for a particular class are guaranteed to be in the same array partition INPUTS : 1) A buffer for the slots file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the slots partition # 10) A buffer holding the slots relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slots written NOTES : None ***********************************************************/ static intBool SlotsToCode( void *theEnv, FILE **slotFile, char *fileName, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *slotArrayVersion, int *slotArrayCount, int *reopenSlotFile, struct CodeGeneratorFile *slotCodeFile) { register unsigned i; SLOT_DESC *sd; EXPRESSION *tmpexp; PACKED_LOCATION_INFO theLocationInfo; if (theDefclass->slotCount == 0) return(TRUE); *slotFile = OpenFileIfNeeded(theEnv,*slotFile,fileName,fileID, imageID,fileCount, *slotArrayVersion,headerFP, "SLOT_DESC",SlotPrefix(), *reopenSlotFile,slotCodeFile); if (*slotFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->slotCount ; i++) { sd = &theDefclass->slots[i]; if (i > 0) fprintf(*slotFile,",\n"); fprintf(*slotFile,"{ %u,%u,%u,%u,%u,%u,%u,%u,%u,%u,%u,%u,%u,%u,", sd->shared,sd->multiple, sd->composite,sd->noInherit, sd->noWrite,sd->initializeOnly, sd->dynamicDefault,sd->defaultSpecified, sd->noDefault,sd->reactive, sd->publicVisibility,sd->createReadAccessor, sd->createWriteAccessor,sd->overrideMessageSpecified); PrintClassReference(theEnv,*slotFile,sd->cls,imageID,maxIndices); fprintf(*slotFile,","); PrintSlotNameReference(theEnv,*slotFile,sd->slotName,imageID,maxIndices); fprintf(*slotFile,",\n "); PrintSymbolReference(theEnv,*slotFile,sd->overrideMessage); if (sd->defaultValue != NULL) { fprintf(*slotFile,",(void *) "); if (sd->dynamicDefault) ExpressionToCode(theEnv,*slotFile,(EXPRESSION *) sd->defaultValue); else { tmpexp = ConvertValueToExpression(theEnv,(DATA_OBJECT *) sd->defaultValue); ExpressionToCode(theEnv,*slotFile,tmpexp); ReturnExpression(theEnv,tmpexp); } } else fprintf(*slotFile,",NULL"); fprintf(*slotFile,","); PrintConstraintReference(theEnv,*slotFile,sd->constraint,imageID,maxIndices); fprintf(*slotFile,",0,0L,"); if (sd->shared) { theLocationInfo.theLong = sd->sharedValue.desc->bsaveIndex; fprintf(*slotFile,"{ &%s%d_%u[%u],0,0,0,NULL } }", SlotPrefix(),imageID, theLocationInfo.theLocation.thePartition, theLocationInfo.theLocation.theOffset); } else fprintf(*slotFile,"{ NULL,0,0,0,NULL } }"); } *slotArrayCount += (int) theDefclass->slotCount; *slotFile = CloseFileIfNeeded(theEnv,*slotFile,slotArrayCount, slotArrayVersion,maxIndices, reopenSlotFile,slotCodeFile); return(TRUE); } /************************************************************* NAME : TemplateSlotsToCode DESCRIPTION : Prints out instance template - the entire instance slot template for a particular class is guaranteed to be in the same array partition INPUTS : 1) A buffer for the template file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the template partition # 10) A buffer holding the template relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Templates written NOTES : None *************************************************************/ static intBool TemplateSlotsToCode( void *theEnv, FILE **templateSlotFile, char *fileName, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *templateSlotArrayVersion, int *templateSlotArrayCount, int *reopenTemplateSlotFile, struct CodeGeneratorFile *templateSlotCodeFile) { register unsigned i; SLOT_DESC *sd; PACKED_LOCATION_INFO theLocationInfo; if (theDefclass->instanceSlotCount == 0) return(TRUE); *templateSlotFile = OpenFileIfNeeded(theEnv,*templateSlotFile,fileName,fileID, imageID,fileCount, *templateSlotArrayVersion,headerFP, "SLOT_DESC *",TemplateSlotPrefix(), *reopenTemplateSlotFile,templateSlotCodeFile); if (*templateSlotFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->instanceSlotCount ; i++) { sd = theDefclass->instanceTemplate[i]; if (i > 0) fprintf(*templateSlotFile,","); theLocationInfo.theLong = sd->bsaveIndex; fprintf(*templateSlotFile,"&%s%d_%u[%u]", SlotPrefix(),imageID, theLocationInfo.theLocation.thePartition, theLocationInfo.theLocation.theOffset); } *templateSlotArrayCount += (int) theDefclass->instanceSlotCount; *templateSlotFile = CloseFileIfNeeded(theEnv,*templateSlotFile,templateSlotArrayCount, templateSlotArrayVersion,maxIndices, reopenTemplateSlotFile,templateSlotCodeFile); return(TRUE); } /************************************************************* NAME : OrderedSlotsToCode DESCRIPTION : Prints out slot name map - the entire slot name map for a particular class is guaranteed to be in the same array partition INPUTS : 1) A buffer for the slot map file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the slot map partition # 10) A buffer holding the slot map relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slot maps written NOTES : None *************************************************************/ static intBool OrderedSlotsToCode( void *theEnv, FILE **orderedSlotFile, char *fileName, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *orderedSlotArrayVersion, int *orderedSlotArrayCount, int *reopenOrderedSlotFile, struct CodeGeneratorFile *orderedSlotCodeFile) { register unsigned i; if (theDefclass->instanceSlotCount == 0) return(TRUE); *orderedSlotFile = OpenFileIfNeeded(theEnv,*orderedSlotFile,fileName,fileID, imageID,fileCount, *orderedSlotArrayVersion,headerFP, "unsigned",OrderedSlotPrefix(), *reopenOrderedSlotFile,orderedSlotCodeFile); if (*orderedSlotFile == NULL) return(FALSE); for (i = 0 ; i <= theDefclass->maxSlotNameID ; i++) { if (i > 0) fprintf(*orderedSlotFile,","); fprintf(*orderedSlotFile,"%u",theDefclass->slotNameMap[i]); } *orderedSlotArrayCount += (int) theDefclass->maxSlotNameID + 1; *orderedSlotFile = CloseFileIfNeeded(theEnv,*orderedSlotFile,orderedSlotArrayCount, orderedSlotArrayVersion,maxIndices, reopenOrderedSlotFile,orderedSlotCodeFile); return(TRUE); } /************************************************************* NAME : HandlersToCode DESCRIPTION : Prints out message-handlers - all message-handlers for a particular class are guaranteed to be in the same array partition INPUTS : 1) A buffer for the handler file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the handler partition # 10) A buffer holding the handler relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handlers written NOTES : None *************************************************************/ static intBool HandlersToCode( void *theEnv, FILE **handlerFile, char *fileName, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *handlerArrayVersion, int *handlerArrayCount, int *reopenHandlerFile, struct CodeGeneratorFile *handlerCodeFile) { register unsigned i; HANDLER *hnd; if (theDefclass->handlerCount == 0) return(TRUE); *handlerFile = OpenFileIfNeeded(theEnv,*handlerFile,fileName,fileID, imageID,fileCount, *handlerArrayVersion,headerFP, "HANDLER",HandlerPrefix(),*reopenHandlerFile, handlerCodeFile); if (*handlerFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->handlerCount ; i++) { if (i > 0) fprintf(*handlerFile,",\n"); hnd = &theDefclass->handlers[i]; fprintf(*handlerFile,"{ %u,%u,0,0,0,",hnd->system,hnd->type); PrintSymbolReference(theEnv,*handlerFile,hnd->name); fprintf(*handlerFile,","); PrintClassReference(theEnv,*handlerFile,hnd->cls,imageID,maxIndices); fprintf(*handlerFile,",%d,%d,%d,",hnd->minParams,hnd->maxParams, hnd->localVarCount); ExpressionToCode(theEnv,*handlerFile,hnd->actions); fprintf(*handlerFile,",NULL }"); } *handlerArrayCount += (int) theDefclass->handlerCount; *handlerFile = CloseFileIfNeeded(theEnv,*handlerFile,handlerArrayCount, handlerArrayVersion,maxIndices, reopenHandlerFile,handlerCodeFile); return(TRUE); } /**************************************************************** NAME : OrderedHandlersToCode DESCRIPTION : Prints out handler map - the entire handler map for a particular class is guaranteed to be in the same array partition INPUTS : 1) A buffer for the handler map file 2) The base image name 3) The id for this type of data 4) The base image id 5) The general header file 6) A buffer for the version number of the file for this type of data 7) The maximum # of elements in any array 8) A pointer to the class 9) A buffer holding the handler map partition # 10) A buffer holding the handler map relative index in the partition 11) A buffer for a flag indicating if the buffer file can be reopened later 12) A pointer to the file info for this data if the last file needs to be reopened for termination RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Handler maps written NOTES : None ****************************************************************/ static intBool OrderedHandlersToCode( void *theEnv, FILE **orderedHandlerFile, char *fileName, int fileID, int imageID, FILE *headerFP, int *fileCount, int maxIndices, DEFCLASS *theDefclass, int *orderedHandlerArrayVersion, int *orderedHandlerArrayCount, int *reopenOrderedHandlerFile, struct CodeGeneratorFile *orderedHandlerCodeFile) { register unsigned i; if (theDefclass->handlerCount == 0) return(TRUE); *orderedHandlerFile = OpenFileIfNeeded(theEnv,*orderedHandlerFile,fileName,fileID, imageID,fileCount, *orderedHandlerArrayVersion,headerFP, "unsigned",OrderedHandlerPrefix(), *reopenOrderedHandlerFile, orderedHandlerCodeFile); if (*orderedHandlerFile == NULL) return(FALSE); for (i = 0 ; i < theDefclass->handlerCount ; i++) { if (i > 0) fprintf(*orderedHandlerFile,","); fprintf(*orderedHandlerFile,"%u",theDefclass->handlerOrderMap[i]); } *orderedHandlerArrayCount += (int) theDefclass->handlerCount; *orderedHandlerFile = CloseFileIfNeeded(theEnv,*orderedHandlerFile,orderedHandlerArrayCount, orderedHandlerArrayVersion,maxIndices, reopenOrderedHandlerFile, orderedHandlerCodeFile); return(TRUE); } #endif clips-6.24/clipssrc/bmathfun.h0000755000175000017500000000546610441127760014524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* BASIC MATH FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_bmathfun #define _H_bmathfun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _BMATHFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetAutoFloatDividend(theEnv) EnvGetAutoFloatDividend(theEnv) #define SetAutoFloatDividend(theEnv,a) EnvSetAutoFloatDividend(theEnv,a) #else #define GetAutoFloatDividend() EnvGetAutoFloatDividend(GetCurrentEnvironment()) #define SetAutoFloatDividend(a) EnvSetAutoFloatDividend(GetCurrentEnvironment(),a) #endif LOCALE void BasicMathFunctionDefinitions(void *); LOCALE void AdditionFunction(void *,DATA_OBJECT_PTR); LOCALE void MultiplicationFunction(void *,DATA_OBJECT_PTR); LOCALE void SubtractionFunction(void *,DATA_OBJECT_PTR); LOCALE void DivisionFunction(void *,DATA_OBJECT_PTR); LOCALE long DivFunction(void *); LOCALE intBool SetAutoFloatDividendCommand(void *); LOCALE intBool GetAutoFloatDividendCommand(void *); LOCALE intBool EnvGetAutoFloatDividend(void *); LOCALE intBool EnvSetAutoFloatDividend(void *,int); LOCALE long int IntegerFunction(void *); LOCALE double FloatFunction(void *); LOCALE void AbsFunction(void *,DATA_OBJECT_PTR); LOCALE void MinFunction(void *,DATA_OBJECT_PTR); LOCALE void MaxFunction(void *,DATA_OBJECT_PTR); #endif clips-6.24/clipssrc/._retract.h0000400000175000017500000000075410441162535014556 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH MonacoBxBxQA,TTF/BFMPSRMWBBLclips-6.24/clipssrc/._setup.h0000400000175000017500000000100410444326264014243 0ustar jfsjfsMac OS X  2 RTEXT????XXZH Monaco;6i;6im? ?3XXZs`xZMWBBMPSR&CSta2T'\clips-6.24/clipssrc/immthpsr.h0000755000175000017500000000270407422635001014550 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_immthpsr #define _H_immthpsr #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #include "genrcfun.h" #ifdef LOCALE #undef LOCALE #endif #ifdef _IMMTHPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void AddImplicitMethods(void *,DEFGENERIC *); #ifndef _IMMTHPSR_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/._objbin.h0000400000175000017500000000012207422634572014354 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._msgcom.h0000400000175000017500000000012207422634537014377 0ustar jfsjfsMac OS X  2 RTEXT????`clips-6.24/clipssrc/watch.c0000755000175000017500000004674610443631620014024 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* WATCH MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Support functions for the watch and unwatch */ /* commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian Donnell */ /* */ /* Revision History: */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EnvSetWatchItem function. */ /* */ /*************************************************************/ #define _WATCH_SOURCE_ #include "setup.h" #if DEBUGGING_FUNCTIONS #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "argacces.h" #include "extnfunc.h" #include "watch.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct watchItem *ValidWatchItem(void *,char *,int *); static intBool RecognizeWatchRouters(void *,char *); static int CaptureWatchPrints(void *,char *,char *); static void DeallocateWatchData(void *); /**********************************************/ /* InitializeWatchData: Allocates environment */ /* data for watch items. */ /**********************************************/ globle void InitializeWatchData( void *theEnv) { AllocateEnvironmentData(theEnv,WATCH_DATA,sizeof(struct watchData),DeallocateWatchData); } /************************************************/ /* DeallocateWatchData: Deallocates environment */ /* data for watch items. */ /************************************************/ static void DeallocateWatchData( void *theEnv) { struct watchItem *tmpPtr, *nextPtr; tmpPtr = WatchData(theEnv)->ListOfWatchItems; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,watchItem,tmpPtr); tmpPtr = nextPtr; } } /*************************************************************/ /* AddWatchItem: Adds an item to the list of watchable items */ /* that can be set using the watch and unwatch commands. */ /* Returns FALSE if the item is already in the list, */ /* otherwise returns TRUE. */ /*************************************************************/ globle intBool AddWatchItem( void *theEnv, char *name, int code, unsigned *flag, int priority, unsigned (*accessFunc)(void *,int,unsigned,struct expr *), unsigned (*printFunc)(void *,char *,int,struct expr *)) { struct watchItem *newPtr, *currentPtr, *lastPtr; /*================================================================*/ /* Find the insertion point in the watchable items list to place */ /* the new item. If the item is already in the list return FALSE. */ /*================================================================*/ for (currentPtr = WatchData(theEnv)->ListOfWatchItems, lastPtr = NULL; currentPtr != NULL; currentPtr = currentPtr->next) { if (strcmp(currentPtr->name,name) == 0) return(FALSE); if (priority < currentPtr->priority) lastPtr = currentPtr; } /*============================*/ /* Create the new watch item. */ /*============================*/ newPtr = get_struct(theEnv,watchItem); newPtr->name = name; newPtr->flag = flag; newPtr->code = code; newPtr->priority = priority; newPtr->accessFunc = accessFunc; newPtr->printFunc = printFunc; /*=================================================*/ /* Insert the new item in the list of watch items. */ /*=================================================*/ if (lastPtr == NULL) { newPtr->next = WatchData(theEnv)->ListOfWatchItems; WatchData(theEnv)->ListOfWatchItems = newPtr; } else { newPtr->next = lastPtr->next; lastPtr->next = newPtr; } /*==================================================*/ /* Return TRUE to indicate the item has been added. */ /*==================================================*/ return(TRUE); } /*****************************************************/ /* EnvWatch: C access routine for the watch command. */ /*****************************************************/ globle intBool EnvWatch( void *theEnv, char *itemName) { return(EnvSetWatchItem(theEnv,itemName,ON,NULL)); } /*********************************************************/ /* EnvUnwatch: C access routine for the unwatch command. */ /*********************************************************/ globle intBool EnvUnwatch( void *theEnv, char *itemName) { return(EnvSetWatchItem(theEnv,itemName,OFF,NULL)); } /***********************************************************************/ /* EnvSetWatchItem: Sets the state of a specified watch item to either */ /* on or off. Returns TRUE if the item was set, otherwise FALSE. */ /***********************************************************************/ globle int EnvSetWatchItem( void *theEnv, char *itemName, unsigned newState, struct expr *argExprs) { struct watchItem *wPtr; /*======================================================*/ /* If the new state isn't on or off, then return FALSE. */ /*======================================================*/ if ((newState != ON) && (newState != OFF)) return(FALSE); /*===================================================*/ /* If the name of the watch item to set is all, then */ /* all watch items are set to the new state and TRUE */ /* is returned. */ /*===================================================*/ if (strcmp(itemName,"all") == 0) { for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { /*==============================================*/ /* If no specific arguments are specified, then */ /* set the global flag for the watch item. */ /*==============================================*/ if (argExprs == NULL) *(wPtr->flag) = newState; /*=======================================*/ /* Set flags for individual watch items. */ /*=======================================*/ if ((wPtr->accessFunc == NULL) ? FALSE : ((*wPtr->accessFunc)(theEnv,wPtr->code,newState,argExprs) == FALSE)) { SetEvaluationError(theEnv,TRUE); return(FALSE); } } return(TRUE); } /*=================================================*/ /* Search for the watch item to be set in the list */ /* of watch items. If found, set the watch item to */ /* its new state and return TRUE. */ /*=================================================*/ for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { if (strcmp(itemName,wPtr->name) == 0) { /*==============================================*/ /* If no specific arguments are specified, then */ /* set the global flag for the watch item. */ /*==============================================*/ if (argExprs == NULL) *(wPtr->flag) = newState; /*=======================================*/ /* Set flags for individual watch items. */ /*=======================================*/ if ((wPtr->accessFunc == NULL) ? FALSE : ((*wPtr->accessFunc)(theEnv,wPtr->code,newState,argExprs) == FALSE)) { SetEvaluationError(theEnv,TRUE); return(FALSE); } return(TRUE); } } /*=================================================*/ /* If the specified item was not found in the list */ /* of watchable items then return FALSE. */ /*=================================================*/ return(FALSE); } /******************************************************************/ /* EnvGetWatchItem: Gets the current state of the specified watch */ /* item. Returns the state of the watch item (0 for off and 1 */ /* for on) if the watch item is found in the list of watch */ /* items, otherwise -1 is returned. */ /******************************************************************/ globle int EnvGetWatchItem( void *theEnv, char *itemName) { struct watchItem *wPtr; for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { if (strcmp(itemName,wPtr->name) == 0) { return((int) *(wPtr->flag)); } } return(-1); } /****************************************************************/ /* ValidWatchItem: Returns TRUE if the specified name is found */ /* in the list of watch items, otherwise returns FALSE. */ /****************************************************************/ static struct watchItem *ValidWatchItem( void *theEnv, char *itemName, int *recognized) { struct watchItem *wPtr; *recognized = TRUE; if (strcmp(itemName,"all") == 0) return(NULL); for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { if (strcmp(itemName,wPtr->name) == 0) return(wPtr); } *recognized = FALSE; return(NULL); } /*************************************************************/ /* GetNthWatchName: Returns the name associated with the nth */ /* item in the list of watchable items. If the nth item */ /* does not exist, then NULL is returned. */ /*************************************************************/ globle char *GetNthWatchName( void *theEnv, int whichItem) { int i; struct watchItem *wPtr; for (wPtr = WatchData(theEnv)->ListOfWatchItems, i = 1; wPtr != NULL; wPtr = wPtr->next, i++) { if (i == whichItem) return(wPtr->name); } return(NULL); } /***************************************************************/ /* GetNthWatchValue: Returns the current state associated with */ /* the nth item in the list of watchable items. If the nth */ /* item does not exist, then -1 is returned. */ /***************************************************************/ globle int GetNthWatchValue( void *theEnv, int whichItem) { int i; struct watchItem *wPtr; for (wPtr = WatchData(theEnv)->ListOfWatchItems, i = 1; wPtr != NULL; wPtr = wPtr->next, i++) { if (i == whichItem) return((int) *(wPtr->flag)); } return(-1); } /**************************************/ /* WatchCommand: H/L access routine */ /* for the watch command. */ /**************************************/ globle void WatchCommand( void *theEnv) { DATA_OBJECT theValue; char *argument; int recognized; struct watchItem *wPtr; /*========================================*/ /* Determine which item is to be watched. */ /*========================================*/ if (EnvArgTypeCheck(theEnv,"watch",1,SYMBOL,&theValue) == FALSE) return; argument = DOToString(theValue); wPtr = ValidWatchItem(theEnv,argument,&recognized); if (recognized == FALSE) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"watch",1,"watchable symbol"); return; } /*=================================================*/ /* Check to make sure extra arguments are allowed. */ /*=================================================*/ if (GetNextArgument(GetFirstArgument()) != NULL) { if ((wPtr == NULL) ? TRUE : (wPtr->accessFunc == NULL)) { SetEvaluationError(theEnv,TRUE); ExpectedCountError(theEnv,"watch",EXACTLY,1); return; } } /*=====================*/ /* Set the watch item. */ /*=====================*/ EnvSetWatchItem(theEnv,argument,ON,GetNextArgument(GetFirstArgument())); } /****************************************/ /* UnwatchCommand: H/L access routine */ /* for the unwatch command. */ /****************************************/ globle void UnwatchCommand( void *theEnv) { DATA_OBJECT theValue; char *argument; int recognized; struct watchItem *wPtr; /*==========================================*/ /* Determine which item is to be unwatched. */ /*==========================================*/ if (EnvArgTypeCheck(theEnv,"unwatch",1,SYMBOL,&theValue) == FALSE) return; argument = DOToString(theValue); wPtr = ValidWatchItem(theEnv,argument,&recognized); if (recognized == FALSE) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"unwatch",1,"watchable symbol"); return; } /*=================================================*/ /* Check to make sure extra arguments are allowed. */ /*=================================================*/ if (GetNextArgument(GetFirstArgument()) != NULL) { if ((wPtr == NULL) ? TRUE : (wPtr->accessFunc == NULL)) { SetEvaluationError(theEnv,TRUE); ExpectedCountError(theEnv,"unwatch",EXACTLY,1); return; } } /*=====================*/ /* Set the watch item. */ /*=====================*/ EnvSetWatchItem(theEnv,argument,OFF,GetNextArgument(GetFirstArgument())); } /************************************************/ /* ListWatchItemsCommand: H/L access routines */ /* for the list-watch-items command. */ /************************************************/ globle void ListWatchItemsCommand( void *theEnv) { struct watchItem *wPtr; DATA_OBJECT theValue; int recognized; /*=======================*/ /* List the watch items. */ /*=======================*/ if (GetFirstArgument() == NULL) { for (wPtr = WatchData(theEnv)->ListOfWatchItems; wPtr != NULL; wPtr = wPtr->next) { EnvPrintRouter(theEnv,WDISPLAY,wPtr->name); if (*(wPtr->flag)) EnvPrintRouter(theEnv,WDISPLAY," = on\n"); else EnvPrintRouter(theEnv,WDISPLAY," = off\n"); } return; } /*=======================================*/ /* Determine which item is to be listed. */ /*=======================================*/ if (EnvArgTypeCheck(theEnv,"list-watch-items",1,SYMBOL,&theValue) == FALSE) return; wPtr = ValidWatchItem(theEnv,DOToString(theValue),&recognized); if ((recognized == FALSE) || (wPtr == NULL)) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"list-watch-items",1,"watchable symbol"); return; } /*=================================================*/ /* Check to make sure extra arguments are allowed. */ /*=================================================*/ if ((wPtr->printFunc == NULL) && (GetNextArgument(GetFirstArgument()) != NULL)) { SetEvaluationError(theEnv,TRUE); ExpectedCountError(theEnv,"list-watch-items",EXACTLY,1); return; } /*====================================*/ /* List the status of the watch item. */ /*====================================*/ EnvPrintRouter(theEnv,WDISPLAY,wPtr->name); if (*(wPtr->flag)) EnvPrintRouter(theEnv,WDISPLAY," = on\n"); else EnvPrintRouter(theEnv,WDISPLAY," = off\n"); /*============================================*/ /* List the status of individual watch items. */ /*============================================*/ if (wPtr->printFunc != NULL) { if ((*wPtr->printFunc)(theEnv,WDISPLAY,wPtr->code, GetNextArgument(GetFirstArgument())) == FALSE) { SetEvaluationError(theEnv,TRUE); } } } /*******************************************/ /* GetWatchItemCommand: H/L access routine */ /* for the get-watch-item command. */ /*******************************************/ globle int GetWatchItemCommand( void *theEnv) { DATA_OBJECT theValue; char *argument; int recognized; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"get-watch-item",EXACTLY,1) == -1) { return(FALSE); } /*========================================*/ /* Determine which item is to be watched. */ /*========================================*/ if (EnvArgTypeCheck(theEnv,"get-watch-item",1,SYMBOL,&theValue) == FALSE) { return(FALSE); } argument = DOToString(theValue); ValidWatchItem(theEnv,argument,&recognized); if (recognized == FALSE) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"get-watch-item",1,"watchable symbol"); return(FALSE); } /*===========================*/ /* Get the watch item value. */ /*===========================*/ if (EnvGetWatchItem(theEnv,argument) == 1) { return(TRUE); } return(FALSE); } /*************************************************************/ /* WatchFunctionDefinitions: Initializes the watch commands. */ /*************************************************************/ globle void WatchFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"watch", 'v', PTIEF WatchCommand, "WatchCommand", "1**w"); EnvDefineFunction2(theEnv,"unwatch", 'v', PTIEF UnwatchCommand, "UnwatchCommand", "1**w"); EnvDefineFunction2(theEnv,"get-watch-item", 'b', PTIEF GetWatchItemCommand, "GetWatchItemCommand", "11w"); EnvDefineFunction2(theEnv,"list-watch-items", 'v', PTIEF ListWatchItemsCommand, "ListWatchItemsCommand", "0**w"); #endif EnvAddRouter(theEnv,WTRACE,1000,RecognizeWatchRouters,CaptureWatchPrints,NULL,NULL,NULL); EnvDeactivateRouter(theEnv,WTRACE); } /**************************************************/ /* RecognizeWatchRouters: Looks for WTRACE prints */ /**************************************************/ #if IBM_TBC #pragma argsused #endif static intBool RecognizeWatchRouters( void *theEnv, char *logName) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (strcmp(logName,WTRACE) == 0) return(TRUE); return(FALSE); } /**************************************************/ /* CaptureWatchPrints: Suppresses WTRACE messages */ /**************************************************/ #if IBM_TBC #pragma argsused #endif static int CaptureWatchPrints( void *theEnv, char *logName, char *str) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(logName) #pragma unused(str) #pragma unused(theEnv) #endif return(1); } #endif /* DEBUGGING_FUNCTIONS */ clips-6.24/clipssrc/._sortfun.h0000400000175000017500000000012207422634727014613 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/cstrccom.h0000755000175000017500000001331310441602112014510 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* CONSTRUCT COMMAND HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added ConstructsDeletable function. */ /* */ /*************************************************************/ #ifndef _H_cstrccom #define _H_cstrccom #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRCCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if (! RUN_TIME) LOCALE void AddConstructToModule(struct constructHeader *); #endif LOCALE intBool DeleteNamedConstruct(void *,char *,struct construct *); LOCALE void *FindNamedConstruct(void *,char *,struct construct *); LOCALE void UndefconstructCommand(void *,char *,struct construct *); LOCALE int PPConstruct(void *,char *,char *,struct construct *); LOCALE SYMBOL_HN *GetConstructModuleCommand(void *,char *,struct construct *); LOCALE struct defmodule *GetConstructModule(void *,char *,struct construct *); LOCALE intBool Undefconstruct(void *,void *,struct construct *); LOCALE void SaveConstruct(void *,void *,char *,struct construct *); LOCALE char *GetConstructNameString(struct constructHeader *); LOCALE char *EnvGetConstructNameString(void *,struct constructHeader *); LOCALE char *GetConstructModuleName(struct constructHeader *); LOCALE SYMBOL_HN *GetConstructNamePointer(struct constructHeader *); LOCALE void GetConstructListFunction(void *,char *,DATA_OBJECT_PTR, struct construct *); LOCALE void GetConstructList(void *,DATA_OBJECT_PTR,struct construct *, struct defmodule *); LOCALE void ListConstructCommand(void *,char *,struct construct *); LOCALE void ListConstruct(void *,struct construct *,char *,struct defmodule *); LOCALE void SetNextConstruct(struct constructHeader *,struct constructHeader *); LOCALE struct defmoduleItemHeader *GetConstructModuleItem(struct constructHeader *); LOCALE char *GetConstructPPForm(void *,struct constructHeader *); LOCALE void PPConstructCommand(void *,char *,struct construct *); LOCALE struct constructHeader *GetNextConstructItem(void *,struct constructHeader *,int); LOCALE struct defmoduleItemHeader *GetConstructModuleItemByIndex(void *,struct defmodule *,int); LOCALE void FreeConstructHeaderModule(void *,struct defmoduleItemHeader *, struct construct *); LOCALE long DoForAllConstructs(void *, void (*)(void *,struct constructHeader *,void *), int,int,void *); LOCALE void DoForAllConstructsInModule(void *,void *, void (*)(void *,struct constructHeader *,void *), int,int,void *); LOCALE void InitializeConstructHeader(void *,char *,struct constructHeader *,SYMBOL_HN *); LOCALE void SetConstructPPForm(void *,struct constructHeader *,char *); LOCALE void *LookupConstruct(void *,struct construct *,char *,intBool); #if DEBUGGING_FUNCTIONS LOCALE unsigned ConstructPrintWatchAccess(void *,struct construct *,char *, EXPRESSION *, unsigned (*)(void *,void *), void (*)(void *,unsigned,void *)); LOCALE unsigned ConstructSetWatchAccess(void *,struct construct *,unsigned, EXPRESSION *, unsigned (*)(void *,void *), void (*)(void *,unsigned,void *)); #endif LOCALE intBool ConstructsDeletable(void *); #endif clips-6.24/clipssrc/._msgfun.h0000400000175000017500000000075410441150101014373 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0z0z:qTTFS &FMWBBMPSRclips-6.24/clipssrc/dfinscmp.c0000755000175000017500000002705107422634542014516 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Definstances Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFINSTANCES_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #include "conscomp.h" #include "envrnmnt.h" #include "defins.h" #define _DFINSCMP_SOURCE_ #include "dfinscmp.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void ReadyDefinstancesForCode(void *); static int DefinstancesToCode(void *,char *,int,FILE *,int,int); static void CloseDefinstancesFiles(void *,FILE *,FILE *,int); static void DefinstancesModuleToCode(void *,FILE *,struct defmodule *,int,int); static void SingleDefinstancesToCode(void *,FILE *,DEFINSTANCES *,int,int,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupDefinstancesCompiler DESCRIPTION : Initializes the construct compiler item for definstances INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Code generator item initialized NOTES : None ***************************************************/ globle void SetupDefinstancesCompiler( void *theEnv) { DefinstancesData(theEnv)->DefinstancesCodeItem = AddCodeGeneratorItem(theEnv,"definstances",0,ReadyDefinstancesForCode, NULL,DefinstancesToCode,2); } /**************************************************** NAME : DefinstancesCModuleReference DESCRIPTION : Prints out a reference to a definstances 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 : Definstances module reference printed NOTES : None ****************************************************/ globle void DefinstancesCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DefinstancesData(theEnv)->DefinstancesCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : ReadyDefinstancesForCode DESCRIPTION : Sets index of deffunctions for use in compiled expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : BsaveIndices set NOTES : None ***************************************************/ static void ReadyDefinstancesForCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DefinstancesData(theEnv)->DefinstancesModuleIndex); } /******************************************************* NAME : DefinstancesToCode DESCRIPTION : Writes out static array code for definstances 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 : -1 if no definstances, 0 on errors, 1 if definstances written SIDE EFFECTS : Code written to files NOTES : None *******************************************************/ static int DefinstancesToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; DEFINSTANCES *theDefinstances; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int definstancesArrayCount = 0, definstancesArrayVersion = 1; FILE *moduleFile = NULL, *definstancesFile = NULL; /* ================================================ Include the appropriate definstances header file ================================================ */ fprintf(headerFP,"#include \"defins.h\"\n"); /* ============================================================= Loop through all the modules and all the definstances writing their C code representation to the file as they are traversed ============================================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "DEFINSTANCES_MODULE",ModulePrefix(DefinstancesData(theEnv)->DefinstancesCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDefinstancesFiles(theEnv,moduleFile,definstancesFile,maxIndices); return(0); } DefinstancesModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); theDefinstances = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,NULL); while (theDefinstances != NULL) { definstancesFile = OpenFileIfNeeded(theEnv,definstancesFile,fileName,fileID,imageID,&fileCount, definstancesArrayVersion,headerFP, "DEFINSTANCES",ConstructPrefix(DefinstancesData(theEnv)->DefinstancesCodeItem), FALSE,NULL); if (definstancesFile == NULL) { CloseDefinstancesFiles(theEnv,moduleFile,definstancesFile,maxIndices); return(0); } SingleDefinstancesToCode(theEnv,definstancesFile,theDefinstances,imageID, maxIndices,moduleCount); definstancesArrayCount++; definstancesFile = CloseFileIfNeeded(theEnv,definstancesFile,&definstancesArrayCount, &definstancesArrayVersion,maxIndices,NULL,NULL); theDefinstances = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,theDefinstances); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; moduleArrayCount++; } CloseDefinstancesFiles(theEnv,moduleFile,definstancesFile,maxIndices); return(1); } /*************************************************** NAME : CloseDefinstancesFiles DESCRIPTION : Closes construct compiler files for definstances structures INPUTS : 1) The definstances module file 2) The definstances structure file 3) The maximum number of indices allowed in an array RETURNS : Nothing useful SIDE EFFECTS : Files closed NOTES : None ***************************************************/ static void CloseDefinstancesFiles( void *theEnv, FILE *moduleFile, FILE *definstancesFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (definstancesFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,definstancesFile,&count,&arrayVersion, maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /*************************************************** NAME : DefinstancesModuleToCode DESCRIPTION : Writes out the C values for a definstances module item INPUTS : 1) The output file 2) The module for the definstances 3) The compile image id 4) The maximum number of elements in an array RETURNS : Nothing useful SIDE EFFECTS : Definstances module item written NOTES : None ***************************************************/ static void DefinstancesModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices) { fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefinstancesData(theEnv)->DefinstancesModuleIndex,ConstructPrefix(DefinstancesData(theEnv)->DefinstancesCodeItem)); fprintf(theFile,"}"); } /*************************************************** NAME : SingleDefinstancesToCode DESCRIPTION : Writes out a single definstances' data to the file INPUTS : 1) The output file 2) The definstances 3) The compile image id 4) The maximum number of elements in an array 5) The module index RETURNS : Nothing useful SIDE EFFECTS : Definstances data written NOTES : None ***************************************************/ static void SingleDefinstancesToCode( void *theEnv, FILE *theFile, DEFINSTANCES *theDefinstances, int imageID, int maxIndices, int moduleCount) { /* =================== Definstances Header =================== */ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefinstances->header,imageID,maxIndices,moduleCount, ModulePrefix(DefinstancesData(theEnv)->DefinstancesCodeItem), ConstructPrefix(DefinstancesData(theEnv)->DefinstancesCodeItem)); /* ========================== Definstances specific data ========================== */ fprintf(theFile,",0,"); ExpressionToCode(theEnv,theFile,theDefinstances->mkinstance); fprintf(theFile,"}"); } #endif clips-6.24/clipssrc/._developr.h0000400000175000017500000000061410441071241014716 0ustar jfsjfsMac OS X  2 R:TEXT????@22Sm2MWBB clips-6.24/clipssrc/sortfun.h0000755000175000017500000000313607422634727014423 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* SORT FUNCTIONS HEADER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for sorting functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_sortfun #define _H_sortfun #ifdef LOCALE #undef LOCALE #endif #ifdef _SORTFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SortFunctionDefinitions(void *); LOCALE void MergeSort(void *,unsigned long,DATA_OBJECT *, int (*)(void *,DATA_OBJECT *,DATA_OBJECT *)); LOCALE void SortFunction(void *,DATA_OBJECT *); #endif clips-6.24/clipssrc/._analysis.h0000400000175000017500000000075410441127650014734 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0g'0g'llTTFSFMWBBMPSRclips-6.24/clipssrc/insfile.h0000755000175000017500000000756410441147502014346 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_insfile #define _H_insfile #ifndef _H_expressn #include "expressn.h" #endif #define INSTANCE_FILE_DATA 30 #if BLOAD_INSTANCES || BSAVE_INSTANCES struct instanceFileData { #if BLOAD_INSTANCES || BSAVE_INSTANCES char *InstanceBinaryPrefixID; char *InstanceBinaryVersionID; unsigned long BinaryInstanceFileSize; #if BLOAD_INSTANCES unsigned long BinaryInstanceFileOffset; char *CurrentReadBuffer; unsigned long CurrentReadBufferSize; unsigned long CurrentReadBufferOffset; #endif #endif }; #define InstanceFileData(theEnv) ((struct instanceFileData *) GetEnvironmentData(theEnv,INSTANCE_FILE_DATA)) #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSFILE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define BinaryLoadInstances(theEnv,a) EnvBinaryLoadInstances(theEnv,a) #define BinarySaveInstances(theEnv,a,b,c,d) EnvBinarySaveInstances(theEnv,a,b,c,d) #define LoadInstances(theEnv,a) EnvLoadInstances(theEnv,a) #define LoadInstancesFromString(theEnv,a,b) EnvLoadInstancesFromString(theEnv,a,b) #define RestoreInstances(theEnv,a) EnvRestoreInstances(theEnv,a) #define RestoreInstancesFromString(theEnv,a,b) EnvRestoreInstancesFromString(theEnv,a,b) #define SaveInstances(theEnv,a,b,c,d) EnvSaveInstances(theEnv,a,b,c,d) #else #define BinaryLoadInstances(a) EnvBinaryLoadInstances(GetCurrentEnvironment(),a) #define BinarySaveInstances(a,b,c,d) EnvBinarySaveInstances(GetCurrentEnvironment(),a,b,c,d) #define LoadInstances(a) EnvLoadInstances(GetCurrentEnvironment(),a) #define LoadInstancesFromString(a,b) EnvLoadInstancesFromString(GetCurrentEnvironment(),a,b) #define RestoreInstances(a) EnvRestoreInstances(GetCurrentEnvironment(),a) #define RestoreInstancesFromString(a,b) EnvRestoreInstancesFromString(GetCurrentEnvironment(),a,b) #define SaveInstances(a,b,c,d) EnvSaveInstances(GetCurrentEnvironment(),a,b,c,d) #endif LOCALE void SetupInstanceFileCommands(void *); LOCALE long SaveInstancesCommand(void *); LOCALE long LoadInstancesCommand(void *); LOCALE long RestoreInstancesCommand(void *); LOCALE long EnvSaveInstances(void *,char *,int,EXPRESSION *,intBool); #if BSAVE_INSTANCES LOCALE long BinarySaveInstancesCommand(void *); LOCALE long EnvBinarySaveInstances(void *,char *,int,EXPRESSION *,intBool); #endif #if BLOAD_INSTANCES LOCALE long BinaryLoadInstancesCommand(void *); LOCALE long EnvBinaryLoadInstances(void *,char *); #endif LOCALE long EnvLoadInstances(void *,char *); LOCALE long EnvLoadInstancesFromString(void *,char *,int); LOCALE long EnvRestoreInstances(void *,char *); LOCALE long EnvRestoreInstancesFromString(void *,char *,int); #ifndef _INSFILE_SOURCE_ #endif #endif clips-6.24/clipssrc/._tmpltutl.c0000400000175000017500000000075410441602346014771 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacoc;c;<llTTFL0zFMPSRMWBBLclips-6.24/clipssrc/._modulpsr.h0000400000175000017500000000012207422634765014762 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._classpsr.c0000400000175000017500000000075410441130212014722 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco" " 6TTFS FMWBBMPSRclips-6.24/clipssrc/bsave.c0000755000175000017500000004421210441164355014004 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* BSAVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for saving constructs to */ /* a binary file. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /*************************************************************/ #define _BSAVE_SOURCE_ #include "setup.h" #include "argacces.h" #include "bload.h" #include "cstrnbin.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "moduldef.h" #include "router.h" #include "symblbin.h" #include "bsave.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void FindNeededItems(void *); static void InitializeFunctionNeededFlags(void *); static void WriteNeededFunctions(void *,FILE *); static unsigned long int FunctionBinarySize(void *); static void WriteBinaryHeader(void *,FILE *); static void WriteBinaryFooter(void *,FILE *); #endif static void DeallocateBsaveData(void *); /**********************************************/ /* InitializeBsaveData: Allocates environment */ /* data for the bsave command. */ /**********************************************/ globle void InitializeBsaveData( void *theEnv) { AllocateEnvironmentData(theEnv,BSAVE_DATA,sizeof(struct bsaveData),DeallocateBsaveData); } /************************************************/ /* DeallocateBsaveData: Deallocates environment */ /* data for the bsave command. */ /************************************************/ static void DeallocateBsaveData( void *theEnv) { struct BinaryItem *tmpPtr, *nextPtr; tmpPtr = BsaveData(theEnv)->ListOfBinaryItems; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,BinaryItem,tmpPtr); tmpPtr = nextPtr; } } /**************************************/ /* BsaveCommand: H/L access routine */ /* for the bsave command. */ /**************************************/ globle int BsaveCommand( void *theEnv) { #if (! RUN_TIME) && BLOAD_AND_BSAVE char *fileName; if (EnvArgCountCheck(theEnv,"bsave",EXACTLY,1) == -1) return(FALSE); fileName = GetFileName(theEnv,"bsave",1); if (fileName != NULL) { if (EnvBsave(theEnv,fileName)) return(TRUE); } #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif return(FALSE); } #if BLOAD_AND_BSAVE /******************************/ /* EnvBsave: C access routine */ /* for the bsave command. */ /******************************/ globle intBool EnvBsave( void *theEnv, char *fileName) { FILE *fp; struct BinaryItem *biPtr; char constructBuffer[CONSTRUCT_HEADER_SIZE]; long saveExpressionCount; /*===================================*/ /* A bsave can't occur when a binary */ /* image is already loaded. */ /*===================================*/ if (Bloaded(theEnv)) { PrintErrorID(theEnv,"BSAVE",1,FALSE); EnvPrintRouter(theEnv,WERROR, "Cannot perform a binary save while a binary load is in effect.\n"); return(0); } /*================*/ /* Open the file. */ /*================*/ if ((fp = GenOpen(theEnv,fileName,"wb")) == NULL) { OpenErrorMessage(theEnv,"bsave",fileName); return(0); } /*==============================*/ /* Remember the current module. */ /*==============================*/ SaveCurrentModule(theEnv); /*==================================*/ /* Write binary header to the file. */ /*==================================*/ WriteBinaryHeader(theEnv,fp); /*===========================================*/ /* Initialize count variables, index values, */ /* and determine some of the data structures */ /* which need to be saved. */ /*===========================================*/ ExpressionData(theEnv)->ExpressionCount = 0; InitializeFunctionNeededFlags(theEnv); InitAtomicValueNeededFlags(theEnv); FindHashedExpressions(theEnv); FindNeededItems(theEnv); SetAtomicValueIndices(theEnv,FALSE); /*===============================*/ /* Save the functions and atoms. */ /*===============================*/ WriteNeededFunctions(theEnv,fp); WriteNeededAtomicValues(theEnv,fp); /*=========================================*/ /* Write out the number of expression data */ /* structures in the binary image. */ /*=========================================*/ GenWrite((void *) &ExpressionData(theEnv)->ExpressionCount,(unsigned long) sizeof(unsigned long),fp); /*===========================================*/ /* Save the numbers indicating the amount of */ /* memory needed to bload the constructs. */ /*===========================================*/ for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->bsaveStorageFunction != NULL) { strncpy(constructBuffer,biPtr->name,CONSTRUCT_HEADER_SIZE); GenWrite(constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE,fp); (*biPtr->bsaveStorageFunction)(theEnv,fp); } } /*====================================*/ /* Write a binary footer to the file. */ /*====================================*/ WriteBinaryFooter(theEnv,fp); /*===================*/ /* Save expressions. */ /*===================*/ ExpressionData(theEnv)->ExpressionCount = 0; BsaveHashedExpressions(theEnv,fp); saveExpressionCount = ExpressionData(theEnv)->ExpressionCount; BsaveConstructExpressions(theEnv,fp); ExpressionData(theEnv)->ExpressionCount = saveExpressionCount; /*===================*/ /* Save constraints. */ /*===================*/ WriteNeededConstraints(theEnv,fp); /*==================*/ /* Save constructs. */ /*==================*/ for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->bsaveFunction != NULL) { strncpy(constructBuffer,biPtr->name,CONSTRUCT_HEADER_SIZE); GenWrite(constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE,fp); (*biPtr->bsaveFunction)(theEnv,fp); } } /*===================================*/ /* Save a binary footer to the file. */ /*===================================*/ WriteBinaryFooter(theEnv,fp); /*===========*/ /* Clean up. */ /*===========*/ RestoreAtomicValueBuckets(theEnv); /*=================*/ /* Close the file. */ /*=================*/ GenClose(theEnv,fp); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*========================================*/ /* Return TRUE to indicate success. */ /*========================================*/ return(TRUE); } /*********************************************/ /* InitializeFunctionNeededFlags: Marks each */ /* function in the list of functions as */ /* being unneeded by this binary image. */ /*********************************************/ static void InitializeFunctionNeededFlags( void *theEnv) { struct FunctionDefinition *functionList; for (functionList = GetFunctionList(theEnv); functionList != NULL; functionList = functionList->next) { functionList->bsaveIndex = 0; } } /**********************************************************/ /* FindNeededItems: Searches through the constructs for */ /* the functions, constraints, or atoms that are needed */ /* by that construct. This routine also counts the */ /* number of expressions in use (through a global). */ /**********************************************************/ static void FindNeededItems( void *theEnv) { struct BinaryItem *biPtr; for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->findFunction != NULL) (*biPtr->findFunction)(theEnv); } } /****************************************************/ /* WriteNeededFunctions: Writes the names of needed */ /* functions to the binary save file. */ /****************************************************/ static void WriteNeededFunctions( void *theEnv, FILE *fp) { unsigned long int space, count = 0, length; struct FunctionDefinition *functionList; /*================================================*/ /* Assign each function an index if it is needed. */ /*================================================*/ for (functionList = GetFunctionList(theEnv); functionList != NULL; functionList = functionList->next) { if (functionList->bsaveIndex) { functionList->bsaveIndex = (short int) count++; } else { functionList->bsaveIndex = -1; } } /*===================================================*/ /* Write the number of function names to be written. */ /*===================================================*/ GenWrite(&count,(unsigned long) sizeof(unsigned long int),fp); if (count == 0) { GenWrite(&count,(unsigned long) sizeof(unsigned long int),fp); return; } /*================================*/ /* Determine the amount of space */ /* needed for the function names. */ /*================================*/ space = FunctionBinarySize(theEnv); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); /*===============================*/ /* Write out the function names. */ /*===============================*/ for (functionList = GetFunctionList(theEnv); functionList != NULL; functionList = functionList->next) { if (functionList->bsaveIndex >= 0) { length = strlen(ValueToString(functionList->callFunctionName)) + 1; GenWrite(ValueToString(functionList->callFunctionName),(unsigned long) length,fp); } } } /*********************************************/ /* FunctionBinarySize: Determines the number */ /* of bytes needed to save all of the */ /* function names in the binary save file. */ /*********************************************/ static unsigned long int FunctionBinarySize( void *theEnv) { unsigned long int size = 0; struct FunctionDefinition *functionList; for (functionList = GetFunctionList(theEnv); functionList != NULL; functionList = functionList->next) { if (functionList->bsaveIndex >= 0) { size += strlen(ValueToString(functionList->callFunctionName)) + 1; } } return(size); } /***************************************************/ /* SaveBloadCount: Used to save the data structure */ /* count values when a binary save command is */ /* issued when a binary image is loaded. */ /***************************************************/ globle void SaveBloadCount( void *theEnv, long cnt) { BLOADCNTSV *tmp, *prv; tmp = get_struct(theEnv,bloadcntsv); tmp->val = cnt; tmp->nxt = NULL; if (BsaveData(theEnv)->BloadCountSaveTop == NULL) { BsaveData(theEnv)->BloadCountSaveTop = tmp; } else { prv = BsaveData(theEnv)->BloadCountSaveTop; while (prv->nxt != NULL) { prv = prv->nxt; } prv->nxt = tmp; } } /**************************************************/ /* RestoreBloadCount: Restores the data structure */ /* count values after a binary save command is */ /* completed when a binary image is loaded. */ /**************************************************/ globle void RestoreBloadCount( void *theEnv, long *cnt) { BLOADCNTSV *tmp; *cnt = BsaveData(theEnv)->BloadCountSaveTop->val; tmp = BsaveData(theEnv)->BloadCountSaveTop; BsaveData(theEnv)->BloadCountSaveTop = BsaveData(theEnv)->BloadCountSaveTop->nxt; rtn_struct(theEnv,bloadcntsv,tmp); } /**********************************************/ /* MarkNeededItems: Examines an expression to */ /* determine which items are needed to save */ /* an expression as part of a binary image. */ /**********************************************/ globle void MarkNeededItems( void *theEnv, struct expr *testPtr) { while (testPtr != NULL) { switch (testPtr->type) { case SYMBOL: case STRING: case GBL_VARIABLE: case INSTANCE_NAME: ((SYMBOL_HN *) testPtr->value)->neededSymbol = TRUE; break; case FLOAT: ((FLOAT_HN *) testPtr->value)->neededFloat = TRUE; break; case INTEGER: ((INTEGER_HN *) testPtr->value)->neededInteger = TRUE; break; case FCALL: ((struct FunctionDefinition *) testPtr->value)->bsaveIndex = TRUE; break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[testPtr->type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[testPtr->type]->bitMap) { ((BITMAP_HN *) testPtr->value)->neededBitMap = TRUE; } break; } if (testPtr->argList != NULL) { MarkNeededItems(theEnv,testPtr->argList); } testPtr = testPtr->nextArg; } } /******************************************************/ /* WriteBinaryHeader: Writes a binary header used for */ /* verification when a binary image is loaded. */ /******************************************************/ static void WriteBinaryHeader( void *theEnv, FILE *fp) { GenWrite(BloadData(theEnv)->BinaryPrefixID,(unsigned long) strlen(BloadData(theEnv)->BinaryPrefixID) + 1,fp); GenWrite(BloadData(theEnv)->BinaryVersionID,(unsigned long) strlen(BloadData(theEnv)->BinaryVersionID) + 1,fp); } /******************************************************/ /* WriteBinaryFooter: Writes a binary footer used for */ /* verification when a binary image is loaded. */ /******************************************************/ static void WriteBinaryFooter( void *theEnv, FILE *fp) { char footerBuffer[CONSTRUCT_HEADER_SIZE]; strncpy(footerBuffer,BloadData(theEnv)->BinaryPrefixID,CONSTRUCT_HEADER_SIZE); GenWrite(footerBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE,fp); } #endif /* BLOAD_AND_BSAVE */ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE /**********************************************************/ /* AddBinaryItem: Informs the bload/bsave commands of the */ /* appropriate access functions needed to save/load the */ /* data structures of a construct or other "item" to a */ /* binary file. */ /**********************************************************/ globle intBool AddBinaryItem( void *theEnv, char *name, int priority, void (*findFunction)(void *), void (*expressionFunction)(void *,FILE *), void (*bsaveStorageFunction)(void *,FILE *), void (*bsaveFunction)(void *,FILE *), void (*bloadStorageFunction)(void *), void (*bloadFunction)(void *), void (*clearFunction)(void *)) { struct BinaryItem *newPtr, *currentPtr, *lastPtr = NULL; /*========================================*/ /* Create the binary item data structure. */ /*========================================*/ newPtr = get_struct(theEnv,BinaryItem); newPtr->name = name; newPtr->findFunction = findFunction; newPtr->expressionFunction = expressionFunction; newPtr->bsaveStorageFunction = bsaveStorageFunction; newPtr->bsaveFunction = bsaveFunction; newPtr->bloadStorageFunction = bloadStorageFunction; newPtr->bloadFunction = bloadFunction; newPtr->clearFunction = clearFunction; newPtr->priority = priority; /*=================================*/ /* If no binary items are defined, */ /* just put the item on the list. */ /*=================================*/ if (BsaveData(theEnv)->ListOfBinaryItems == NULL) { newPtr->next = NULL; BsaveData(theEnv)->ListOfBinaryItems = newPtr; return(TRUE); } /*=========================================*/ /* Otherwise, place the binary item at the */ /* appropriate place in the list of binary */ /* items based on its priority. */ /*=========================================*/ currentPtr = BsaveData(theEnv)->ListOfBinaryItems; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = BsaveData(theEnv)->ListOfBinaryItems; BsaveData(theEnv)->ListOfBinaryItems = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } /*==================================*/ /* Return TRUE to indicate the item */ /* was successfully added. */ /*==================================*/ return(TRUE); } #endif /* BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE */ clips-6.24/clipssrc/factrete.h0000755000175000017500000000540110441143460014475 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FACT RETE ACCESS FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_factrete #define _H_factrete #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTRETE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool FactPNGetVar1(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactPNGetVar2(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactPNGetVar3(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactJNGetVar1(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactJNGetVar2(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactJNGetVar3(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactSlotLength(void *,void *,DATA_OBJECT_PTR); LOCALE int FactJNCompVars1(void *,void *,DATA_OBJECT_PTR); LOCALE int FactJNCompVars2(void *,void *,DATA_OBJECT_PTR); LOCALE int FactPNCompVars1(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactPNConstant1(void *,void *,DATA_OBJECT_PTR); LOCALE intBool FactPNConstant2(void *,void *,DATA_OBJECT_PTR); LOCALE int FactStoreMultifield(void *,void *,DATA_OBJECT_PTR); LOCALE unsigned short AdjustFieldPosition(void *,struct multifieldMarker *, unsigned short,unsigned short,int *); #endif clips-6.24/clipssrc/bsave.h0000755000175000017500000000713210441127776014017 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* BSAVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_bsave #define _H_bsave struct BinaryItem; #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _BSAVE_SOURCE_ #define LOCALE #else #define LOCALE extern #endif struct BinaryItem { char *name; void (*findFunction)(void *); void (*bloadStorageFunction)(void *); void (*bloadFunction)(void *); void (*clearFunction)(void *); void (*expressionFunction)(void *,FILE *); void (*bsaveStorageFunction)(void *,FILE *); void (*bsaveFunction)(void *,FILE *); int priority; struct BinaryItem *next; }; #if BLOAD_AND_BSAVE typedef struct bloadcntsv { long val; struct bloadcntsv *nxt; } BLOADCNTSV; #endif typedef struct bsave_expr { unsigned short type; long value,arg_list,next_arg; } BSAVE_EXPRESSION; #define CONSTRUCT_HEADER_SIZE 20 #define BSAVE_DATA 39 struct bsaveData { struct BinaryItem *ListOfBinaryItems; #if BLOAD_AND_BSAVE BLOADCNTSV *BloadCountSaveTop; #endif }; #define BsaveData(theEnv) ((struct bsaveData *) GetEnvironmentData(theEnv,BSAVE_DATA)) #if ENVIRONMENT_API_ONLY #define Bsave(theEnv,a) EnvBsave(theEnv,a) #else #define Bsave(a) EnvBsave(GetCurrentEnvironment(),a) #endif LOCALE void InitializeBsaveData(void *); LOCALE int BsaveCommand(void *); #if BLOAD_AND_BSAVE LOCALE intBool EnvBsave(void *,char *); LOCALE void MarkNeededItems(void *,struct expr *); LOCALE void SaveBloadCount(void *,long); LOCALE void RestoreBloadCount(void *,long *); #endif LOCALE intBool AddBinaryItem(void *,char *,int, void (*)(void *), void (*)(void *,FILE *), void (*)(void *,FILE *), void (*)(void *,FILE *), void (*)(void *), void (*)(void *), void (*)(void *)); #ifndef _BSAVE_SOURCE_ extern struct BinaryItem *ListOfBinaryItems; #endif #endif clips-6.24/clipssrc/._argacces.c0000400000175000017500000000075410441602033014645 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco3.a3.allTTFL'FMPSRMWBBLclips-6.24/clipssrc/._dffnxpsr.h0000400000175000017500000000075410441112015014730 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z!"QQTTFSmFMPSRMWBBLclips-6.24/clipssrc/userdata.c0000755000175000017500000001167307422635016014523 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* USER DATA MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for attaching user data to constructs, */ /* facts, instances, user functions, etc. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _USERDATA_SOURCE_ #include #include "setup.h" #include "envrnmnt.h" #include "userdata.h" /*************************************************/ /* InitializeUserDataData: Allocates environment */ /* data for user data routines. */ /*************************************************/ globle void InitializeUserDataData( void *theEnv) { AllocateEnvironmentData(theEnv,USER_DATA_DATA,sizeof(struct userDataData),NULL); } /******************************************************/ /* InstallUserDataRecord: Installs a user data record */ /* in the user data record array and returns the */ /* integer data ID associated with the record. */ /******************************************************/ globle unsigned char InstallUserDataRecord( void *theEnv, struct userDataRecord *theRecord) { theRecord->dataID = UserDataData(theEnv)->UserDataRecordCount; UserDataData(theEnv)->UserDataRecordArray[UserDataData(theEnv)->UserDataRecordCount] = theRecord; return(UserDataData(theEnv)->UserDataRecordCount++); } /*****************************************************/ /* FetchUserData: Searches for user data information */ /* from a list of user data structures. A new user */ /* data structure is created if one is not found. */ /*****************************************************/ globle struct userData *FetchUserData( void *theEnv, unsigned char userDataID, struct userData **theList) { struct userData *theData; for (theData = *theList; theData != NULL; theData = theData->next) { if (theData->dataID == userDataID) { return(theData); } } theData = (struct userData *) (*UserDataData(theEnv)->UserDataRecordArray[userDataID]->createUserData)(theEnv); theData->dataID = userDataID; theData->next = *theList; *theList = theData; return(theData); } /*****************************************************/ /* TestUserData: Searches for user data information */ /* from a list of user data structures. NULL is */ /* returned if the appropriate user data structure */ /* is not found. */ /*****************************************************/ globle struct userData *TestUserData( unsigned char userDataID, struct userData *theList) { struct userData *theData; for (theData = theList; theData != NULL; theData = theData->next) { if (theData->dataID == userDataID) { return(theData); } } return(NULL); } /***************************************************************/ /* ClearUserDataList: Deallocates a linked list of user data. */ /***************************************************************/ globle void ClearUserDataList( void *theEnv, struct userData *theList) { struct userData *nextData; while (theList != NULL) { nextData = theList->next; (*UserDataData(theEnv)->UserDataRecordArray[theList->dataID]->deleteUserData)(theEnv,theList); theList = nextData; } } /*************************************************/ /* DeleteUserData: Removes user data information */ /* from a list of user data structures. */ /*************************************************/ globle struct userData *DeleteUserData( void *theEnv, unsigned char userDataID, struct userData *theList) { struct userData *theData, *lastData = NULL; for (theData = theList; theData != NULL; theData = theData->next) { if (theData->dataID == userDataID) { if (lastData == NULL) { theList = theData->next; } else { lastData->next = theData->next; } (*UserDataData(theEnv)->UserDataRecordArray[userDataID]->deleteUserData)(theEnv,theData); return(theList); } lastData = theData; } return(theList); } clips-6.24/clipssrc/inherpsr.c0000755000175000017500000007753007422634713014554 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* MULTIPLE INHERITANCE PARSER MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Parsing Routines for Multiple Inheritance */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #include "classcom.h" #include "classfun.h" #include "envrnmnt.h" #include "memalloc.h" #include "modulutl.h" #include "router.h" #include "scanner.h" #define _INHERPSR_SOURCE_ #include "inherpsr.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef struct partialOrder PARTIAL_ORDER; typedef struct successor SUCCESSOR; struct partialOrder { DEFCLASS *cls; unsigned pre; SUCCESSOR *suc; struct partialOrder *nxt; }; struct successor { PARTIAL_ORDER *po; struct successor *nxt; }; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static PARTIAL_ORDER *InitializePartialOrderTable(void *,PARTIAL_ORDER *,PACKED_CLASS_LINKS *); static void RecordPartialOrders(void *,PARTIAL_ORDER *,DEFCLASS *,PACKED_CLASS_LINKS *,unsigned); static PARTIAL_ORDER *FindPartialOrder(PARTIAL_ORDER *,DEFCLASS *); static void PrintPartialOrderLoop(void *,PARTIAL_ORDER *); static void PrintClassLinks(void *,char *,char *,CLASS_LINK *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************** NAME : ParseSuperclasses DESCRIPTION : Parses the (is-a +) portion of the (defclass ...) construct and returns a list of direct superclasses. The class "standard-class" is the precedence list for classes with no direct superclasses. The final precedence list (not calculated here) will have the class in question first followed by the merged precedence lists of its direct superclasses. INPUTS : 1) The logical name of the input source 2) The symbolic name of the new class RETURNS : The address of the superclass list or NULL if there was an error SIDE EFFECTS : None NOTES : Assumes "(defclass [] (" has already been scanned. All superclasses must be defined before their subclasses. Duplicates in the (is-a ...) list are are not allowed (a class may only inherits from a superclass once). This routine also checks the class-precedence lists of each of the direct superclasses for an occurrence of the new class - i.e. cycles! This can only happen when a class is redefined (a new class cannot have an unspecified superclass). This routine allocates the space for the list ***************************************************************/ globle PACKED_CLASS_LINKS *ParseSuperclasses( void *theEnv, char *readSource, SYMBOL_HN *newClassName) { CLASS_LINK *clink = NULL,*cbot = NULL,*ctmp; DEFCLASS *sclass; PACKED_CLASS_LINKS *plinks; if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,"defclass inheritance"); return(NULL); } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (DefclassData(theEnv)->ObjectParseToken.value != (void *) DefclassData(theEnv)->ISA_SYMBOL)) { SyntaxErrorMessage(theEnv,"defclass inheritance"); return(NULL); } SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defclass"); goto SuperclassParseError; } if (FindModuleSeparator(ValueToString(newClassName))) { IllegalModuleSpecifierMessage(theEnv); goto SuperclassParseError; } if (GetValue(DefclassData(theEnv)->ObjectParseToken) == (void *) newClassName) { PrintErrorID(theEnv,"INHERPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"A class may not have itself as a superclass.\n"); goto SuperclassParseError; } for (ctmp = clink ; ctmp != NULL ; ctmp = ctmp->nxt) { if (GetValue(DefclassData(theEnv)->ObjectParseToken) == (void *) ctmp->cls->header.name) { PrintErrorID(theEnv,"INHERPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"A class may inherit from a superclass only once.\n"); goto SuperclassParseError; } } sclass = LookupDefclassInScope(theEnv,ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken))); if (sclass == NULL) { PrintErrorID(theEnv,"INHERPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"A class must be defined after all its superclasses.\n"); goto SuperclassParseError; } if ((sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,"INHERPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"A user-defined class cannot be a subclass of "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sclass)); EnvPrintRouter(theEnv,WERROR,".\n"); goto SuperclassParseError; } ctmp = get_struct(theEnv,classLink); ctmp->cls = sclass; if (clink == NULL) clink = ctmp; else cbot->nxt = ctmp; ctmp->nxt = NULL; cbot = ctmp; SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if (clink == NULL) { PrintErrorID(theEnv,"INHERPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Must have at least one superclass.\n"); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); plinks = get_struct(theEnv,packedClassLinks); PackClassLinks(theEnv,plinks,clink); return(plinks); SuperclassParseError: DeleteClassLinks(theEnv,clink); return(NULL); } /*************************************************************************** NAME : FindPrecedenceList DESCRIPTION : A complete class precedence list is obtained from the list of direct superclasses as follows : Each class and its direct superclasses are recursively entered in order to a list called the partial order table. A class is only entered once. The order reflects a pre-order depth-first traversal of the classes, and this order will be followed as closely as possible to preserve the "family" heuristic when constructing the class precedence list. Attached to each node is a count indicating the number of classes which must precede this class and a list of classes which must succeed this class (attached via the suc field and linked via nxt fields). These predecessor counts and successor lists indicate the partial orderings given by the rules of multiple inheritance for the classes: 1) a class must precede all its superclasses, and 2) a class determines the precedence of its immediate superclasses. For example, the following class definitions (defclass A (is-a USER)) (defclass B (is-a USER)) (defclass C (is-a A B)) would give the following partial orders: C < A by Rule 1 C < B by Rule 1 A < B by Rule 2 B < USER by Rule 1 A < USER by Rule 1 USER < OBJECT by Rule 1 In turn, these partial orders would be recorded in a sequence table: C A USER OBJECT B Predecessor Count 0 1 2 1 2 Successor List A,B B,USER OBJECT USER To generate a precedence list for C, we pick the first class with a predecessor count of 0, append it to the precedence list, and decrement the counts of all its successors. We continue scanning for a 0 from where we left off. If we ever scan completely through the table without finding a 0, then we know there is an error. Shown below is the table above after each class is entered onto the precedence list: Precedence list: C A USER OBJECT B Predecessor Count 0 2 1 1 Successor List B,USER OBJECT USER Precedence list: C A USER OBJECT B Predecessor Count 1 1 0 Successor List OBJECT USER Precedence list: C A B USER OBJECT Predecessor Count 0 1 Successor List OBJECT Precedence list: C A B USER OBJECT Predecessor Count 0 Successor List Precedence List: C A B USER OBJECT And since the table is now empty we are done! INPUTS : 1) The old class definition (NULL if it is new) 2) The list of direct superclasses RETURNS : The address of the precedence list if successful, NULL otherwise SIDE EFFECTS : Precedence list allocated NOTES : WARNING!! - This routine assumes that there are no cyclic dependencies in the given superclass list, i.e. none of the superclasses inherit from the class for which the precedence list is being defined. (This is verified in ParseDefclasses() in CLASSCOM.C) Every class-precedence list has the class itself on it (implicitly) and a built-in system class on it explicitly (except for the built-in classes). The precedence determination algorithm is a variation on the topological sorting algorithm given in The Art of Computer Programming - Vol. I (Fundamental Algorithms) by Donald Knuth. ***************************************************************************/ globle PACKED_CLASS_LINKS *FindPrecedenceList( void *theEnv, DEFCLASS *cls, PACKED_CLASS_LINKS *supers) { PARTIAL_ORDER *po_table = NULL,*start,*pop,*poprv,*potmp; SUCCESSOR *stmp; CLASS_LINK *ptop,*pbot,*ptmp; PACKED_CLASS_LINKS *plinks; register unsigned i; /* ===================================================================== Recursively add all superclasses in a pre-order depth-first traversal to the partial order table. There should be only one node per class. ===================================================================== */ po_table = InitializePartialOrderTable(theEnv,po_table,supers); /* ============================================================= If the class already exists, record the rule 1 partial orders with the new superclass lists. This is so that cyclic dependencies can be detected. ============================================================= */ if (cls != NULL) { pop = get_struct(theEnv,partialOrder); pop->cls = cls; pop->pre = 0; pop->suc = NULL; pop->nxt = po_table; po_table = pop; pop = po_table->nxt; RecordPartialOrders(theEnv,po_table,cls,supers,0); } else pop = po_table; /* ================================================================== Record the rule 1 and rule 2 partial orders given by the direct superclass lists of the classes in the table. There is no need to recurse since all possible classes have been entered already. Be sure to skip the class itself if it was added to the front of the table. ================================================================== */ for ( ; pop != NULL ; pop = pop->nxt) { RecordPartialOrders(theEnv,po_table,pop->cls,&pop->cls->directSuperclasses,0); for (i = 0 ; i < pop->cls->directSuperclasses.classCount ; i++) RecordPartialOrders(theEnv,po_table,pop->cls->directSuperclasses.classArray[i], &pop->cls->directSuperclasses,i+1); } /* ============================================================= Record the rule 2 partial orders given by the superclass list ============================================================= */ for (i = 0 ; i < supers->classCount ; i++) RecordPartialOrders(theEnv,po_table,supers->classArray[i],supers,i+1); start = NULL; poprv = NULL; pop = po_table; ptop = pbot = NULL; while (pop != start) { /* ============================================================== Allow wraparound - happens when the search for a 0 node begins somewhere in the middle of the sequence table ============================================================== */ if (pop == NULL) { poprv = NULL; pop = po_table; start = start->nxt; } /* ========================================================= Search for the first class with no remaining predecessors ========================================================= */ if (pop->pre == 0) { /* ================================================= Decrement the predecessor count for all the successors of this class and delete the list. This is the variation on Knuth's algorithm which allows us to preserve the "family" heuristic. Since we will pick up scanning for 0's from this point, we will be able to keep "family" trees together, if possible. BuildPartialOrders() entered the classes into the sequence table in a pre-order depth traversal order. ================================================= */ while (pop->suc != NULL) { stmp = pop->suc; pop->suc = stmp->nxt; stmp->po->pre--; rtn_struct(theEnv,successor,stmp); } /* ============================================= Append the class to the precedence list and remove its entry from the partial order table ============================================= */ potmp = pop; if (poprv == NULL) po_table = pop->nxt; else poprv->nxt = pop->nxt; pop = pop->nxt; start = poprv; ptmp = get_struct(theEnv,classLink); ptmp->cls = potmp->cls; ptmp->nxt = NULL; rtn_struct(theEnv,partialOrder,potmp); if (ptop == NULL) ptop = ptmp; else pbot->nxt = ptmp; pbot = ptmp; } else { poprv = pop; pop = pop->nxt; } } /* ====================================================================== If the table of partial orders is not empty and we were unable to find a class with no predecessors, then there is no solution! Print out the precedence loop in the partial orders. Delete the remaining partial order table and the partial precedence list. ====================================================================== */ if (po_table != NULL) { PrintErrorID(theEnv,"INHERPSR",5,FALSE); PrintClassLinks(theEnv,WERROR,"Partial precedence list formed:",ptop); PrintPartialOrderLoop(theEnv,po_table); while (po_table != NULL) { while (po_table->suc != NULL) { stmp = po_table->suc; po_table->suc = stmp->nxt; rtn_struct(theEnv,successor,stmp); } potmp = po_table; po_table = po_table->nxt; rtn_struct(theEnv,partialOrder,potmp); } DeleteClassLinks(theEnv,ptop); return(NULL); } /* ============================================================================= If the class already existed, be sure and remove it from its own precedence list. Remember that we stuck it on the table artificially to catch cycles. It was first in the table, and, since it started with a predecessor count of zero (given that there were no loops), it is first in the precedence list. We will leave the dummy node there so that functions which wish to iterate over a class and its superclasses may easily do so. ============================================================================= */ if (cls == NULL) { ptmp = get_struct(theEnv,classLink); ptmp->nxt = ptop; ptop = ptmp; } /* ============================================================ The class pointer will be filled in later by ParseDefclass() ============================================================ */ ptop->cls = NULL; plinks = get_struct(theEnv,packedClassLinks); PackClassLinks(theEnv,plinks,ptop); return(plinks); } /*************************************************** NAME : PackClassLinks DESCRIPTION : Writes a list of class links into a contiguous section of memory to reduce overhead (the original list is deleted) INPUTS : 1) The packed list structure to use 2) The top of the original list RETURNS : Nothing useful SIDE EFFECTS : Packed list allocated and old list deleted NOTES : None ***************************************************/ globle void PackClassLinks( void *theEnv, PACKED_CLASS_LINKS *plinks, CLASS_LINK *lptop) { register unsigned count; register CLASS_LINK *lp; for (count = 0 , lp = lptop ; lp != NULL ; lp = lp->nxt) count++; if (count > 0) plinks->classArray = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * count)); else plinks->classArray = NULL; for (count = 0 , lp = lptop ; lp != NULL ; lp = lp->nxt , count++) plinks->classArray[count] = lp->cls; DeleteClassLinks(theEnv,lptop); plinks->classCount = (unsigned short) count; } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************************** NAME : InitializePartialOrderTable DESCRIPTION : This function recursively enters the classes that will be used in a precedence list determination in depth-first pre-order traversal. The predecessor counts and successor list are initialized. INPUTS : 1) The partial order table 2) A list of direct superclasses 3) The class for which a precedence class is being determined (NULL for new class) 4) The class which superclass list is being processed RETURNS : The top of partial order table SIDE EFFECTS : The partial order table is initialized. NOTES : None **************************************************************************/ static PARTIAL_ORDER *InitializePartialOrderTable( void *theEnv, PARTIAL_ORDER *po_table, PACKED_CLASS_LINKS *supers) { register PARTIAL_ORDER *pop,*poprv; register unsigned i; for (i = 0 ; i < supers->classCount ; i++) { /* ================================================= Append this class at the end of the partial order table only if it is not already present ================================================= */ poprv = NULL; for (pop = po_table ; pop != NULL ; pop = pop->nxt) { if (pop->cls == supers->classArray[i]) break; poprv = pop; } if (pop == NULL) { pop = get_struct(theEnv,partialOrder); pop->cls = supers->classArray[i]; pop->nxt = NULL; pop->suc = NULL; pop->pre = 0; if (poprv == NULL) po_table = pop; else poprv->nxt = pop; /* ============================================================= Recursively append all its superclasses immediately after it. This order will allow us to preserve the "family" heuristic in the precedence list. ============================================================= */ po_table = InitializePartialOrderTable(theEnv,po_table, &supers->classArray[i]->directSuperclasses); } } return(po_table); } /*********************************************************************************** NAME : RecordPartialOrders DESCRIPTION : Given a predecessor class and a list of successor classes, this function enters a number of partial orders into the table equaling the number of successor classes. INPUTS : 1) The partial order table 2) The predecessor class 3) An array of successor classes 4) A starting index for the successor classes RETURNS : The top of sequence table SIDE EFFECTS : The sequence table is built, e.g.: CLASS1 < CLASS2 , CLASS3 would be recorded as: PO_TABLE -> NXT -> NXT -> NXT -> SUC SUC SUC | | | V V V NXT | V NXT | V The predecessor counts would be 0, 1 and 1 for CLASS1, CLASS2 and CLASS3 respectively. NOTES : None ***********************************************************************************/ static void RecordPartialOrders( void *theEnv, PARTIAL_ORDER *po_table, DEFCLASS *cls, PACKED_CLASS_LINKS *successors, unsigned starti) { register PARTIAL_ORDER *clspo; register SUCCESSOR *stmp; clspo = FindPartialOrder(po_table,cls); while (starti < successors->classCount) { stmp = get_struct(theEnv,successor); stmp->po = FindPartialOrder(po_table,successors->classArray[starti]); stmp->nxt = clspo->suc; clspo->suc = stmp; stmp->po->pre++; starti++; } } /*************************************************** NAME : FindPartialOrder DESCRIPTION : Finds a partial order node INPUTS : 1) The partial order table 2) The class to look up RETURNS : The partial order node address SIDE EFFECTS : None NOTES : None ***************************************************/ static PARTIAL_ORDER *FindPartialOrder( PARTIAL_ORDER *po_table, DEFCLASS *cls) { while (po_table != NULL) { if (po_table->cls == cls) break; po_table = po_table->nxt; } return(po_table); } /************************************************************************** NAME : PrintPartialOrderLoop DESCRIPTION : This routine prints a conflicting loop (there may be more than one) in the given sequence table of partial orders. The algorithm works as follows: Given the following class definitions, (defclass A (is-a USER)) (defclass B (is-a USER)) (defclass C (is-a A B)) (defclass D (is-a B A)) (defclass E (is-a C D)) the partial order table will look as follows after as many classes as possible have been entered onto the precedence list: A USER OBJECT B Predecessor Count 1 2 1 1 Successor List B,USER OBJECT A,USER Construct a new table where each class is linked to one of its predecessors. For the example above one would be: Class: A USER OBJECT B Predecessor: B A USER A This table is actually implemnted using the original partial order table (see the code below for specifics). Now using this table, start with the first node, and visit successive nodes by following the predecessor links. Mark each node as "visited". When a previously visited node is encountered, the loop has been found. In the case above, we start with A, goto B and then goto A again which we have already seen. So starting from where we found the loop (A) we follow the links again, printing the nodes as we go, until we're back where we started: A B A. Notice that this loop reflects the Rule 2 conflicts between Class C and Class D in Class E's precedence list. INPUTS : The remaining partial order table of conflicting partial orders RETURNS : Nothing useful SIDE EFFECTS : The predecessor counts and successor lists are modified to implement the loop detection. NOTES : This algorithm is adopted from one given in Donald Knuth's The Art of Computer Programming - Vol. I (Fundamental Algorithms). **************************************************************************/ static void PrintPartialOrderLoop( void *theEnv, PARTIAL_ORDER *po_table) { register PARTIAL_ORDER *pop1,*pop2; SUCCESSOR *prc,*stmp; /* ==================================================== Set the predecessor count of every node to 0 so that this field can be used as a marker ==================================================== */ for (pop1 = po_table ; pop1 != NULL ; pop1 = pop1->nxt) pop1->pre = 0; /* ======================================================= Mark each node in the partial order table with one of its predecessors. If the class has already been marked (predecessor count > 0), don't bother. This is accomplished by adding a node to the front of its successors' successor lists. When the process is finished, all nodes will have one predecessor chained to them by their 'suc' field. (If any nodes had had no predecessors, they would not still be in the table.) ======================================================= */ for (pop1 = po_table ; pop1 != NULL ; pop1 = pop1->nxt) { if (pop1->pre == 0) { prc = pop1->suc; pop1->suc = NULL; } else { prc = pop1->suc->nxt; pop1->suc->nxt = NULL; } while (prc != NULL) { pop2 = FindPartialOrder(po_table,prc->po->cls); if (pop2->pre == 0) { stmp = get_struct(theEnv,successor); stmp->po = pop1; stmp->nxt = pop2->suc; pop2->suc = stmp; pop2->pre = 1; } stmp = prc; prc = prc->nxt; rtn_struct(theEnv,successor,stmp); } } /* ================================================= Set the predecessor count of every node back to 0 so that this field can be used as a marker again ================================================= */ for (pop1 = po_table ; pop1 != NULL ; pop1 = pop1->nxt) pop1->pre = 0; /* ========================================================= Now start with the first node in the partial order table, and follow the predecessor links, marking the nodes as they are visited. When we reach a node we have been before, we have found a loop! Follow all the marked nodes again starting from the CURRENT position to print the loop. ========================================================= */ pop1 = po_table; while (pop1->pre == 0) { pop1->pre = 1; pop1 = pop1->suc->po; } EnvPrintRouter(theEnv,WERROR,"Precedence loop in superclasses:"); while (pop1->pre == 1) { EnvPrintRouter(theEnv,WERROR," "); PrintClassName(theEnv,WERROR,pop1->cls,FALSE); pop1->pre = 0; pop1 = pop1->suc->po; } EnvPrintRouter(theEnv,WERROR," "); PrintClassName(theEnv,WERROR,pop1->cls,TRUE); } /*************************************************** NAME : PrintClassLinks DESCRIPTION : Displays the names of classes in a list with a title INPUTS : 1) The logical name of the output 2) Title string 3) List of class links RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ static void PrintClassLinks( void *theEnv, char *logicalName, char *title, CLASS_LINK *clink) { if (title != NULL) EnvPrintRouter(theEnv,logicalName,title); while (clink != NULL) { EnvPrintRouter(theEnv,logicalName," "); PrintClassName(theEnv,logicalName,clink->cls,FALSE); clink = clink->nxt; } EnvPrintRouter(theEnv,logicalName,"\n"); } #endif clips-6.24/clipssrc/._dffctdef.h0000400000175000017500000000075410441111705014650 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zTTFS hFMWBBMPSRclips-6.24/clipssrc/._globlbsc.h0000400000175000017500000000075410441143614014676 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z1,,TTFS FMWBBMPSRclips-6.24/clipssrc/._evaluatn.h0000400000175000017500000000075410441602161014723 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco1T1T-TTFL)FMPSRMWBBLclips-6.24/clipssrc/._factlhs.h0000400000175000017500000000012207422635017014530 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/agenda.c0000755000175000017500000011767310441602016014126 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* AGENDA MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* Provides functionality for examining, manipulating, */ /* adding, and removing activations from the agenda. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* and DYNAMIC_SALIENCE compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EnvGetActivationBasisPPForm function. */ /* */ /*************************************************************/ #define _AGENDA_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "argacces.h" #include "constant.h" #include "crstrtgy.h" #include "engine.h" #include "envrnmnt.h" #include "extnfunc.h" #include "memalloc.h" #include "moduldef.h" #include "modulutl.h" #include "multifld.h" #include "reteutil.h" #include "retract.h" #include "router.h" #include "rulebsc.h" #include "ruledef.h" #include "strngrtr.h" #include "sysdep.h" #include "watch.h" #include "agenda.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void PrintActivation(void *,char *,void *); static void AgendaClearFunction(void *); static char *SalienceEvaluationName(int); static int EvaluateSalience(void *,void *); /*************************************************/ /* InitializeAgenda: Initializes the activations */ /* watch item and the H/L commands for */ /* manipulating the agenda. */ /*************************************************/ globle void InitializeAgenda( void *theEnv) { AllocateEnvironmentData(theEnv,AGENDA_DATA,sizeof(struct agendaData),NULL); AgendaData(theEnv)->SalienceEvaluation = WHEN_DEFINED; AgendaData(theEnv)->Strategy = DEFAULT_STRATEGY; EnvAddClearFunction(theEnv,"agenda",AgendaClearFunction,0); #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"activations",1,&AgendaData(theEnv)->WatchActivations,40,DefruleWatchAccess,DefruleWatchPrint); #endif #if ! RUN_TIME EnvDefineFunction2(theEnv,"refresh", 'v', PTIEF RefreshCommand, "RefreshCommand", "11w"); EnvDefineFunction2(theEnv,"refresh-agenda",'v', PTIEF RefreshAgendaCommand,"RefreshAgendaCommand", "01w"); EnvDefineFunction2(theEnv,"get-salience-evaluation",'w', PTIEF GetSalienceEvaluationCommand, "GetSalienceEvaluationCommand", "00"); EnvDefineFunction2(theEnv,"set-salience-evaluation",'w', PTIEF SetSalienceEvaluationCommand, "SetSalienceEvaluationCommand", "11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"agenda", 'v', PTIEF AgendaCommand, "AgendaCommand", "01w"); #endif #endif } /*****************************************************************/ /* AddActivation: Creates a rule activation to be added to the */ /* Agenda and links the activation with its associated partial */ /* match. The function PlaceActivation is then called to place */ /* the activation on the Agenda. Typically called when all */ /* patterns on the LHS of a rule have been satisfied. */ /*****************************************************************/ 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; /*=======================================*/ /* 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->sortedBasis = NULL; 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->binds[binds->bcount].gm.theValue = (void *) newActivation; /*====================================================*/ /* If activations are being watch, display a message. */ /*====================================================*/ #if DEBUGGING_FUNCTIONS if (newActivation->theRule->watchActivation) { EnvPrintRouter(theEnv,WTRACE,"==> Activation "); PrintActivation(theEnv,WTRACE,(void *) newActivation); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*=====================================*/ /* Place the activation on the agenda. */ /*=====================================*/ theModuleItem = (struct defruleModule *) theRule->header.whichModule; PlaceActivation(theEnv,&(theModuleItem->agenda),newActivation); } /***************************************************************/ /* ClearRuleFromAgenda: Clears the agenda of a specified rule. */ /***************************************************************/ globle void ClearRuleFromAgenda( void *theEnv, void *vTheRule) { struct defrule *theRule = (struct defrule *) vTheRule; struct defrule *tempRule; struct activation *agendaPtr, *agendaNext; /*============================================*/ /* Get a pointer to the agenda for the module */ /* in which the rule is contained. */ /*============================================*/ agendaPtr = ((struct defruleModule *) theRule->header.whichModule)->agenda; /*==============================================*/ /* Loop through every activation on the agenda. */ /*==============================================*/ while (agendaPtr != NULL) { agendaNext = agendaPtr->next; /*========================================================*/ /* Check each disjunct of the rule against the activation */ /* to determine if the activation points to the rule. If */ /* it does, then remove the activation from the agenda. */ /*========================================================*/ for (tempRule = theRule; tempRule != NULL; tempRule = tempRule->disjunct) { if (agendaPtr->theRule == tempRule) { RemoveActivation(theEnv,agendaPtr,TRUE,TRUE); break; } } agendaPtr = agendaNext; } } /****************************************************************/ /* EnvGetNextActivation: Returns an activation from the Agenda. */ /* If its argument is NULL, then the first activation on the */ /* Agenda is returned. If its argument is not NULL, the next */ /* activation after the argument is returned. */ /****************************************************************/ globle void *EnvGetNextActivation( void *theEnv, void *actPtr) { struct defruleModule *theModuleItem; if (actPtr == NULL) { theModuleItem = (struct defruleModule *) GetModuleItem(theEnv,NULL,DefruleData(theEnv)->DefruleModuleIndex); if (theModuleItem == NULL) return(NULL); return((void *) theModuleItem->agenda); } else { return((void *) (((struct activation *) actPtr)->next)); } } /*********************************************/ /* EnvGetActivationName: Returns the name of */ /* the rule associated with an activation. */ /*********************************************/ #if IBM_TBC #pragma argsused #endif globle char *EnvGetActivationName( void *theEnv, void *actPtr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(ValueToString(((struct activation *) actPtr)->theRule->header.name)); } /**************************************/ /* EnvSetActivationSalience: Sets the */ /* salience value of an activation. */ /**************************************/ #if IBM_TBC #pragma argsused #endif globle int EnvSetActivationSalience( void *theEnv, void *actPtr, int value) { int temp; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif temp = ((struct activation *) actPtr)->salience; ((struct activation *) actPtr)->salience = value; return(temp); } /**********************************************/ /* EnvGetActivationPPForm: Returns the pretty */ /* print representation of an activation. */ /**********************************************/ globle void EnvGetActivationPPForm( void *theEnv, char *buffer, unsigned bufferLength, void *theActivation) { OpenStringDestination(theEnv,"ActPPForm",buffer,bufferLength); PrintActivation(theEnv,"ActPPForm",(void *) theActivation); CloseStringDestination(theEnv,"ActPPForm"); } /****************************************************/ /* EnvGetActivationBasisPPForm: Returns the pretty */ /* print representation of an activation's basis. */ /****************************************************/ globle void EnvGetActivationBasisPPForm( void *theEnv, char *buffer, unsigned bufferLength, void *vTheActivation) { struct activation *theActivation = (struct activation *) vTheActivation; OpenStringDestination(theEnv,"ActPPForm",buffer,bufferLength); PrintPartialMatch(theEnv,"ActPPForm",theActivation->basis); CloseStringDestination(theEnv,"ActPPForm"); } /********************************************/ /* MoveActivationToTop: Moves the specified */ /* activation to the top of the agenda. */ /********************************************/ globle intBool MoveActivationToTop( void *theEnv, void *vtheActivation) { struct activation *prevPtr; struct activation *theActivation = (struct activation *) vtheActivation; struct defruleModule *theModuleItem; /*====================================*/ /* Determine the module of the agenda */ /* in which the activation is stored. */ /*====================================*/ theModuleItem = (struct defruleModule *) theActivation->theRule->header.whichModule; /*============================================*/ /* If the activation is already at the top of */ /* the agenda, then nothing needs to be done. */ /*============================================*/ if (theActivation == theModuleItem->agenda) return(FALSE); /*=================================================*/ /* Update the pointers of the activation preceding */ /* and following the activation being moved. */ /*=================================================*/ prevPtr = theActivation->prev; prevPtr->next = theActivation->next; if (theActivation->next != NULL) theActivation->next->prev = prevPtr; /*=======================================================*/ /* Move the activation and then update its pointers, the */ /* pointers of the activation following it, and the */ /* module pointer to the top activation on the agenda. */ /*=======================================================*/ theActivation->next = theModuleItem->agenda; theModuleItem->agenda->prev = theActivation; theActivation->prev = NULL; theModuleItem->agenda = theActivation; /*=============================*/ /* Mark the agenda as changed. */ /*=============================*/ AgendaData(theEnv)->AgendaChanged = TRUE; return(TRUE); } /**********************************************/ /* EnvDeleteActivation: Removes the specified */ /* activation from the agenda. */ /**********************************************/ globle intBool EnvDeleteActivation( void *theEnv, void *theActivation) { if (theActivation == NULL) RemoveAllActivations(theEnv); else RemoveActivation(theEnv,(struct activation *) theActivation,TRUE,TRUE); return(TRUE); } /*******************************************************/ /* DetachActivation: Detaches the specified activation */ /* from the list of activations on the Agenda. */ /*******************************************************/ globle intBool DetachActivation( void *theEnv, void *vTheActivation) { struct defruleModule *theModuleItem; struct activation *theActivation = (struct activation *) vTheActivation; /*============================*/ /* A NULL pointer is invalid. */ /*============================*/ if (theActivation == NULL) SystemError(theEnv,"AGENDA",1); /*====================================*/ /* Determine the module of the agenda */ /* in which the activation is stored. */ /*====================================*/ theModuleItem = (struct defruleModule *) theActivation->theRule->header.whichModule; /*========================================================*/ /* If the activation is the top activation on the agenda, */ /* then update the module pointer to agenda. */ /*========================================================*/ if (theActivation == theModuleItem->agenda) { theModuleItem->agenda = theActivation->next; } /*==================================================*/ /* Update the pointers in the preceding activation. */ /*==================================================*/ if (theActivation->prev != NULL) { theActivation->prev->next = theActivation->next; } /*==================================================*/ /* Update the pointers in the following activation. */ /*==================================================*/ if (theActivation->next != NULL) { theActivation->next->prev = theActivation->prev; } /*=================================================*/ /* Update the pointers in the detached activation. */ /*=================================================*/ theActivation->prev = NULL; theActivation->next = NULL; /*=============================*/ /* Mark the agenda as changed. */ /*=============================*/ AgendaData(theEnv)->AgendaChanged = TRUE; return(TRUE); } /****************************************************************************/ /* PrintActivation: Prints an activation in a "pretty" format. Salience, */ /* rule name, and the partial match which activated the rule are printed. */ /****************************************************************************/ static void PrintActivation( void *theEnv, char *logicalName, void *vTheActivation) { struct activation *theActivation = (struct activation *) vTheActivation; char printSpace[20]; sprintf(printSpace,"%-6d ",theActivation->salience); EnvPrintRouter(theEnv,logicalName,printSpace); EnvPrintRouter(theEnv,logicalName,ValueToString(theActivation->theRule->header.name)); EnvPrintRouter(theEnv,logicalName,": "); PrintPartialMatch(theEnv,logicalName,theActivation->basis); } /*******************************/ /* EnvAgenda: C access routine */ /* for the agenda command. */ /*******************************/ globle void EnvAgenda( void *theEnv, char *logicalName, void *vTheModule) { struct defmodule *theModule = (struct defmodule *) vTheModule; ListItemsDriver(theEnv,logicalName,theModule,"activation","activations", EnvGetNextActivation,NULL,PrintActivation,NULL); } /*******************************************************************/ /* RemoveActivation: Returns an activation and its associated data */ /* structures to the Memory Manager. Links to other activations */ /* and partial matches may also be updated. */ /*******************************************************************/ globle void RemoveActivation( void *theEnv, void *vTheActivation, int updateAgenda, int updateLinks) { struct defruleModule *theModuleItem; struct activation *theActivation = (struct activation *) vTheActivation; /*====================================*/ /* Determine the module of the agenda */ /* in which the activation is stored. */ /*====================================*/ theModuleItem = (struct defruleModule *) theActivation->theRule->header.whichModule; /*=================================*/ /* Update the agenda if necessary. */ /*=================================*/ if (updateAgenda == TRUE) { /*===============================================*/ /* Update the pointer links between activations. */ /*===============================================*/ if (theActivation->prev == NULL) { theModuleItem->agenda = theModuleItem->agenda->next; if (theModuleItem->agenda != NULL) theModuleItem->agenda->prev = NULL; } else { theActivation->prev->next = theActivation->next; if (theActivation->next != NULL) { theActivation->next->prev = theActivation->prev; } } /*===================================*/ /* Indicate removal of activation if */ /* activations are being watched. */ /*===================================*/ #if DEBUGGING_FUNCTIONS if (theActivation->theRule->watchActivation) { EnvPrintRouter(theEnv,WTRACE,"<== Activation "); PrintActivation(theEnv,WTRACE,(void *) theActivation); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*=============================*/ /* Mark the agenda as changed. */ /*=============================*/ AgendaData(theEnv)->AgendaChanged = TRUE; } /*============================================*/ /* Update join and agenda links if necessary. */ /*============================================*/ if ((updateLinks == TRUE) && (theActivation->basis != NULL)) { theActivation->basis->binds[theActivation->basis->bcount].gm.theValue = NULL; } /*================================================*/ /* Return the activation to the free memory pool. */ /*================================================*/ AgendaData(theEnv)->NumberOfActivations--; if (theActivation->sortedBasis != NULL) { ReturnPartialMatch(theEnv,theActivation->sortedBasis); } rtn_struct(theEnv,activation,theActivation); } /**************************************************************/ /* AgendaClearFunction: Agenda clear routine for use with the */ /* clear command. Resets the current time tag to zero. */ /**************************************************************/ static void AgendaClearFunction( void *theEnv) { AgendaData(theEnv)->CurrentTimetag = 0; } /*************************************************/ /* RemoveAllActivations: Removes all activations */ /* from the agenda of the current module. */ /*************************************************/ globle void RemoveAllActivations( void *theEnv) { struct activation *tempPtr, *theActivation; theActivation = GetDefruleModuleItem(theEnv,NULL)->agenda; while (theActivation != NULL) { tempPtr = theActivation->next; RemoveActivation(theEnv,theActivation,TRUE,TRUE); theActivation = tempPtr; } } /*********************************************************/ /* EnvGetAgendaChanged: Returns the value of the boolean */ /* flag which indicates whether any changes have been */ /* made to the agenda. */ /*********************************************************/ globle int EnvGetAgendaChanged( void *theEnv) { return(AgendaData(theEnv)->AgendaChanged); } /*****************************************************************/ /* EnvSetAgendaChanged: Sets the value of the boolean flag which */ /* indicates whether any changes have been made to the agenda. */ /*****************************************************************/ globle void EnvSetAgendaChanged( void *theEnv, int value) { AgendaData(theEnv)->AgendaChanged = value; } /**********************************************************/ /* EnvReorderAgenda: Completely reorders the agenda based */ /* on the current conflict resolution strategy. */ /**********************************************************/ globle void EnvReorderAgenda( void *theEnv, void *vTheModule) { struct activation *theActivation, *tempPtr; struct defmodule *theModule = (struct defmodule *) vTheModule; int allModules = FALSE; struct defruleModule *theModuleItem; /*=============================================*/ /* If the module specified is a NULL pointer, */ /* then every module has its agenda reordered. */ /*=============================================*/ if (theModule == NULL) { allModules = TRUE; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); } /*========================*/ /* Reorder the agenda(s). */ /*========================*/ for (; theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=================================*/ /* Get the list of activations and */ /* remove them from the agenda. */ /*=================================*/ theModuleItem = GetDefruleModuleItem(theEnv,theModule); theActivation = theModuleItem->agenda; theModuleItem->agenda = NULL; /*=========================================*/ /* Reorder the activations by placing them */ /* back on the agenda one by one. */ /*=========================================*/ while (theActivation != NULL) { tempPtr = theActivation->next; theActivation->next = NULL; theActivation->prev = NULL; PlaceActivation(theEnv,&(theModuleItem->agenda),theActivation); theActivation = tempPtr; } /*===============================================*/ /* Return if only one agenda is being reordered. */ /*===============================================*/ if (! allModules) return; } } /****************************************************/ /* GetNumberOfActivations: Returns the value of the */ /* total number of activations on all agendas. */ /****************************************************/ globle unsigned long GetNumberOfActivations( void *theEnv) { return(AgendaData(theEnv)->NumberOfActivations); } /******************************************************/ /* RefreshCommand: H/L Command for refreshing a rule. */ /* Syntax: (refresh ) */ /******************************************************/ globle void RefreshCommand( void *theEnv) { char *ruleName; void *rulePtr; /*===========================*/ /* Get the name of the rule. */ /*===========================*/ ruleName = GetConstructName(theEnv,"refresh","rule name"); if (ruleName == NULL) return; /*===============================*/ /* Determine if the rule exists. */ /*===============================*/ rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } /*===================*/ /* Refresh the rule. */ /*===================*/ EnvRefresh(theEnv,rulePtr); } /************************************************************/ /* EnvRefresh: Refreshes a defrule. Activations of the rule */ /* that have already been fired are added to the agenda. */ /************************************************************/ globle intBool EnvRefresh( void *theEnv, void *theRule) { struct defrule *rulePtr; struct partialMatch *listOfMatches; /*====================================*/ /* Refresh each disjunct of the rule. */ /*====================================*/ for (rulePtr = (struct defrule *) theRule; rulePtr != NULL; rulePtr = rulePtr->disjunct) { /*================================*/ /* Check each partial match that */ /* satisfies the LHS of the rule. */ /*================================*/ for (listOfMatches = rulePtr->lastJoin->beta; listOfMatches != NULL; listOfMatches = listOfMatches->next) { /*=======================================================*/ /* If the partial match is associated with an activation */ /* (which it should always be) and it isn't associated */ /* with a not CE that still has matches, then place a */ /* new activation on the agenda if this partial match */ /* doesn't have an activation associated with it. */ /*=======================================================*/ if ((listOfMatches->activationf) && (! listOfMatches->counterf)) { if (listOfMatches->binds[listOfMatches->bcount].gm.theValue == NULL) { AddActivation(theEnv,rulePtr,listOfMatches); } } } } return(TRUE); } /**********************************************/ /* RefreshAgendaCommand: H/L access routine */ /* for the refresh-agenda command. */ /**********************************************/ globle void RefreshAgendaCommand( void *theEnv) { int numArgs, error; struct defmodule *theModule; /*==============================================*/ /* This function can have at most one argument. */ /*==============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"refresh-agenda",NO_MORE_THAN,1)) == -1) return; /*===============================================================*/ /* If a module name is specified, then the agenda of that module */ /* is refreshed. Otherwise, the agenda of the current module is */ /* refreshed. */ /*===============================================================*/ if (numArgs == 1) { theModule = GetModuleName(theEnv,"refresh-agenda",1,&error); if (error) return; } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*===============================================*/ /* Refresh the agenda of the appropriate module. */ /*===============================================*/ EnvRefreshAgenda(theEnv,theModule); } /**************************************/ /* EnvRefreshAgenda: C access routine */ /* for the refresh-agenda command. */ /**************************************/ globle void EnvRefreshAgenda( void *theEnv, void *vTheModule) { struct activation *theActivation; struct defmodule *theModule = (struct defmodule *) vTheModule; intBool oldValue; int allModules = FALSE; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*=============================================*/ /* If the module specified is a NULL pointer, */ /* then every module has its agenda refreshed. */ /*=============================================*/ if (theModule == NULL) { allModules = TRUE; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); } /*=======================================================*/ /* Remember the current setting for salience evaluation. */ /* To perform the refresh, the when activated setting is */ /* used to recompute the salience values. */ /*=======================================================*/ oldValue = EnvGetSalienceEvaluation(theEnv); EnvSetSalienceEvaluation(theEnv,WHEN_ACTIVATED); /*========================*/ /* Refresh the agenda(s). */ /*========================*/ for (; theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=========================================*/ /* Change the current module to the module */ /* of the agenda being refreshed. */ /*=========================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*================================================================*/ /* Recompute the salience values for the current module's agenda. */ /*================================================================*/ for (theActivation = (struct activation *) EnvGetNextActivation(theEnv,NULL); theActivation != NULL; theActivation = (struct activation *) EnvGetNextActivation(theEnv,theActivation)) { theActivation->salience = EvaluateSalience(theEnv,theActivation->theRule); } /*======================================================*/ /* Reorder the agenda based on the new salience values. */ /*======================================================*/ EnvReorderAgenda(theEnv,theModule); /*===============================================*/ /* Return if only one agenda is being refreshed. */ /*===============================================*/ if (! allModules) { EnvSetSalienceEvaluation(theEnv,oldValue); RestoreCurrentModule(theEnv); return; } } /*==========================================*/ /* Restore the salience evaluation setting. */ /*==========================================*/ EnvSetSalienceEvaluation(theEnv,oldValue); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); } /*********************************************************/ /* SetSalienceEvaluationCommand: H/L Command for setting */ /* the salience evaluation behavior. */ /* Syntax: (set-salience-evaluation-behavior ) */ /*********************************************************/ globle void *SetSalienceEvaluationCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument, *oldValue; /*==================================================*/ /* Get the current setting for salience evaluation. */ /*==================================================*/ oldValue = SalienceEvaluationName(EnvGetSalienceEvaluation(theEnv)); /*=========================================*/ /* This function expects a single argument */ /* which must be a symbol. */ /*=========================================*/ if (EnvArgCountCheck(theEnv,"set-salience-evaluation",EXACTLY,1) == -1) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue)); } if (EnvArgTypeCheck(theEnv,"set-salience-evaluation",1,SYMBOL,&argPtr) == FALSE) { return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue)); } /*=============================================================*/ /* The allowed symbols to pass as an argument to this function */ /* are when-defined, when-activated, and every-cycle. */ /*=============================================================*/ argument = DOToString(argPtr); if (strcmp(argument,"when-defined") == 0) { EnvSetSalienceEvaluation(theEnv,WHEN_DEFINED); } else if (strcmp(argument,"when-activated") == 0) { EnvSetSalienceEvaluation(theEnv,WHEN_ACTIVATED); } else if (strcmp(argument,"every-cycle") == 0) { EnvSetSalienceEvaluation(theEnv,EVERY_CYCLE); } else { ExpectedTypeError1(theEnv,"set-salience-evaluation",1, "symbol with value when-defined, when-activated, or every-cycle"); return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue)); } /*=================================================*/ /* Return the old setting for salience evaluation. */ /*=================================================*/ return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue)); } /*********************************************************/ /* GetSalienceEvaluationCommand: H/L Command for getting */ /* the salience evaluation behavior. */ /* Syntax: (get-salience-evaluation-behavior) */ /*********************************************************/ globle void *GetSalienceEvaluationCommand( void *theEnv) { EnvArgCountCheck(theEnv,"get-salience-evaluation",EXACTLY,0); return((SYMBOL_HN *) EnvAddSymbol(theEnv,SalienceEvaluationName(EnvGetSalienceEvaluation(theEnv)))); } /*****************************************************************/ /* SalienceEvaluationName: Given the integer value corresponding */ /* to a specified salience evaluation behavior, returns a */ /* character string of the behavior's name. */ /*****************************************************************/ static char *SalienceEvaluationName( int strategy) { char *sname; switch (strategy) { case WHEN_DEFINED: sname = "when-defined"; break; case WHEN_ACTIVATED: sname = "when-activated"; break; case EVERY_CYCLE: sname = "every-cycle"; break; default: sname = "unknown"; break; } return(sname); } /****************************************************************/ /* EnvGetSalienceEvaluation: Returns the value of current type */ /* of salience evaluation (e.g., when defined, when activated, */ /* or every cycle). */ /****************************************************************/ globle intBool EnvGetSalienceEvaluation( void *theEnv) { return(AgendaData(theEnv)->SalienceEvaluation); } /***********************************************/ /* EnvSetSalienceEvaluation: Sets the value of */ /* the current type of salience evaluation. */ /***********************************************/ globle intBool EnvSetSalienceEvaluation( void *theEnv, int value) { int ov; ov = AgendaData(theEnv)->SalienceEvaluation; AgendaData(theEnv)->SalienceEvaluation = value; return(ov); } /*****************************************************************/ /* EvaluateSalience: Returns the salience value of the specified */ /* defrule. If salience evaluation is currently set to */ /* when-defined, then the current value of the rule's salience */ /* is returned. Otherwise the salience expression associated */ /* with the rule is reevaluated, the value is stored as the */ /* rule's current salience, and it is then returned. */ /*****************************************************************/ static int EvaluateSalience( void *theEnv, void *vPtr) { struct defrule *rPtr = (struct defrule *) vPtr; DATA_OBJECT salienceValue; int salience; /*==================================================*/ /* If saliences are only being evaluated when rules */ /* are defined, then just return the last salience */ /* value evaluated for the rule. */ /*==================================================*/ if (EnvGetSalienceEvaluation(theEnv) == WHEN_DEFINED) { return(rPtr->salience); } /*=================================================================*/ /* If the rule's salience value was defined as an integer constant */ /* (i.e., not an expression or global variable which could change */ /* on reevaluation), then just return the salience value computed */ /* for the rule when it was defined. */ /*=================================================================*/ if (rPtr->dynamicSalience == NULL) return(rPtr->salience); /*====================================================*/ /* Reevaluate the rule's salience. If an error occurs */ /* during evaluation, print an error message. */ /*====================================================*/ SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,rPtr->dynamicSalience,&salienceValue)) { SalienceInformationError(theEnv,"defrule",ValueToString(rPtr->header.name)); return(rPtr->salience); } /*========================================*/ /* The salience value must be an integer. */ /*========================================*/ if (salienceValue.type != INTEGER) { SalienceNonIntegerError(theEnv); SalienceInformationError(theEnv,"defrule",ValueToString(rPtr->header.name)); SetEvaluationError(theEnv,TRUE); return(rPtr->salience); } /*==========================================*/ /* The salience value must fall between the */ /* minimum and maximum allowed values. */ /*==========================================*/ salience = (int) ValueToLong(salienceValue.value); if ((salience > MAX_DEFRULE_SALIENCE) || (salience < MIN_DEFRULE_SALIENCE)) { SalienceRangeError(theEnv,MIN_DEFRULE_SALIENCE,MAX_DEFRULE_SALIENCE); SetEvaluationError(theEnv,TRUE); SalienceInformationError(theEnv,"defrule",ValueToString(((struct defrule *) rPtr)->header.name)); return(rPtr->salience); } /*===================================*/ /* Store the new salience value with */ /* the rule and return this value. */ /*===================================*/ rPtr->salience = salience; return(rPtr->salience); } #if DEBUGGING_FUNCTIONS /***********************************************/ /* AgendaCommand: Prints out the agenda of the */ /* rules that are ready to fire. */ /* Syntax: (agenda) */ /***********************************************/ globle void AgendaCommand( void *theEnv) { int numArgs, error; struct defmodule *theModule; /*==============================================*/ /* This function can have at most one argument. */ /*==============================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"agenda",NO_MORE_THAN,1)) == -1) return; /*===============================================================*/ /* If a module name is specified, then the agenda of that module */ /* is displayed. Otherwise, the agenda of the current module is */ /* displayed. */ /*===============================================================*/ if (numArgs == 1) { theModule = GetModuleName(theEnv,"agenda",1,&error); if (error) return; } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*===============================================*/ /* Display the agenda of the appropriate module. */ /*===============================================*/ EnvAgenda(theEnv,WDISPLAY,theModule); } #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/genrccom.h0000755000175000017500000001676310441143533014513 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_genrccom #define _H_genrccom #define EnvGetDefgenericName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define EnvGetDefgenericPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define SetNextDefgeneric(g,t) SetNextConstruct((struct constructHeader *) g, \ (struct constructHeader *) t) #define GetDefgenericNamePointer(x) GetConstructNamePointer((struct constructHeader *) x) #define SetDefgenericPPForm(g,ppf) SetConstructPPForm(theEnv,(struct constructHeader *) g,ppf) #define EnvDefgenericModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_genrcfun #include "genrcfun.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DefgenericModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define FindDefgeneric(theEnv,a) EnvFindDefgeneric(theEnv,a) #define GetDefgenericList(theEnv,a,b) EnvGetDefgenericList(theEnv,a,b) #define GetDefgenericName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define GetDefgenericPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetDefgenericWatch(theEnv,a) EnvGetDefgenericWatch(theEnv,a) #define GetNextDefgeneric(theEnv,a) EnvGetNextDefgeneric(theEnv,a) #define IsDefgenericDeletable(theEnv,a) EnvIsDefgenericDeletable(theEnv,a) #define ListDefgenerics(theEnv,a,b) EnvListDefgenerics(theEnv,a,b) #define SetDefgenericWatch(theEnv,a,b) EnvSetDefgenericWatch(theEnv,a,b) #define Undefgeneric(theEnv,a) EnvUndefgeneric(theEnv,a) #define GetDefmethodDescription(theEnv,a,b,c,d) EnvGetDefmethodDescription(theEnv,a,b,c,d) #define GetDefmethodList(theEnv,a,b) EnvGetDefmethodList(theEnv,a,b) #define GetDefmethodPPForm(theEnv,a,b) EnvGetDefmethodPPForm(theEnv,a,b) #define GetDefmethodWatch(theEnv,a,b) EnvGetDefmethodWatch(theEnv,a,b) #define GetMethodRestrictions(theEnv,a,b,c) EnvGetMethodRestrictions(theEnv,a,b,c) #define GetNextDefmethod(theEnv,a,b) EnvGetNextDefmethod(theEnv,a,b) #define IsDefmethodDeletable(theEnv,a,b) EnvIsDefmethodDeletable(theEnv,a,b) #define ListDefmethods(theEnv,a,b) EnvListDefmethods(theEnv,a,b) #define SetDefmethodWatch(theEnv,a,b,c) EnvSetDefmethodWatch(theEnv,a,b,c) #define Undefmethod(theEnv,a,b) EnvUndefmethod(theEnv,a,b) #else #define DefgenericModule(x) GetConstructModuleName((struct constructHeader *) x) #define FindDefgeneric(a) EnvFindDefgeneric(GetCurrentEnvironment(),a) #define GetDefgenericList(a,b) EnvGetDefgenericList(GetCurrentEnvironment(),a,b) #define GetDefgenericName(x) GetConstructNameString((struct constructHeader *) x) #define GetDefgenericPPForm(x) GetConstructPPForm(GetCurrentEnvironment(),(struct constructHeader *) x) #define GetDefgenericWatch(a) EnvGetDefgenericWatch(GetCurrentEnvironment(),a) #define GetNextDefgeneric(a) EnvGetNextDefgeneric(GetCurrentEnvironment(),a) #define IsDefgenericDeletable(a) EnvIsDefgenericDeletable(GetCurrentEnvironment(),a) #define ListDefgenerics(a,b) EnvListDefgenerics(GetCurrentEnvironment(),a,b) #define SetDefgenericWatch(a,b) EnvSetDefgenericWatch(GetCurrentEnvironment(),a,b) #define Undefgeneric(a) EnvUndefgeneric(GetCurrentEnvironment(),a) #define GetDefmethodDescription(a,b,c,d) EnvGetDefmethodDescription(GetCurrentEnvironment(),a,b,c,d) #define GetDefmethodList(a,b) EnvGetDefmethodList(GetCurrentEnvironment(),a,b) #define GetDefmethodPPForm(a,b) EnvGetDefmethodPPForm(GetCurrentEnvironment(),a,b) #define GetDefmethodWatch(a,b) EnvGetDefmethodWatch(GetCurrentEnvironment(),a,b) #define GetMethodRestrictions(a,b,c) EnvGetMethodRestrictions(GetCurrentEnvironment(),a,b,c) #define GetNextDefmethod(a,b) EnvGetNextDefmethod(GetCurrentEnvironment(),a,b) #define IsDefmethodDeletable(a,b) EnvIsDefmethodDeletable(GetCurrentEnvironment(),a,b) #define ListDefmethods(a,b) EnvListDefmethods(GetCurrentEnvironment(),a,b) #define SetDefmethodWatch(a,b,c) EnvSetDefmethodWatch(GetCurrentEnvironment(),a,b,c) #define Undefmethod(a,b) EnvUndefmethod(GetCurrentEnvironment(),a,b) #endif LOCALE void SetupGenericFunctions(void *); LOCALE void *EnvFindDefgeneric(void *,char *); LOCALE DEFGENERIC *LookupDefgenericByMdlOrScope(void *,char *); LOCALE DEFGENERIC *LookupDefgenericInScope(void *,char *); LOCALE void *EnvGetNextDefgeneric(void *,void *); LOCALE unsigned EnvGetNextDefmethod(void *,void *,unsigned); LOCALE int EnvIsDefgenericDeletable(void *,void *); LOCALE int EnvIsDefmethodDeletable(void *,void *,unsigned); LOCALE void UndefgenericCommand(void *); LOCALE void *GetDefgenericModuleCommand(void *); LOCALE void UndefmethodCommand(void *); LOCALE DEFMETHOD *GetDefmethodPointer(void *,unsigned); LOCALE intBool EnvUndefgeneric(void *,void *); LOCALE intBool EnvUndefmethod(void *,void *,unsigned); #if ! OBJECT_SYSTEM LOCALE void TypeCommand(void *,DATA_OBJECT *); #endif #if DEBUGGING_FUNCTIONS LOCALE void EnvGetDefmethodDescription(void *,char *,int,void *,unsigned); LOCALE unsigned EnvGetDefgenericWatch(void *,void *); LOCALE void EnvSetDefgenericWatch(void *,unsigned,void *); LOCALE unsigned EnvGetDefmethodWatch(void *,void *,unsigned); LOCALE void EnvSetDefmethodWatch(void *,unsigned,void *,unsigned); LOCALE void PPDefgenericCommand(void *); LOCALE void PPDefmethodCommand(void *); LOCALE void ListDefmethodsCommand(void *); LOCALE char *EnvGetDefmethodPPForm(void *,void *,unsigned); LOCALE void ListDefgenericsCommand(void *); LOCALE void EnvListDefgenerics(void *,char *,struct defmodule *); LOCALE void EnvListDefmethods(void *,char *,void *); #endif LOCALE void GetDefgenericListFunction(void *,DATA_OBJECT *); globle void EnvGetDefgenericList(void *,DATA_OBJECT *,struct defmodule *); LOCALE void GetDefmethodListCommand(void *,DATA_OBJECT *); LOCALE void EnvGetDefmethodList(void *,void *,DATA_OBJECT *); LOCALE void GetMethodRestrictionsCommand(void *,DATA_OBJECT *); LOCALE void EnvGetMethodRestrictions(void *,void *,unsigned,DATA_OBJECT *); #endif clips-6.24/clipssrc/._rulelhs.h0000400000175000017500000000012207422634626014567 0ustar jfsjfsMac OS X  2 RTEXT????`aclips-6.24/clipssrc/multifld.h0000755000175000017500000001304510441602251014521 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* MULTIFIELD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for creating and manipulating */ /* multifield values. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Moved ImplodeMultifield from multifun.c. */ /* */ /*************************************************************/ #ifndef _H_multifld #define _H_multifld struct field; struct multifield; #ifndef _H_evaluatn #include "evaluatn.h" #endif struct field { unsigned short type; void *value; }; struct multifield { unsigned busyCount; short depth; unsigned long multifieldLength; struct multifield *next; struct field theFields[1]; }; typedef struct multifield SEGMENT; typedef struct multifield * SEGMENT_PTR; typedef struct multifield * MULTIFIELD_PTR; typedef struct field FIELD; typedef struct field * FIELD_PTR; #define GetMFLength(target) (((struct multifield *) (target))->multifieldLength) #define GetMFPtr(target,index) (&(((struct field *) ((struct multifield *) (target))->theFields)[index-1])) #define SetMFType(target,index,value) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].type = (unsigned short) (value)) #define SetMFValue(target,index,val) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].value = (void *) (val)) #define GetMFType(target,index) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].type) #define GetMFValue(target,index) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].value) #define EnvGetMFLength(theEnv,target) (((struct multifield *) (target))->multifieldLength) #define EnvGetMFPtr(theEnv,target,index) (&(((struct field *) ((struct multifield *) (target))->theFields)[index-1])) #define EnvSetMFType(theEnv,target,index,value) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].type = (unsigned short) (value)) #define EnvSetMFValue(theEnv,target,index,val) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].value = (void *) (val)) #define EnvGetMFType(theEnv,target,index) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].type) #define EnvGetMFValue(theEnv,target,index) (((struct field *) ((struct multifield *) (target))->theFields)[index-1].value) /*==================*/ /* ENVIRONMENT DATA */ /*==================*/ #define MULTIFIELD_DATA 51 struct multifieldData { struct multifield *ListOfMultifields; }; #define MultifieldData(theEnv) ((struct multifieldData *) GetEnvironmentData(theEnv,MULTIFIELD_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _MULTIFLD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define CreateMultifield(theEnv,a) EnvCreateMultifield(theEnv,a) #else #define CreateMultifield(a) EnvCreateMultifield(GetCurrentEnvironment(),a) #endif LOCALE void InitializeMultifieldData(void *); LOCALE void *CreateMultifield2(void *,unsigned long); LOCALE void ReturnMultifield(void *,struct multifield *); LOCALE void MultifieldInstall(void *,struct multifield *); LOCALE void MultifieldDeinstall(void *,struct multifield *); LOCALE struct multifield *StringToMultifield(void *,char *); LOCALE void *EnvCreateMultifield(void *,unsigned long); LOCALE void AddToMultifieldList(void *,struct multifield *); LOCALE void FlushMultifields(void *); LOCALE void DuplicateMultifield(void *,struct dataObject *,struct dataObject *); LOCALE void PrintMultifield(void *,char *,SEGMENT_PTR,long,long,int); LOCALE intBool MultifieldDOsEqual(DATA_OBJECT_PTR,DATA_OBJECT_PTR); LOCALE void StoreInMultifield(void *,DATA_OBJECT *,EXPRESSION *,int); LOCALE void *CopyMultifield(void *,struct multifield *); LOCALE intBool MultifieldsEqual(struct multifield *,struct multifield *); LOCALE void *DOToMultifield(void *,DATA_OBJECT *); LOCALE unsigned HashMultifield(struct multifield *,unsigned); LOCALE struct multifield *GetMultifieldList(void *); LOCALE void *ImplodeMultifield(void *,DATA_OBJECT *); #endif clips-6.24/clipssrc/classinf.c0000755000175000017500000010620510441130151014472 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CLASS INFO PROGRAMMATIC ACCESS MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Class Information Interface Support Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include #include "argacces.h" #include "classcom.h" #include "classexm.h" #include "classfun.h" #include "classini.h" #include "envrnmnt.h" #include "memalloc.h" #include "insfun.h" #include "msgcom.h" #include "msgfun.h" #include "multifld.h" #include "prntutil.h" #define _CLASSINF_SOURCE_ #include "classinf.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void SlotInfoSupportFunction(void *,DATA_OBJECT *,char *,void (*)(void *,void *,char *,DATA_OBJECT *)); static unsigned CountSubclasses(DEFCLASS *,int,int); static unsigned StoreSubclasses(void *,unsigned,DEFCLASS *,int,int,short); static SLOT_DESC *SlotInfoSlot(void *,DATA_OBJECT *,DEFCLASS *,char *,char *); /********************************************************************* NAME : ClassAbstractPCommand DESCRIPTION : Determines if direct instances of a class can be made INPUTS : None RETURNS : TRUE (1) if class is abstract, FALSE (0) if concrete SIDE EFFECTS : None NOTES : Syntax: (class-abstractp ) *********************************************************************/ globle int ClassAbstractPCommand( void *theEnv) { DATA_OBJECT tmp; DEFCLASS *cls; if (EnvArgTypeCheck(theEnv,"class-abstractp",1,SYMBOL,&tmp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (cls == NULL) { ClassExistError(theEnv,"class-abstractp",ValueToString(tmp.value)); return(FALSE); } return(EnvClassAbstractP(theEnv,(void *) cls)); } #if DEFRULE_CONSTRUCT /***************************************************************** NAME : ClassReactivePCommand DESCRIPTION : Determines if instances of a class can match rule patterns INPUTS : None RETURNS : TRUE (1) if class is reactive, FALSE (0) if non-reactive SIDE EFFECTS : None NOTES : Syntax: (class-reactivep ) *****************************************************************/ globle int ClassReactivePCommand( void *theEnv) { DATA_OBJECT tmp; DEFCLASS *cls; if (EnvArgTypeCheck(theEnv,"class-reactivep",1,SYMBOL,&tmp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (cls == NULL) { ClassExistError(theEnv,"class-reactivep",ValueToString(tmp.value)); return(FALSE); } return(EnvClassReactiveP(theEnv,(void *) cls)); } #endif /*********************************************************** NAME : ClassInfoFnxArgs DESCRIPTION : Examines arguments for: class-slots, get-defmessage-handler-list, class-superclasses and class-subclasses INPUTS : 1) Name of function 2) A buffer to hold a flag indicating if the inherit keyword was specified RETURNS : Pointer to the class on success, NULL on errors SIDE EFFECTS : inhp flag set error flag set NOTES : None ***********************************************************/ globle void *ClassInfoFnxArgs( void *theEnv, char *fnx, int *inhp) { void *clsptr; DATA_OBJECT tmp; *inhp = 0; if (EnvRtnArgCount(theEnv) == 0) { ExpectedCountError(theEnv,fnx,AT_LEAST,1); SetEvaluationError(theEnv,TRUE); return(NULL); } if (EnvArgTypeCheck(theEnv,fnx,1,SYMBOL,&tmp) == FALSE) return(NULL); clsptr = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmp)); if (clsptr == NULL) { ClassExistError(theEnv,fnx,ValueToString(tmp.value)); return(NULL); } if (EnvRtnArgCount(theEnv) == 2) { if (EnvArgTypeCheck(theEnv,fnx,2,SYMBOL,&tmp) == FALSE) return(NULL); if (strcmp(ValueToString(tmp.value),"inherit") == 0) *inhp = 1; else { SyntaxErrorMessage(theEnv,fnx); SetEvaluationError(theEnv,TRUE); return(NULL); } } return(clsptr); } /******************************************************************** NAME : ClassSlotsCommand DESCRIPTION : Groups slot info for a class into a multifield value for dynamic perusal INPUTS : Data object buffer to hold the slots of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the slots of the class NOTES : Syntax: (class-slots [inherit]) ********************************************************************/ globle void ClassSlotsCommand( void *theEnv, DATA_OBJECT *result) { int inhp; void *clsptr; clsptr = ClassInfoFnxArgs(theEnv,"class-slots",&inhp); if (clsptr == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvClassSlots(theEnv,clsptr,result,inhp); } /************************************************************************ NAME : ClassSuperclassesCommand DESCRIPTION : Groups superclasses for a class into a multifield value for dynamic perusal INPUTS : Data object buffer to hold the superclasses of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the superclasses of the class NOTES : Syntax: (class-superclasses [inherit]) ************************************************************************/ globle void ClassSuperclassesCommand( void *theEnv, DATA_OBJECT *result) { int inhp; void *clsptr; clsptr = ClassInfoFnxArgs(theEnv,"class-superclasses",&inhp); if (clsptr == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvClassSuperclasses(theEnv,clsptr,result,inhp); } /************************************************************************ NAME : ClassSubclassesCommand DESCRIPTION : Groups subclasses for a class into a multifield value for dynamic perusal INPUTS : Data object buffer to hold the subclasses of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the subclasses of the class NOTES : Syntax: (class-subclasses [inherit]) ************************************************************************/ globle void ClassSubclassesCommand( void *theEnv, DATA_OBJECT *result) { int inhp; void *clsptr; clsptr = ClassInfoFnxArgs(theEnv,"class-subclasses",&inhp); if (clsptr == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvClassSubclasses(theEnv,clsptr,result,inhp); } /*********************************************************************** NAME : GetDefmessageHandlersListCmd DESCRIPTION : Groups message-handlers for a class into a multifield value for dynamic perusal INPUTS : Data object buffer to hold the handlers of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the message-handlers of the class NOTES : Syntax: (get-defmessage-handler-list [inherit]) ***********************************************************************/ globle void GetDefmessageHandlersListCmd( void *theEnv, DATA_OBJECT *result) { int inhp; void *clsptr; if (EnvRtnArgCount(theEnv) == 0) EnvGetDefmessageHandlerList(theEnv,NULL,result,0); else { clsptr = ClassInfoFnxArgs(theEnv,"get-defmessage-handler-list",&inhp); if (clsptr == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } EnvGetDefmessageHandlerList(theEnv,clsptr,result,inhp); } } /********************************* Slot Information Access Functions *********************************/ globle void SlotFacetsCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-facets",EnvSlotFacets); } globle void SlotSourcesCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-sources",EnvSlotSources); } globle void SlotTypesCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-types",EnvSlotTypes); } globle void SlotAllowedValuesCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-allowed-values",EnvSlotAllowedValues); } globle void SlotAllowedClassesCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-allowed-classes",EnvSlotAllowedClasses); } globle void SlotRangeCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-range",EnvSlotRange); } globle void SlotCardinalityCommand( void *theEnv, DATA_OBJECT *result) { SlotInfoSupportFunction(theEnv,result,"slot-cardinality",EnvSlotCardinality); } /******************************************************************** NAME : EnvClassAbstractP DESCRIPTION : Determines if a class is abstract or not INPUTS : Generic pointer to class RETURNS : 1 if class is abstract, 0 otherwise SIDE EFFECTS : None NOTES : None ********************************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool EnvClassAbstractP( void *theEnv, void *clsptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) clsptr)->abstract); } #if DEFRULE_CONSTRUCT /******************************************************************** NAME : EnvClassReactiveP DESCRIPTION : Determines if a class is reactive or not INPUTS : Generic pointer to class RETURNS : 1 if class is reactive, 0 otherwise SIDE EFFECTS : None NOTES : None ********************************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool EnvClassReactiveP( void *theEnv, void *clsptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((DEFCLASS *) clsptr)->reactive); } #endif /******************************************************************** NAME : EnvClassSlots DESCRIPTION : Groups slot info for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the slots of the class 3) Include (1) or exclude (0) inherited slots RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the slots of the class NOTES : None ********************************************************************/ globle void EnvClassSlots( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { unsigned long size; register DEFCLASS *cls; register unsigned long i; cls = (DEFCLASS *) clsptr; size = inhp ? cls->instanceSlotCount : cls->slotCount; result->type = MULTIFIELD; SetpDOBegin(result,1); SetpDOEnd(result,size); result->value = (void *) EnvCreateMultifield(theEnv,size); if (size == 0) return; if (inhp) { for (i = 0 ; i < cls->instanceSlotCount ; i++) { SetMFType(result->value,i+1,SYMBOL); SetMFValue(result->value,i+1,cls->instanceTemplate[i]->slotName->name); } } else { for (i = 0 ; i < cls->slotCount ; i++) { SetMFType(result->value,i+1,SYMBOL); SetMFValue(result->value,i+1,cls->slots[i].slotName->name); } } } /************************************************************************ NAME : EnvGetDefmessageHandlerList DESCRIPTION : Groups handler info for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class (NULL to get handlers for all classes) 2) Data object buffer to hold the handlers of the class 3) Include (1) or exclude (0) inherited handlers RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names and types of the message-handlers of the class NOTES : None ************************************************************************/ globle void EnvGetDefmessageHandlerList( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { DEFCLASS *cls,*svcls,*svnxt,*supcls; unsigned j; register int classi,classiLimit; unsigned long i, sublen, len; if (clsptr == NULL) { inhp = 0; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL); svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls); } else { cls = (DEFCLASS *) clsptr; svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls); SetNextDefclass((void *) cls,NULL); } for (svcls = cls , i = 0 ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) { classiLimit = inhp ? cls->allSuperclasses.classCount : 1; for (classi = 0 ; classi < classiLimit ; classi++) i += cls->allSuperclasses.classArray[classi]->handlerCount; } len = i * 3; result->type = MULTIFIELD; SetpDOBegin(result,1); SetpDOEnd(result,len); result->value = (void *) EnvCreateMultifield(theEnv,len); for (cls = svcls , sublen = 0 ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) { classiLimit = inhp ? cls->allSuperclasses.classCount : 1; for (classi = 0 ; classi < classiLimit ; classi++) { supcls = cls->allSuperclasses.classArray[classi]; if (inhp == 0) i = sublen + 1; else i = len - (supcls->handlerCount * 3) - sublen + 1; for (j = 0 ; j < supcls->handlerCount ; j++) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,GetDefclassNamePointer((void *) supcls)); SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,supcls->handlers[j].name); SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,MessageHandlerData(theEnv)->hndquals[supcls->handlers[j].type])); } sublen += supcls->handlerCount * 3; } } if (svcls != NULL) SetNextDefclass((void *) svcls,(void *) svnxt); } /*************************************************************************** NAME : EnvClassSuperclasses DESCRIPTION : Groups the names of superclasses into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the superclasses of the class 3) Include (1) or exclude (0) indirect superclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the superclasses of the class NOTES : None ***************************************************************************/ globle void EnvClassSuperclasses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { PACKED_CLASS_LINKS *plinks; unsigned offset; register unsigned i,j; if (inhp) { plinks = &((DEFCLASS *) clsptr)->allSuperclasses; offset = 1; } else { plinks = &((DEFCLASS *) clsptr)->directSuperclasses; offset = 0; } result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,plinks->classCount - offset); result->value = (void *) EnvCreateMultifield(theEnv,result->end + 1U); if (result->end == -1) return; for (i = offset , j = 1 ; i < plinks->classCount ; i++ , j++) { SetMFType(result->value,j,SYMBOL); SetMFValue(result->value,j,GetDefclassNamePointer((void *) plinks->classArray[i])); } } /************************************************************************** NAME : EnvClassSubclasses DESCRIPTION : Groups the names of subclasses for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the sublclasses of the class 3) Include (1) or exclude (0) indirect subclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names the subclasses of the class NOTES : None **************************************************************************/ globle void EnvClassSubclasses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { register unsigned i; register int id; if ((id = GetTraversalID(theEnv)) == -1) return; i = CountSubclasses((DEFCLASS *) clsptr,inhp,id); ReleaseTraversalID(theEnv); result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); if (i == 0) return; if ((id = GetTraversalID(theEnv)) == -1) return; StoreSubclasses(result->value,1,(DEFCLASS *) clsptr,inhp,id,TRUE); ReleaseTraversalID(theEnv); } /************************************************************************** NAME : ClassSubclassAddresses DESCRIPTION : Groups the class addresses of subclasses for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the sublclasses of the class 3) Include (1) or exclude (0) indirect subclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the subclass addresss of the class NOTES : None **************************************************************************/ globle void ClassSubclassAddresses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { register unsigned i; register int id; if ((id = GetTraversalID(theEnv)) == -1) return; i = CountSubclasses((DEFCLASS *) clsptr,inhp,id); ReleaseTraversalID(theEnv); result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); if (i == 0) return; if ((id = GetTraversalID(theEnv)) == -1) return; StoreSubclasses(result->value,1,(DEFCLASS *) clsptr,inhp,id,FALSE); ReleaseTraversalID(theEnv); } /************************************************************************** NAME : Slot... Slot information access functions DESCRIPTION : Groups the sources/facets/types/allowed-values/range or cardinality of a slot for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Name of the slot 3) Data object buffer to hold the attributes of the class RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the attributes for the slot of the class NOTES : None **************************************************************************/ globle void EnvSlotFacets( void *theEnv, void *clsptr, char *sname, DATA_OBJECT *result) { register int i; register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-facets")) == NULL) return; #if DEFRULE_CONSTRUCT result->end = 9; result->value = (void *) EnvCreateMultifield(theEnv,10L); for (i = 1 ; i <= 10 ; i++) SetMFType(result->value,i,SYMBOL); #else result->end = 8; result->value = (void *) EnvCreateMultifield(theEnv,9L); for (i = 1 ; i <= 9 ; i++) SetMFType(result->value,i,SYMBOL); #endif SetMFValue(result->value,1,EnvAddSymbol(theEnv,(char *) (sp->multiple ? "MLT" : "SGL"))); if (sp->noDefault) SetMFValue(result->value,2,EnvAddSymbol(theEnv,"NIL")); else SetMFValue(result->value,2,EnvAddSymbol(theEnv,(char *) (sp->dynamicDefault ? "DYN" : "STC"))); SetMFValue(result->value,3,EnvAddSymbol(theEnv,(char *) (sp->noInherit ? "NIL" : "INH"))); if (sp->initializeOnly) SetMFValue(result->value,4,EnvAddSymbol(theEnv,"INT")); else if (sp->noWrite) SetMFValue(result->value,4,EnvAddSymbol(theEnv,"R")); else SetMFValue(result->value,4,EnvAddSymbol(theEnv,"RW")); SetMFValue(result->value,5,EnvAddSymbol(theEnv,(char *) (sp->shared ? "SHR" : "LCL"))); #if DEFRULE_CONSTRUCT SetMFValue(result->value,6,EnvAddSymbol(theEnv,(char *) (sp->reactive ? "RCT" : "NIL"))); SetMFValue(result->value,7,EnvAddSymbol(theEnv,(char *) (sp->composite ? "CMP" : "EXC"))); SetMFValue(result->value,8,EnvAddSymbol(theEnv,(char *) (sp->publicVisibility ? "PUB" : "PRV"))); SetMFValue(result->value,9,EnvAddSymbol(theEnv,GetCreateAccessorString((void *) sp))); SetMFValue(result->value,10,sp->noWrite ? EnvAddSymbol(theEnv,"NIL") : (void *) sp->overrideMessage); #else SetMFValue(result->value,6,EnvAddSymbol(theEnv,(char *) (sp->composite ? "CMP" : "EXC"))); SetMFValue(result->value,7,EnvAddSymbol(theEnv,(char *) (sp->publicVisibility ? "PUB" : "PRV"))); SetMFValue(result->value,8,EnvAddSymbol(theEnv,GetCreateAccessorString((void *) sp))); SetMFValue(result->value,9,sp->noWrite ? EnvAddSymbol(theEnv,"NIL") : (void *) sp->overrideMessage); #endif } globle void EnvSlotSources( void *theEnv, void *clsptr, char *sname, DATA_OBJECT *result) { register unsigned i; register int classi; register SLOT_DESC *sp,*csp; CLASS_LINK *ctop,*ctmp; DEFCLASS *cls; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-sources")) == NULL) return; i = 1; ctop = get_struct(theEnv,classLink); ctop->cls = sp->cls; ctop->nxt = NULL; if (sp->composite) { for (classi = 1 ; classi < sp->cls->allSuperclasses.classCount ; classi++) { cls = sp->cls->allSuperclasses.classArray[classi]; csp = FindClassSlot(cls,sp->slotName->name); if ((csp != NULL) ? (csp->noInherit == 0) : FALSE) { ctmp = get_struct(theEnv,classLink); ctmp->cls = cls; ctmp->nxt = ctop; ctop = ctmp; i++; if (csp->composite == 0) break; } } } SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); for (ctmp = ctop , i = 1 ; ctmp != NULL ; ctmp = ctmp->nxt , i++) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i,GetDefclassNamePointer((void *) ctmp->cls)); } DeleteClassLinks(theEnv,ctop); } globle void EnvSlotTypes( void *theEnv, void *clsptr, char *sname, DATA_OBJECT *result) { register unsigned i,j; register SLOT_DESC *sp; char typemap[2]; unsigned msize; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-types")) == NULL) return; if ((sp->constraint != NULL) ? sp->constraint->anyAllowed : TRUE) { typemap[0] = typemap[1] = (char) 0xFF; ClearBitMap(typemap,MULTIFIELD); msize = 8; } else { typemap[0] = typemap[1] = (char) 0x00; msize = 0; if (sp->constraint->symbolsAllowed) { msize++; SetBitMap(typemap,SYMBOL); } if (sp->constraint->stringsAllowed) { msize++; SetBitMap(typemap,STRING); } if (sp->constraint->floatsAllowed) { msize++; SetBitMap(typemap,FLOAT); } if (sp->constraint->integersAllowed) { msize++; SetBitMap(typemap,INTEGER); } if (sp->constraint->instanceNamesAllowed) { msize++; SetBitMap(typemap,INSTANCE_NAME); } if (sp->constraint->instanceAddressesAllowed) { msize++; SetBitMap(typemap,INSTANCE_ADDRESS); } if (sp->constraint->externalAddressesAllowed) { msize++; SetBitMap(typemap,EXTERNAL_ADDRESS); } if (sp->constraint->factAddressesAllowed) { msize++; SetBitMap(typemap,FACT_ADDRESS); } } SetpDOEnd(result,msize); result->value = EnvCreateMultifield(theEnv,msize); i = 1; j = 0; while (i <= msize) { if (TestBitMap(typemap,j)) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i, (void *) GetDefclassNamePointer((void *) DefclassData(theEnv)->PrimitiveClassMap[j])); i++; } j++; } } globle void EnvSlotAllowedValues( void *theEnv, void *clsptr, char *sname, DATA_OBJECT *result) { register int i; register SLOT_DESC *sp; register EXPRESSION *theExp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-allowed-values")) == NULL) return; if ((sp->constraint != NULL) ? (sp->constraint->restrictionList == NULL) : TRUE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->end = ExpressionSize(sp->constraint->restrictionList) - 1; result->value = EnvCreateMultifield(theEnv,(unsigned long) (result->end + 1)); i = 1; theExp = sp->constraint->restrictionList; while (theExp != NULL) { SetMFType(result->value,i,theExp->type); SetMFValue(result->value,i,theExp->value); theExp = theExp->nextArg; i++; } } globle void EnvSlotAllowedClasses( void *theEnv, void *clsptr, char *sname, DATA_OBJECT *result) { register int i; register SLOT_DESC *sp; register EXPRESSION *theExp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-allowed-classes")) == NULL) return; if ((sp->constraint != NULL) ? (sp->constraint->classList == NULL) : TRUE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->end = ExpressionSize(sp->constraint->classList) - 1; result->value = EnvCreateMultifield(theEnv,(unsigned long) (result->end + 1)); i = 1; theExp = sp->constraint->classList; while (theExp != NULL) { SetMFType(result->value,i,theExp->type); SetMFValue(result->value,i,theExp->value); theExp = theExp->nextArg; i++; } } globle void EnvSlotRange( void *theEnv, void *clsptr, char *sname, DATA_OBJECT *result) { register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-range")) == NULL) return; if ((sp->constraint == NULL) ? FALSE : (sp->constraint->anyAllowed || sp->constraint->floatsAllowed || sp->constraint->integersAllowed)) { result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,sp->constraint->minValue->type); SetMFValue(result->value,1,sp->constraint->minValue->value); SetMFType(result->value,2,sp->constraint->maxValue->type); SetMFValue(result->value,2,sp->constraint->maxValue->value); } else { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } } globle void EnvSlotCardinality( void *theEnv, void *clsptr, char *sname, DATA_OBJECT *result) { register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-cardinality")) == NULL) return; if (sp->multiple == 0) { EnvSetMultifieldErrorValue(theEnv,result); return; } result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); if (sp->constraint != NULL) { SetMFType(result->value,1,sp->constraint->minFields->type); SetMFValue(result->value,1,sp->constraint->minFields->value); SetMFType(result->value,2,sp->constraint->maxFields->type); SetMFValue(result->value,2,sp->constraint->maxFields->value); } else { SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); } } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /***************************************************** NAME : SlotInfoSupportFunction DESCRIPTION : Support routine for slot-sources, slot-facets, et. al. INPUTS : 1) Data object buffer 2) Name of the H/L caller 3) Pointer to support function to call RETURNS : Nothing useful SIDE EFFECTS : Support function called and data object buffer set NOTES : None *****************************************************/ static void SlotInfoSupportFunction( void *theEnv, DATA_OBJECT *result, char *fnxname, void (*fnx)(void *,void *,char *,DATA_OBJECT *)) { SYMBOL_HN *ssym; DEFCLASS *cls; ssym = CheckClassAndSlot(theEnv,fnxname,&cls); if (ssym == NULL) { EnvSetMultifieldErrorValue(theEnv,result); return; } (*fnx)(theEnv,(void *) cls,ValueToString(ssym),result); } /***************************************************************** NAME : CountSubclasses DESCRIPTION : Counts the number of direct or indirect subclasses for a class INPUTS : 1) Address of class 2) Include (1) or exclude (0) indirect subclasses 3) Traversal id RETURNS : The number of subclasses SIDE EFFECTS : None NOTES : None *****************************************************************/ static unsigned CountSubclasses( DEFCLASS *cls, int inhp, int tvid) { register unsigned i,cnt; register DEFCLASS *subcls; for (cnt = 0 , i = 0 ; i < cls->directSubclasses.classCount ; i++) { subcls = cls->directSubclasses.classArray[i]; if (TestTraversalID(subcls->traversalRecord,tvid) == 0) { cnt++; SetTraversalID(subcls->traversalRecord,tvid); if (inhp && (subcls->directSubclasses.classCount != 0)) cnt += CountSubclasses(subcls,inhp,tvid); } } return(cnt); } /********************************************************************* NAME : StoreSubclasses DESCRIPTION : Stores the names of direct or indirect subclasses for a class in a mutlifield INPUTS : 1) Caller's multifield buffer 2) Starting index 3) Address of the class 4) Include (1) or exclude (0) indirect subclasses 5) Traversal id RETURNS : The number of subclass names stored in the multifield SIDE EFFECTS : Multifield set with subclass names NOTES : Assumes multifield is big enough to hold subclasses *********************************************************************/ static unsigned StoreSubclasses( void *mfval, unsigned si, DEFCLASS *cls, int inhp, int tvid, short storeName) { register unsigned i,classi; register DEFCLASS *subcls; for (i = si , classi = 0 ; classi < cls->directSubclasses.classCount ; classi++) { subcls = cls->directSubclasses.classArray[classi]; if (TestTraversalID(subcls->traversalRecord,tvid) == 0) { SetTraversalID(subcls->traversalRecord,tvid); if (storeName) { SetMFType(mfval,i,SYMBOL); SetMFValue(mfval,i++,(void *) GetDefclassNamePointer((void *) subcls)); } else { SetMFType(mfval,i,DEFCLASS_PTR); SetMFValue(mfval,i++,(void *) subcls); } if (inhp && (subcls->directSubclasses.classCount != 0)) i += StoreSubclasses(mfval,i,subcls,inhp,tvid,storeName); } } return(i - si); } /********************************************************* NAME : SlotInfoSlot DESCRIPTION : Runtime support routine for slot-sources, slot-facets, et. al. which looks up a slot INPUTS : 1) Data object buffer 2) Class pointer 3) Name-string of slot to find 4) The name of the calling function RETURNS : Nothing useful SIDE EFFECTS : Support function called and data object buffer initialized NOTES : None *********************************************************/ static SLOT_DESC *SlotInfoSlot( void *theEnv, DATA_OBJECT *result, DEFCLASS *cls, char *sname, char *fnxname) { SYMBOL_HN *ssym; int i; if ((ssym = FindSymbolHN(theEnv,sname)) == NULL) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,result); return(NULL); } i = FindInstanceTemplateSlot(theEnv,cls,ssym); if (i == -1) { SlotExistError(theEnv,sname,fnxname); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,result); return(NULL); } result->type = MULTIFIELD; result->begin = 0; return(cls->instanceTemplate[i]); } #endif clips-6.24/clipssrc/._parsefun.h0000400000175000017500000000012207422634603014727 0ustar jfsjfsMac OS X  2 RTEXT???? aclips-6.24/clipssrc/._immthpsr.c0000400000175000017500000000075410253660700014746 0ustar jfsjfsMac OS X  2 RTEXT????`aTTFH Monacom8m8%;775HTTFSFMPSRMWBBLclips-6.24/clipssrc/constant.h0000755000175000017500000001613410443656577014562 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/12/06 */ /* */ /* CONSTANTS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_constant #define _H_constant #ifndef FALSE #define FALSE 0 #endif #ifndef TRUE #define TRUE 1 #endif #define EXACTLY 0 #define AT_LEAST 1 #define NO_MORE_THAN 2 #define RANGE 3 #define OFF 0 #define ON 1 #define LHS 0 #define RHS 1 #define NEGATIVE 0 #define POSITIVE 1 #define EOS '\0' #define INSIDE 0 #define OUTSIDE 1 #define LESS_THAN 0 #define GREATER_THAN 1 #define EQUAL 2 #define GLOBAL_SAVE 0 #define LOCAL_SAVE 1 #define VISIBLE_SAVE 2 #ifndef WPROMPT_STRING #define WPROMPT_STRING "wclips" #endif #ifndef APPLICATION_NAME #define APPLICATION_NAME "CLIPS" #endif #ifndef COMMAND_PROMPT #define COMMAND_PROMPT "CLIPS> " #endif #ifndef VERSION_STRING #define VERSION_STRING "6.24" #endif #ifndef CREATION_DATE_STRING #define CREATION_DATE_STRING "06/15/06" #endif #ifndef BANNER_STRING #define BANNER_STRING " CLIPS (V6.24 06/15/06)\n" #endif /*************************/ /* TOKEN AND TYPE VALUES */ /*************************/ #define OBJECT_TYPE_NAME "OBJECT" #define USER_TYPE_NAME "USER" #define PRIMITIVE_TYPE_NAME "PRIMITIVE" #define NUMBER_TYPE_NAME "NUMBER" #define INTEGER_TYPE_NAME "INTEGER" #define FLOAT_TYPE_NAME "FLOAT" #define SYMBOL_TYPE_NAME "SYMBOL" #define STRING_TYPE_NAME "STRING" #define MULTIFIELD_TYPE_NAME "MULTIFIELD" #define LEXEME_TYPE_NAME "LEXEME" #define ADDRESS_TYPE_NAME "ADDRESS" #define EXTERNAL_ADDRESS_TYPE_NAME "EXTERNAL-ADDRESS" #define FACT_ADDRESS_TYPE_NAME "FACT-ADDRESS" #define INSTANCE_TYPE_NAME "INSTANCE" #define INSTANCE_NAME_TYPE_NAME "INSTANCE-NAME" #define INSTANCE_ADDRESS_TYPE_NAME "INSTANCE-ADDRESS" /*************************************************************************/ /* The values of these constants should not be changed. They are set to */ /* start after the primitive type codes in CONSTANT.H. These codes are */ /* used to let the generic function bsave image be used whether COOL is */ /* present or not. */ /*************************************************************************/ #define OBJECT_TYPE_CODE 9 #define PRIMITIVE_TYPE_CODE 10 #define NUMBER_TYPE_CODE 11 #define LEXEME_TYPE_CODE 12 #define ADDRESS_TYPE_CODE 13 #define INSTANCE_TYPE_CODE 14 /****************************************************/ /* The first 9 primitive types need to retain their */ /* values!! Sorted arrays depend on their values!! */ /****************************************************/ #define FLOAT 0 #define INTEGER 1 #define SYMBOL 2 #define STRING 3 #define MULTIFIELD 4 #define EXTERNAL_ADDRESS 5 #define FACT_ADDRESS 6 #define INSTANCE_ADDRESS 7 #define INSTANCE_NAME 8 #define FCALL 30 #define GCALL 31 #define PCALL 32 #define GBL_VARIABLE 33 #define MF_GBL_VARIABLE 34 #define SF_VARIABLE 35 #define MF_VARIABLE 36 #define SF_WILDCARD 37 #define MF_WILDCARD 38 #define BITMAPARRAY 39 #define FACT_PN_CMP1 50 #define FACT_JN_CMP1 51 #define FACT_JN_CMP2 52 #define FACT_SLOT_LENGTH 53 #define FACT_PN_VAR1 54 #define FACT_PN_VAR2 55 #define FACT_PN_VAR3 56 #define FACT_JN_VAR1 57 #define FACT_JN_VAR2 58 #define FACT_JN_VAR3 59 #define FACT_PN_CONSTANT1 60 #define FACT_PN_CONSTANT2 61 #define FACT_STORE_MULTIFIELD 62 #define DEFTEMPLATE_PTR 63 #define OBJ_GET_SLOT_PNVAR1 70 #define OBJ_GET_SLOT_PNVAR2 71 #define OBJ_GET_SLOT_JNVAR1 72 #define OBJ_GET_SLOT_JNVAR2 73 #define OBJ_SLOT_LENGTH 74 #define OBJ_PN_CONSTANT 75 #define OBJ_PN_CMP1 76 #define OBJ_JN_CMP1 77 #define OBJ_PN_CMP2 78 #define OBJ_JN_CMP2 79 #define OBJ_PN_CMP3 80 #define OBJ_JN_CMP3 81 #define DEFCLASS_PTR 82 #define HANDLER_GET 83 #define HANDLER_PUT 84 #define DEFGLOBAL_PTR 90 #define PROC_PARAM 95 #define PROC_WILD_PARAM 96 #define PROC_GET_BIND 97 #define PROC_BIND 98 #define PATTERN_CE 150 #define AND_CE 151 #define OR_CE 152 #define NOT_CE 153 #define TEST_CE 154 #define NAND_CE 155 #define EXISTS_CE 156 #define FORALL_CE 157 #define NOT_CONSTRAINT 160 #define AND_CONSTRAINT 161 #define OR_CONSTRAINT 162 #define PREDICATE_CONSTRAINT 163 #define RETURN_VALUE_CONSTRAINT 164 #define LPAREN 170 #define RPAREN 171 #define STOP 172 #define UNKNOWN_VALUE 173 #define RVOID 175 #define INTEGER_OR_FLOAT 180 #define SYMBOL_OR_STRING 181 #define INSTANCE_OR_INSTANCE_NAME 182 typedef long int FACT_ID; /*************************/ /* Macintosh Definitions */ /*************************/ #define CREATOR_STRING "CLIS" #define CREATOR_CODE 'CLIS' #endif clips-6.24/clipssrc/._genrcpsr.h0000400000175000017500000000075410441143575014740 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0z0z1TTFS FMWBBMPSRclips-6.24/clipssrc/._cstrccmp.h0000400000175000017500000000012207422634570014725 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._edbasic.c0000400000175000017500000000061407675425251014506 0ustar jfsjfsMac OS X  2 R:TEXT????a228r2MWBB clips-6.24/clipssrc/objrtgen.c0000755000175000017500000005714110441150405014512 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INFERENCE ENGINE OBJECT PARSING ROUTINES MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: RETE Network Parsing Interface for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && (! RUN_TIME) && (! BLOAD_ONLY) #ifndef _STDIO_INCLUDED_ #include #define _STDIO_INCLUDED_ #endif #include "classfun.h" #include "envrnmnt.h" #include "objrtfnx.h" #define _OBJRTGEN_SOURCE_ #include "objrtgen.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void GenObjectGetVar(void *,int,EXPRESSION *,struct lhsParseNode *); static intBool IsSimpleSlotVariable(struct lhsParseNode *); static EXPRESSION *GenerateSlotComparisonTest(void *,int,struct lhsParseNode *,struct lhsParseNode *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************** Build functions used by AddPatternParser() to provide object access to the join nertwork **********************************************/ globle void ReplaceGetJNObjectValue( void *theEnv, EXPRESSION *theItem, struct lhsParseNode *theNode) { GenObjectGetVar(theEnv,TRUE,theItem,theNode); } globle EXPRESSION *GenGetJNObjectValue( void *theEnv, struct lhsParseNode *theNode) { EXPRESSION *theItem; theItem = GenConstant(theEnv,0,NULL); GenObjectGetVar(theEnv,TRUE,theItem,theNode); return(theItem); } globle EXPRESSION *ObjectJNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { return(GenerateSlotComparisonTest(theEnv,TRUE,selfNode,referringNode)); } /********************************************** Build functions used by AddPatternParser() to provide object access to the pattern network **********************************************/ globle EXPRESSION *GenObjectPNConstantCompare( void *theEnv, struct lhsParseNode *theNode) { struct ObjectCmpPNConstant hack; EXPRESSION *theExp; unsigned short tmpType; /* =============================================================== If the value of a single field slot (or relation name) is being compared against a constant, then use specialized routines for doing the comparison. If a constant comparison is being done within a multifield slot and the constant's position has no multifields to the left or no multifields to the right, then use the same routine used for the single field slot case, but include the offset from either the beginning or end of the slot. Otherwise, use a general eq/neq test. =============================================================== */ ClearBitString((void *) &hack,(int) sizeof(struct ObjectCmpPNConstant)); if (theNode->negated) hack.fail = 1; else hack.pass = 1; if (((theNode->withinMultifieldSlot == FALSE) || (theNode->multiFieldsAfter == 0) || (theNode->multiFieldsBefore == 0)) && (theNode->slotNumber != ISA_ID) && (theNode->slotNumber != NAME_ID)) { if (theNode->withinMultifieldSlot == FALSE) hack.fromBeginning = TRUE; else if (theNode->multiFieldsBefore == 0) { hack.fromBeginning = TRUE; hack.offset = theNode->singleFieldsBefore; } else hack.offset = theNode->singleFieldsAfter; theExp = GenConstant(theEnv,OBJ_PN_CONSTANT,AddBitMap(theEnv,(void *) &hack, (int) sizeof(struct ObjectCmpPNConstant))); theExp->argList = GenConstant(theEnv,theNode->type,theNode->value); } else { hack.general = 1; theExp = GenConstant(theEnv,OBJ_PN_CONSTANT,AddBitMap(theEnv,(void *) &hack, (int) sizeof(struct ObjectCmpPNConstant))); theExp->argList = GenConstant(theEnv,0,NULL); tmpType = theNode->type; theNode->type = SF_VARIABLE; GenObjectGetVar(theEnv,FALSE,theExp->argList,theNode); theNode->type = tmpType; theExp->argList->nextArg = GenConstant(theEnv,theNode->type,theNode->value); } return(theExp); } globle void ReplaceGetPNObjectValue( void *theEnv, EXPRESSION *theItem, struct lhsParseNode *theNode) { GenObjectGetVar(theEnv,FALSE,theItem,theNode); } globle EXPRESSION *GenGetPNObjectValue( void *theEnv, struct lhsParseNode *theNode) { EXPRESSION *theItem; theItem = GenConstant(theEnv,0,NULL); GenObjectGetVar(theEnv,FALSE,theItem,theNode); return(theItem); } globle EXPRESSION *ObjectPNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { return(GenerateSlotComparisonTest(theEnv,FALSE,selfNode,referringNode)); } /**************************************************** NAME : GenObjectLengthTest DESCRIPTION : Generates a test on the cardinality of a slot matching an object pattern INPUTS : The first lhsParseNode for a slot in an object pattern RETURNS : Nothing useful SIDE EFFECTS : The lhsParseNode network test is modified to include the length test NOTES : None ****************************************************/ globle void GenObjectLengthTest( void *theEnv, struct lhsParseNode *theNode) { struct ObjectMatchLength hack; EXPRESSION *theTest; if ((theNode->singleFieldsAfter == 0) && (theNode->type != SF_VARIABLE) && (theNode->type != SF_WILDCARD)) return; ClearBitString((void *) &hack,(int) sizeof(struct ObjectMatchLength)); if ((theNode->type != MF_VARIABLE) && (theNode->type != MF_WILDCARD) && (theNode->multiFieldsAfter == 0)) hack.exactly = 1; else hack.exactly = 0; if ((theNode->type == SF_VARIABLE) || (theNode->type == SF_WILDCARD)) hack.minLength = 1 + theNode->singleFieldsAfter; else hack.minLength = theNode->singleFieldsAfter; theTest = GenConstant(theEnv,OBJ_SLOT_LENGTH,AddBitMap(theEnv,(void *) &hack, (int) sizeof(struct ObjectMatchLength))); theNode->networkTest = CombineExpressions(theEnv,theTest,theNode->networkTest); } /**************************************************** NAME : GenObjectZeroLengthTest DESCRIPTION : Generates a test on the cardinality of a slot matching an object pattern INPUTS : The first lhsParseNode for a slot in an object pattern RETURNS : Nothing useful SIDE EFFECTS : The lhsParseNode network test is modified to include the length test NOTES : None ****************************************************/ globle void GenObjectZeroLengthTest( void *theEnv, struct lhsParseNode *theNode) { struct ObjectMatchLength hack; EXPRESSION *theTest; ClearBitString((void *) &hack,(int) sizeof(struct ObjectMatchLength)); hack.exactly = 1; hack.minLength = 0; theTest = GenConstant(theEnv,OBJ_SLOT_LENGTH,AddBitMap(theEnv,(void *) &hack, (int) sizeof(struct ObjectMatchLength))); theNode->networkTest = CombineExpressions(theEnv,theTest,theNode->networkTest); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : GenObjectGetVar DESCRIPTION : Generates the expressions necessary to access object pattern variables INPUTS : 1) An integer code indicating if this is a join network reference or a pattern network reference 2) The expression for which to set the type and value 3) The lhsParseNode for the variable reference RETURNS : Nothing useful SIDE EFFECTS : The value is a packed long holding pattern index, slot number, field index, etc. NOTES : None ***************************************************/ static void GenObjectGetVar( void *theEnv, int joinReference, EXPRESSION *theItem, struct lhsParseNode *theNode) { struct ObjectMatchVar1 hack1; struct ObjectMatchVar2 hack2; ClearBitString((void *) &hack1,(int) sizeof(struct ObjectMatchVar1)); ClearBitString((void *) &hack2,(int) sizeof(struct ObjectMatchVar2)); if (joinReference) { hack1.whichPattern = (unsigned short) theNode->pattern; hack2.whichPattern = (unsigned short) theNode->pattern; } /* ======================== Access an object address ======================== */ if (theNode->slotNumber < 0) { hack1.objectAddress = 1; SetpType(theItem,(joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1)); theItem->value = AddBitMap(theEnv,(void *) &hack1,(int) sizeof(struct ObjectMatchVar1)); return; } /* ====================================== Access the entire contents of the slot ====================================== */ if ((theNode->singleFieldsBefore == 0) && (theNode->singleFieldsAfter == 0) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0) && ((theNode->withinMultifieldSlot == FALSE) || (theNode->type == MF_VARIABLE) || (theNode->type == MF_WILDCARD))) { hack1.allFields = 1; hack1.whichSlot = (unsigned short) theNode->slotNumber; theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1); theItem->value = AddBitMap(theEnv,(void *) &hack1,(int) sizeof(struct ObjectMatchVar1)); return; } /* ============================================================= Access a particular field(s) in a multifield slot pattern containing at most one multifield variable and at least one (or two if no multifield variables) single-field variable ============================================================= */ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) && ((theNode->multiFieldsBefore == 0) || (theNode->multiFieldsAfter == 0))) { hack2.whichSlot = (unsigned short) theNode->slotNumber; if (theNode->multiFieldsBefore == 0) { hack2.fromBeginning = 1; hack2.beginningOffset = theNode->singleFieldsBefore; } else { hack2.fromEnd = 1; hack2.endOffset = theNode->singleFieldsAfter; } theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR2 : OBJ_GET_SLOT_PNVAR2); theItem->value = AddBitMap(theEnv,(void *) &hack2,sizeof(struct ObjectMatchVar2)); return; } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { hack2.whichSlot = (unsigned short) theNode->slotNumber; hack2.fromBeginning = 1; hack2.fromEnd = 1; hack2.beginningOffset = theNode->singleFieldsBefore; hack2.endOffset = theNode->singleFieldsAfter; theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR2 : OBJ_GET_SLOT_PNVAR2); theItem->value = AddBitMap(theEnv,(void *) &hack2,sizeof(struct ObjectMatchVar2)); return; } /* ================================================== General slot field access using multifield markers ================================================== */ hack1.whichSlot = (unsigned short) theNode->slotNumber; hack1.whichField = (unsigned short) theNode->index; theItem->type = (unsigned short) (joinReference ? OBJ_GET_SLOT_JNVAR1 : OBJ_GET_SLOT_PNVAR1); theItem->value = AddBitMap(theEnv,(void *) &hack1,sizeof(struct ObjectMatchVar1)); } /**************************************************************** NAME : IsSimpleSlotVariable DESCRIPTION : Determines if a slot pattern variable references a single-field slot or a single-field in a multifield slot which does not require use of multifield markers (Object addresses are not simple variables) INPUTS : The intermediate parse node RETURNS : TRUE if the variable is simple, FALSE otherwise SIDE EFFECTS : None NOTES : None ****************************************************************/ static intBool IsSimpleSlotVariable( struct lhsParseNode *node) { if ((node->type == MF_WILDCARD) || (node->type == MF_VARIABLE)) return(FALSE); if ((node->slotNumber < 0) || (node->slotNumber == ISA_ID) || (node->slotNumber == NAME_ID)) return(FALSE); if (node->withinMultifieldSlot == FALSE) return(TRUE); if (node->multifieldSlot == TRUE) return(FALSE); if ((node->multiFieldsBefore == 0) || (node->multiFieldsAfter == 0)) return(TRUE); return(FALSE); } /*************************************************************** NAME : GenerateSlotComparisonTest DESCRIPTION : Generates pattern and join network expressions for comparing object pattern variables INPUTS : 1) A flag indicating if this is a pattern or join network test 2) The intermediate parse node for the first variable 3) The intermediate parse node for the second variable RETURNS : An expression for comparing the variables SIDE EFFECTS : Expression and bitmaps generated NOTES : The following tests are generated for the following scenarios: SF slot w/ SF slot: PN_1 or JN_1 Example: (foo ?x) with (bar ?xy) SF slot w/ SF reference in MF slot: PN_2 or JN_2 Example: (foo ?x) (bar ? ?x ? ?) SF reference w/ SF reference: PN_3 or JN_3 Example: (foo ? ?x ?) and (bar ? ? ? ?x) All other cases: EQ/NEQ general test Example: (foo $? ?x $?) and (bar ?x) ***************************************************************/ static EXPRESSION *GenerateSlotComparisonTest( void *theEnv, int joinTest, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { EXPRESSION *theExp; struct ObjectCmpPNSingleSlotVars1 phack1; struct ObjectCmpPNSingleSlotVars2 phack2; struct ObjectCmpPNSingleSlotVars3 phack3; struct ObjectCmpJoinSingleSlotVars1 jhack1; struct ObjectCmpJoinSingleSlotVars2 jhack2; struct ObjectCmpJoinSingleSlotVars3 jhack3; /* ========================================================= If we are comparing two single-field slot variables that don't require multifield markers for lookup, use a quick comparison. Otherwise, use a general eq/neq with the pattern variable access routines ========================================================= */ if (IsSimpleSlotVariable(selfNode) && IsSimpleSlotVariable(referringNode)) { /* ============================== Compare two single-field slots ============================== */ if ((selfNode->withinMultifieldSlot == FALSE) && (referringNode->withinMultifieldSlot == FALSE)) { ClearBitString((void *) &phack1,(int) sizeof(struct ObjectCmpPNSingleSlotVars1)); ClearBitString((void *) &jhack1,(int) sizeof(struct ObjectCmpJoinSingleSlotVars1)); if (selfNode->negated) phack1.fail = jhack1.fail = 1; else phack1.pass = jhack1.pass = 1; phack1.firstSlot = jhack1.firstSlot = (unsigned short) selfNode->slotNumber; phack1.secondSlot = jhack1.secondSlot = (unsigned short) referringNode->slotNumber; if (joinTest) { jhack1.firstPattern = (unsigned short) selfNode->pattern; jhack1.secondPattern = (unsigned short) referringNode->pattern; theExp = GenConstant(theEnv,OBJ_JN_CMP1,AddBitMap(theEnv,(void *) &jhack1, (int) sizeof(struct ObjectCmpJoinSingleSlotVars1))); } else theExp = GenConstant(theEnv,OBJ_PN_CMP1,AddBitMap(theEnv,(void *) &phack1, (int) sizeof(struct ObjectCmpPNSingleSlotVars1))); } /* ============================================ Compare a single-field slot with a single-field in a multifield slot (make sure the multifield slot reference is first ============================================ */ else if ((selfNode->withinMultifieldSlot == FALSE) || (referringNode->withinMultifieldSlot == FALSE)) { ClearBitString((void *) &phack2,(int) sizeof(struct ObjectCmpPNSingleSlotVars2)); ClearBitString((void *) &jhack2,(int) sizeof(struct ObjectCmpJoinSingleSlotVars2)); if (selfNode->negated) phack2.fail = jhack2.fail = 1; else phack2.pass = jhack2.pass = 1; if (selfNode->withinMultifieldSlot == TRUE) { phack2.firstSlot = jhack2.firstSlot = (unsigned short) selfNode->slotNumber; phack2.secondSlot = jhack2.secondSlot = (unsigned short) referringNode->slotNumber; if (joinTest) { jhack2.firstPattern = (unsigned short) selfNode->pattern; jhack2.secondPattern = (unsigned short) referringNode->pattern; } if (selfNode->multiFieldsBefore == 0) { phack2.fromBeginning = jhack2.fromBeginning = 1; phack2.offset = jhack2.offset = selfNode->singleFieldsBefore; } else phack2.offset = jhack2.offset = selfNode->singleFieldsAfter; } else { phack2.firstSlot = jhack2.firstSlot = (unsigned short) referringNode->slotNumber; phack2.secondSlot = jhack2.secondSlot = (unsigned short) selfNode->slotNumber; if (joinTest) { jhack2.firstPattern = (unsigned short) referringNode->pattern; jhack2.secondPattern = (unsigned short) selfNode->pattern; } if (referringNode->multiFieldsBefore == 0) { phack2.fromBeginning = jhack2.fromBeginning = 1; phack2.offset = jhack2.offset = referringNode->singleFieldsBefore; } else phack2.offset = jhack2.offset = referringNode->singleFieldsAfter; } if (joinTest) theExp = GenConstant(theEnv,OBJ_JN_CMP2,AddBitMap(theEnv,(void *) &jhack2, (int) sizeof(struct ObjectCmpJoinSingleSlotVars2))); else theExp = GenConstant(theEnv,OBJ_PN_CMP2,AddBitMap(theEnv,(void *) &phack2, (int) sizeof(struct ObjectCmpPNSingleSlotVars2))); } /* =================================== Compare two single-field references within multifield slots =================================== */ else { ClearBitString((void *) &phack3,(int) sizeof(struct ObjectCmpPNSingleSlotVars3)); ClearBitString((void *) &jhack3,(int) sizeof(struct ObjectCmpJoinSingleSlotVars3)); if (selfNode->negated) phack3.fail = jhack3.fail = 1; else phack3.pass = jhack3.pass = 1; phack3.firstSlot = jhack3.firstSlot = (unsigned short) selfNode->slotNumber; phack3.secondSlot = jhack3.secondSlot = (unsigned short) referringNode->slotNumber; if (selfNode->multiFieldsBefore == 0) { phack3.firstFromBeginning = jhack3.firstFromBeginning = 1; phack3.firstOffset = jhack3.firstOffset = selfNode->singleFieldsBefore; } else phack3.firstOffset = jhack3.firstOffset = selfNode->singleFieldsAfter; if (referringNode->multiFieldsBefore == 0) { phack3.secondFromBeginning = jhack3.secondFromBeginning = 1; phack3.secondOffset = jhack3.secondOffset = referringNode->singleFieldsBefore; } else phack3.secondOffset = jhack3.secondOffset = referringNode->singleFieldsAfter; if (joinTest) { jhack3.firstPattern = (unsigned short) selfNode->pattern; jhack3.secondPattern = (unsigned short) referringNode->pattern; theExp = GenConstant(theEnv,OBJ_JN_CMP3,AddBitMap(theEnv,(void *) &jhack3, (int) sizeof(struct ObjectCmpJoinSingleSlotVars3))); } else theExp = GenConstant(theEnv,OBJ_PN_CMP3,AddBitMap(theEnv,(void *) &phack3, (int) sizeof(struct ObjectCmpPNSingleSlotVars3))); } } /* ================================================== General comparison for multifield slot references, references which require multifield markers, and object addresses ================================================== */ else { theExp = GenConstant(theEnv,FCALL,selfNode->negated ? ExpressionData(theEnv)->PTR_NEQ : ExpressionData(theEnv)->PTR_EQ); theExp->argList = GenConstant(theEnv,0,NULL); GenObjectGetVar(theEnv,joinTest,theExp->argList,selfNode); theExp->argList->nextArg = GenConstant(theEnv,0,NULL); GenObjectGetVar(theEnv,joinTest,theExp->argList->nextArg,referringNode); } return(theExp); } #endif /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips-6.24/clipssrc/modulutl.c0000755000175000017500000005602607422634564014570 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFMODULE UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for parsing module/construct */ /* names and searching through modules for specific */ /* constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _MODULUTL_SOURCE_ #include "setup.h" #include "memalloc.h" #include "router.h" #include "envrnmnt.h" #include "modulpsr.h" #include "modulutl.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *SearchImportedConstructModules(void *,struct symbolHashNode *, struct defmodule *, struct moduleItem *,struct symbolHashNode *, int *,int,struct defmodule *); /********************************************************************/ /* FindModuleSeparator: Finds the :: separator which delineates the */ /* boundary between a module name and a construct name. The value */ /* zero is returned if the separator is not found, otherwise the */ /* position of the second colon within the string is returned. */ /********************************************************************/ globle unsigned FindModuleSeparator( char *theString) { unsigned i, foundColon; for (i = 0, foundColon = FALSE; theString[i] != EOS; i++) { if (theString[i] == ':') { if (foundColon) return(i); foundColon = TRUE; } else { foundColon = FALSE; } } return(FALSE); } /*******************************************************************/ /* ExtractModuleName: Given the position of the :: separator and a */ /* module/construct name joined using the separator, returns a */ /* symbol reference to the module name (or NULL if a module name */ /* cannot be extracted). */ /*******************************************************************/ globle SYMBOL_HN *ExtractModuleName( void *theEnv, unsigned thePosition, char *theString) { char *newString; SYMBOL_HN *returnValue; /*=============================================*/ /* Return NULL if the :: is in a position such */ /* that a module name can't be extracted. */ /*=============================================*/ if (thePosition <= 1) return(NULL); /*==========================================*/ /* Allocate storage for a temporary string. */ /*==========================================*/ newString = (char *) gm2(theEnv,thePosition); /*======================================================*/ /* Copy the entire module/construct name to the string. */ /*======================================================*/ strncpy(newString,theString, (STD_SIZE) thePosition - 1); /*========================================================*/ /* Place an end of string marker where the :: is located. */ /*========================================================*/ newString[thePosition-1] = EOS; /*=====================================================*/ /* Add the module name (the truncated module/construct */ /* name) to the symbol table. */ /*=====================================================*/ returnValue = (SYMBOL_HN *) EnvAddSymbol(theEnv,newString); /*=============================================*/ /* Return the storage of the temporary string. */ /*=============================================*/ rm(theEnv,newString,thePosition); /*=============================================*/ /* Return a pointer to the module name symbol. */ /*=============================================*/ return(returnValue); } /********************************************************************/ /* ExtractConstructName: Given the position of the :: separator and */ /* a module/construct name joined using the separator, returns a */ /* symbol reference to the construct name (or NULL if a construct */ /* name cannot be extracted). */ /********************************************************************/ globle SYMBOL_HN *ExtractConstructName( void *theEnv, unsigned thePosition, char *theString) { size_t theLength; char *newString; SYMBOL_HN *returnValue; /*======================================*/ /* Just return the string if it doesn't */ /* contain the :: symbol. */ /*======================================*/ if (thePosition == 0) return((SYMBOL_HN *) EnvAddSymbol(theEnv,theString)); /*=====================================*/ /* Determine the length of the string. */ /*=====================================*/ theLength = strlen(theString); /*=================================================*/ /* Return NULL if the :: is at the very end of the */ /* string (and thus there is no construct name). */ /*=================================================*/ if (theLength <= (thePosition + 1)) return(NULL); /*====================================*/ /* Allocate a temporary string large */ /* enough to hold the construct name. */ /*====================================*/ newString = (char *) gm2(theEnv,theLength - thePosition); /*================================================*/ /* Copy the construct name portion of the */ /* module/construct name to the temporary string. */ /*================================================*/ strncpy(newString,&theString[thePosition+1], (STD_SIZE) theLength - thePosition); /*=============================================*/ /* Add the construct name to the symbol table. */ /*=============================================*/ returnValue = (SYMBOL_HN *) EnvAddSymbol(theEnv,newString); /*=============================================*/ /* Return the storage of the temporary string. */ /*=============================================*/ rm(theEnv,newString,theLength - thePosition); /*================================================*/ /* Return a pointer to the construct name symbol. */ /*================================================*/ return(returnValue); } /****************************************************/ /* ExtractModuleAndConstructName: Extracts both the */ /* module and construct name from a string. Sets */ /* the current module to the specified module. */ /****************************************************/ globle char *ExtractModuleAndConstructName( void *theEnv, char *theName) { unsigned separatorPosition; SYMBOL_HN *moduleName, *shortName; struct defmodule *theModule; /*========================*/ /* Find the :: separator. */ /*========================*/ separatorPosition = FindModuleSeparator(theName); if (! separatorPosition) return(theName); /*==========================*/ /* Extract the module name. */ /*==========================*/ moduleName = ExtractModuleName(theEnv,separatorPosition,theName); if (moduleName == NULL) return(NULL); /*====================================*/ /* Check to see if the module exists. */ /*====================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName)); if (theModule == NULL) return(NULL); /*============================*/ /* Change the current module. */ /*============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*=============================*/ /* Extract the construct name. */ /*=============================*/ shortName = ExtractConstructName(theEnv,separatorPosition,theName); return(ValueToString(shortName)); } /************************************************************/ /* FindImportedConstruct: High level routine which searches */ /* a module and other modules from which it imports */ /* constructs for a specified construct. */ /************************************************************/ globle void *FindImportedConstruct( void *theEnv, char *constructName, struct defmodule *matchModule, char *findName, int *count, int searchCurrent, struct defmodule *notYetDefinedInModule) { void *rv; struct moduleItem *theModuleItem; /*=============================================*/ /* Set the number of references found to zero. */ /*=============================================*/ *count = 0; /*===============================*/ /* The :: should not be included */ /* in the construct's name. */ /*===============================*/ if (FindModuleSeparator(findName)) return(NULL); /*=============================================*/ /* Remember the current module since we'll be */ /* changing it during the search and will want */ /* to restore it once the search is completed. */ /*=============================================*/ SaveCurrentModule(theEnv); /*==========================================*/ /* Find the module related access functions */ /* for the construct type being sought. */ /*==========================================*/ if ((theModuleItem = FindModuleItem(theEnv,constructName)) == NULL) { RestoreCurrentModule(theEnv); return(NULL); } /*===========================================*/ /* If the construct type doesn't have a find */ /* function, then we can't look for it. */ /*===========================================*/ if (theModuleItem->findFunction == NULL) { RestoreCurrentModule(theEnv); return(NULL); } /*==================================*/ /* Initialize the search by marking */ /* all modules as unvisited. */ /*==================================*/ MarkModulesAsUnvisited(theEnv); /*===========================*/ /* Search for the construct. */ /*===========================*/ rv = SearchImportedConstructModules(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,constructName), matchModule,theModuleItem, (SYMBOL_HN *) EnvAddSymbol(theEnv,findName),count, searchCurrent,notYetDefinedInModule); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*====================================*/ /* Return a pointer to the construct. */ /*====================================*/ return(rv); } /*********************************************************/ /* AmbiguousReferenceErrorMessage: Error message printed */ /* when a reference to a specific construct can be */ /* imported from more than one module. */ /*********************************************************/ globle void AmbiguousReferenceErrorMessage( void *theEnv, char *constructName, char *findName) { EnvPrintRouter(theEnv,WERROR,"Ambiguous reference to "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,findName); EnvPrintRouter(theEnv,WERROR,".\nIt is imported from more than one module.\n"); } /****************************************************/ /* MarkModulesAsUnvisited: Used for initializing a */ /* search through the module heirarchies. Sets */ /* the visited flag of each module to FALSE. */ /****************************************************/ globle void MarkModulesAsUnvisited( void *theEnv) { struct defmodule *theModule; DefmoduleData(theEnv)->CurrentModule->visitedFlag = FALSE; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { theModule->visitedFlag = FALSE; } } /***********************************************************/ /* SearchImportedConstructModules: Low level routine which */ /* searches a module and other modules from which it */ /* imports constructs for a specified construct. */ /***********************************************************/ static void *SearchImportedConstructModules( void *theEnv, struct symbolHashNode *constructType, struct defmodule *matchModule, struct moduleItem *theModuleItem, struct symbolHashNode *findName, int *count, int searchCurrent, struct defmodule *notYetDefinedInModule) { struct defmodule *theModule; struct portItem *theImportList, *theExportList; void *rv, *arv = NULL; int searchModule, exported; struct defmodule *currentModule; /*=========================================*/ /* Start the search in the current module. */ /* If the current module has already been */ /* visited, then return. */ /*=========================================*/ currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (currentModule->visitedFlag) return(NULL); /*=======================================================*/ /* The searchCurrent flag indicates whether the current */ /* module should be included in the search. In addition, */ /* if matchModule is non-NULL, the current module will */ /* only be searched if it is the specific module from */ /* which we want the construct imported. */ /*=======================================================*/ if ((searchCurrent) && ((matchModule == NULL) || (currentModule == matchModule))) { /*===============================================*/ /* Look for the construct in the current module. */ /*===============================================*/ rv = (*theModuleItem->findFunction)(theEnv,ValueToString(findName)); /*========================================================*/ /* If we're in the process of defining the construct in */ /* the module we're searching then go ahead and increment */ /* the count indicating the number of modules in which */ /* the construct was found. */ /*========================================================*/ if (notYetDefinedInModule == currentModule) { (*count)++; arv = rv; } /*=========================================================*/ /* Otherwise, if the construct is in the specified module, */ /* increment the count only if the construct actually */ /* belongs to the module. [Some constructs, like the COOL */ /* system classes, can be found in any module, but they */ /* actually belong to the MAIN module.] */ /*=========================================================*/ else if (rv != NULL) { if (((struct constructHeader *) rv)->whichModule->theModule == currentModule) { (*count)++; } arv = rv; } } /*=====================================*/ /* Mark the current module as visited. */ /*=====================================*/ currentModule->visitedFlag = TRUE; /*===================================*/ /* Search through all of the modules */ /* imported by the current module. */ /*===================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); theImportList = theModule->importList; while (theImportList != NULL) { /*===================================================*/ /* Determine if the module should be searched (based */ /* upon whether the entire module, all constructs of */ /* a specific type, or specifically named constructs */ /* are imported). */ /*===================================================*/ searchModule = FALSE; if ((theImportList->constructType == NULL) || (theImportList->constructType == constructType)) { if ((theImportList->constructName == NULL) || (theImportList->constructName == findName)) { searchModule = TRUE; } } /*=================================*/ /* Determine if the module exists. */ /*=================================*/ if (searchModule) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theImportList->moduleName)); if (theModule == NULL) searchModule = FALSE; } /*=======================================================*/ /* Determine if the construct is exported by the module. */ /*=======================================================*/ if (searchModule) { exported = FALSE; theExportList = theModule->exportList; while ((theExportList != NULL) && (! exported)) { if ((theExportList->constructType == NULL) || (theExportList->constructType == constructType)) { if ((theExportList->constructName == NULL) || (theExportList->constructName == findName)) { exported = TRUE; } } theExportList = theExportList->next; } if (! exported) searchModule = FALSE; } /*=================================*/ /* Search in the specified module. */ /*=================================*/ if (searchModule) { EnvSetCurrentModule(theEnv,(void *) theModule); if ((rv = SearchImportedConstructModules(theEnv,constructType,matchModule, theModuleItem,findName, count,TRUE, notYetDefinedInModule)) != NULL) { arv = rv; } } /*====================================*/ /* Move on to the next imported item. */ /*====================================*/ theImportList = theImportList->next; } /*=========================*/ /* Return a pointer to the */ /* last construct found. */ /*=========================*/ return(arv); } /***************************************/ /* ListItemsDriver: Driver routine for */ /* listing items in a module. */ /***************************************/ globle void ListItemsDriver( void *theEnv, char *logicalName, struct defmodule *theModule, char *singleName, char *pluralName, void *(*nextFunction)(void *,void *), char *(*nameFunction)(void *), void (*printFunction)(void *,char *,void *), int (*doItFunction)(void *,void *)) { void *constructPtr; char *constructName; long count = 0; int allModules = FALSE; int doIt; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*======================*/ /* Print out the items. */ /*======================*/ if (theModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); allModules = TRUE; } while (theModule != NULL) { if (allModules) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule)); EnvPrintRouter(theEnv,logicalName,":\n"); } EnvSetCurrentModule(theEnv,(void *) theModule); constructPtr = (*nextFunction)(theEnv,NULL); while (constructPtr != NULL) { if (EvaluationData(theEnv)->HaltExecution == TRUE) return; if (doItFunction == NULL) doIt = TRUE; else doIt = (*doItFunction)(theEnv,constructPtr); if (! doIt) {} else if (nameFunction != NULL) { constructName = (*nameFunction)(constructPtr); if (constructName != NULL) { if (allModules) EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,constructName); EnvPrintRouter(theEnv,logicalName,"\n"); } } else if (printFunction != NULL) { if (allModules) EnvPrintRouter(theEnv,logicalName," "); (*printFunction)(theEnv,logicalName,constructPtr); EnvPrintRouter(theEnv,logicalName,"\n"); } constructPtr = (*nextFunction)(theEnv,constructPtr); count++; } if (allModules) theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); else theModule = NULL; } /*=================================================*/ /* Print the tally and restore the current module. */ /*=================================================*/ if (singleName != NULL) PrintTally(theEnv,logicalName,count,singleName,pluralName); RestoreCurrentModule(theEnv); } /********************************************************/ /* DoForAllModules: Executes an action for all modules. */ /********************************************************/ globle long DoForAllModules( void *theEnv, void (*actionFunction)(struct defmodule *,void *), int interruptable, void *userBuffer) { void *theModule; long moduleCount = 0L; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*==================================*/ /* Loop through all of the modules. */ /*==================================*/ for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule), moduleCount++) { EnvSetCurrentModule(theEnv,(void *) theModule); if ((interruptable) && GetHaltExecution(theEnv)) { RestoreCurrentModule(theEnv); return(-1L); } (*actionFunction)((struct defmodule *) theModule,userBuffer); } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); /*=========================================*/ /* Return the number of modules traversed. */ /*=========================================*/ return(moduleCount); } clips-6.24/clipssrc/multifld.c0000755000175000017500000006502310441602250014516 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* MULTIFIELD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /* Moved ImplodeMultifield from multifun.c. */ /* */ /*************************************************************/ #define _MULTIFLD_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #include "constant.h" #include "memalloc.h" #include "envrnmnt.h" #include "evaluatn.h" #include "scanner.h" #include "router.h" #include "strngrtr.h" #include "utility.h" #if OBJECT_SYSTEM #include "object.h" #endif #include "multifld.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DeallocateMultifieldData(void *); /***************************************************/ /* InitializeMultifieldData: Allocates environment */ /* data for multifield values. */ /***************************************************/ globle void InitializeMultifieldData( void *theEnv) { AllocateEnvironmentData(theEnv,MULTIFIELD_DATA,sizeof(struct multifieldData),DeallocateMultifieldData); } /*****************************************************/ /* DeallocateMultifieldData: Deallocates environment */ /* data for multifield values. */ /*****************************************************/ static void DeallocateMultifieldData( void *theEnv) { struct multifield *tmpPtr, *nextPtr; tmpPtr = MultifieldData(theEnv)->ListOfMultifields; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; ReturnMultifield(theEnv,tmpPtr); tmpPtr = nextPtr; } } /***********************************************************/ /* CreateMultifield2: */ /***********************************************************/ globle void *CreateMultifield2( void *theEnv, unsigned long size) { struct multifield *theSegment; unsigned long newSize = size; if (size <= 0) newSize = 1; theSegment = get_var_struct2(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L)); theSegment->multifieldLength = size; theSegment->depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth; theSegment->busyCount = 0; theSegment->next = NULL; return((void *) theSegment); } /*****************************************************************/ /* ReturnMultifield: */ /*****************************************************************/ globle void ReturnMultifield( void *theEnv, struct multifield *theSegment) { unsigned long newSize; if (theSegment == NULL) return; if (theSegment->multifieldLength == 0) newSize = 1; else newSize = theSegment->multifieldLength; rtn_var_struct2(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment); } /******************************/ /* MultifieldInstall: */ /******************************/ globle void MultifieldInstall( void *theEnv, struct multifield *theSegment) { unsigned long length, i; struct field *theFields; if (theSegment == NULL) return; length = theSegment->multifieldLength; theSegment->busyCount++; theFields = theSegment->theFields; for (i = 0 ; i < length ; i++) { AtomInstall(theEnv,theFields[i].type,theFields[i].value); } } /******************************/ /* MultifieldDeinstall: */ /******************************/ globle void MultifieldDeinstall( void *theEnv, struct multifield *theSegment) { unsigned long length, i; struct field *theFields; if (theSegment == NULL) return; length = theSegment->multifieldLength; theSegment->busyCount--; theFields = theSegment->theFields; for (i = 0 ; i < length ; i++) { AtomDeinstall(theEnv,theFields[i].type,theFields[i].value); } } /*******************************************************/ /* StringToMultifield: Returns a multifield structure */ /* that represents the string sent as the argument. */ /*******************************************************/ globle struct multifield *StringToMultifield( void *theEnv, char *theString) { struct token theToken; struct multifield *theSegment; struct field *theFields; unsigned long numberOfFields = 0; struct expr *topAtom = NULL, *lastAtom = NULL, *theAtom; /*====================================================*/ /* Open the string as an input source and read in the */ /* list of values to be stored in the multifield. */ /*====================================================*/ OpenStringSource(theEnv,"multifield-str",theString,0); GetToken(theEnv,"multifield-str",&theToken); while (theToken.type != STOP) { if ((theToken.type == SYMBOL) || (theToken.type == STRING) || (theToken.type == FLOAT) || (theToken.type == INTEGER) || (theToken.type == INSTANCE_NAME)) { theAtom = GenConstant(theEnv,theToken.type,theToken.value); } else { theAtom = GenConstant(theEnv,STRING,EnvAddSymbol(theEnv,theToken.printForm)); } numberOfFields++; if (topAtom == NULL) topAtom = theAtom; else lastAtom->nextArg = theAtom; lastAtom = theAtom; GetToken(theEnv,"multifield-str",&theToken); } CloseStringSource(theEnv,"multifield-str"); /*====================================================================*/ /* Create a multifield of the appropriate size for the values parsed. */ /*====================================================================*/ theSegment = (struct multifield *) EnvCreateMultifield(theEnv,numberOfFields); theFields = theSegment->theFields; /*====================================*/ /* Copy the values to the multifield. */ /*====================================*/ theAtom = topAtom; numberOfFields = 0; while (theAtom != NULL) { theFields[numberOfFields].type = theAtom->type; theFields[numberOfFields].value = theAtom->value; numberOfFields++; theAtom = theAtom->nextArg; } /*===========================*/ /* Return the parsed values. */ /*===========================*/ ReturnExpression(theEnv,topAtom); /*============================*/ /* Return the new multifield. */ /*============================*/ return(theSegment); } /**************************************************************/ /* EnvCreateMultifield: Creates a multifield of the specified */ /* size and adds it to the list of segments. */ /**************************************************************/ globle void *EnvCreateMultifield( void *theEnv, unsigned long size) { struct multifield *theSegment; unsigned long newSize; if (size <= 0) newSize = 1; else newSize = size; theSegment = get_var_struct2(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L)); theSegment->multifieldLength = size; theSegment->depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth; theSegment->busyCount = 0; theSegment->next = NULL; theSegment->next = MultifieldData(theEnv)->ListOfMultifields; MultifieldData(theEnv)->ListOfMultifields = theSegment; UtilityData(theEnv)->EphemeralItemCount++; UtilityData(theEnv)->EphemeralItemSize += sizeof(struct multifield) + (sizeof(struct field) * newSize); return((void *) theSegment); } /*********************************************************************/ /* DOToMultifield: */ /*********************************************************************/ globle void *DOToMultifield( void *theEnv, DATA_OBJECT *theValue) { struct multifield *dst, *src; if (theValue->type != MULTIFIELD) return(NULL); dst = (struct multifield *) CreateMultifield2(theEnv,(unsigned long) GetpDOLength(theValue)); src = (struct multifield *) theValue->value; GenCopyMemory(struct field,dst->multifieldLength, &(dst->theFields[0]),&(src->theFields[GetpDOBegin(theValue) - 1])); return((void *) dst); } /***********************************************************/ /* AddToMultifieldList: */ /***********************************************************/ globle void AddToMultifieldList( void *theEnv, struct multifield *theSegment) { theSegment->depth = (short) EvaluationData(theEnv)->CurrentEvaluationDepth; theSegment->next = MultifieldData(theEnv)->ListOfMultifields; MultifieldData(theEnv)->ListOfMultifields = theSegment; UtilityData(theEnv)->EphemeralItemCount++; UtilityData(theEnv)->EphemeralItemSize += sizeof(struct multifield) + (sizeof(struct field) * theSegment->multifieldLength); } /***********************************************************/ /* FlushMultifields: */ /***********************************************************/ globle void FlushMultifields( void *theEnv) { struct multifield *theSegment, *nextPtr, *lastPtr = NULL; unsigned long newSize; theSegment = MultifieldData(theEnv)->ListOfMultifields; while (theSegment != NULL) { nextPtr = theSegment->next; if ((theSegment->depth > EvaluationData(theEnv)->CurrentEvaluationDepth) && (theSegment->busyCount == 0)) { UtilityData(theEnv)->EphemeralItemCount--; UtilityData(theEnv)->EphemeralItemSize -= sizeof(struct multifield) + (sizeof(struct field) * theSegment->multifieldLength); if (theSegment->multifieldLength == 0) newSize = 1; else newSize = theSegment->multifieldLength; rtn_var_struct2(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment); if (lastPtr == NULL) MultifieldData(theEnv)->ListOfMultifields = nextPtr; else lastPtr->next = nextPtr; } else { lastPtr = theSegment; } theSegment = nextPtr; } } /*********************************************************************/ /* DuplicateMultifield: Allocates a new segment and copies results from */ /* old value to new - NOT put on ListOfMultifields!! */ /*********************************************************************/ globle void DuplicateMultifield( void *theEnv, DATA_OBJECT_PTR dst, DATA_OBJECT_PTR src) { dst->type = MULTIFIELD; dst->begin = 0; dst->end = src->end - src->begin; dst->value = (void *) CreateMultifield2(theEnv,(unsigned long) dst->end + 1); GenCopyMemory(struct field,dst->end + 1,&((struct multifield *) dst->value)->theFields[0], &((struct multifield *) src->value)->theFields[src->begin]); } /*********************************************************************/ /* CopyMultifield: */ /*********************************************************************/ globle void *CopyMultifield( void *theEnv, struct multifield *src) { struct multifield *dst; dst = (struct multifield *) CreateMultifield2(theEnv,src->multifieldLength); GenCopyMemory(struct field,src->multifieldLength,&(dst->theFields[0]),&(src->theFields[0])); return((void *) dst); } /**********************************************************/ /* PrintMultifield: Prints out a multifield */ /**********************************************************/ globle void PrintMultifield( void *theEnv, char *fileid, struct multifield *segment, long begin, long end, int printParens) { struct field *theMultifield; int i; theMultifield = segment->theFields; if (printParens) EnvPrintRouter(theEnv,fileid,"("); i = begin; while (i <= end) { PrintAtom(theEnv,fileid,theMultifield[i].type,theMultifield[i].value); i++; if (i <= end) EnvPrintRouter(theEnv,fileid," "); } if (printParens) EnvPrintRouter(theEnv,fileid,")"); } /*****************************************************/ /* StoreInMultifield: Append function for segments. */ /*****************************************************/ globle void StoreInMultifield( void *theEnv, DATA_OBJECT *returnValue, EXPRESSION *expptr, int garbageSegment) { DATA_OBJECT val_ptr; DATA_OBJECT *val_arr; struct multifield *theMultifield; struct multifield *orig_ptr; long start, end, i,j, k, argCount; unsigned long seg_size; argCount = CountArguments(expptr); /*=========================================*/ /* If no arguments are given return a NULL */ /* multifield of length zero. */ /*=========================================*/ if (argCount == 0) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L); SetpValue(returnValue,(void *) theMultifield); return; } else { /*========================================*/ /* Get a new segment with length equal to */ /* the total length of all the arguments. */ /*========================================*/ val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount); seg_size = 0; for(i = 1 ; i <= argCount ; i++ , expptr = expptr->nextArg) { EvaluateExpression(theEnv,expptr,&val_ptr); if (EvaluationData(theEnv)->EvaluationError) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); if (garbageSegment) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); } else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L); SetpValue(returnValue,(void *) theMultifield); rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount); return; } SetpType(val_arr+i-1,GetType(val_ptr)); if (GetType(val_ptr) == MULTIFIELD) { SetpValue(val_arr+i-1,GetpValue(&val_ptr)); start = GetDOBegin(val_ptr); end = GetDOEnd(val_ptr); } else if (GetType(val_ptr) == RVOID) { SetpValue(val_arr+i-1,GetValue(val_ptr)); start = 1; end = 0; } else { SetpValue(val_arr+i-1,GetValue(val_ptr)); start = end = -1; } seg_size += (unsigned long) (end - start + 1); SetpDOBegin(val_arr+i-1,start); SetpDOEnd(val_arr+i-1,end); } if (garbageSegment) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); } else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size); /*========================================*/ /* Copy each argument into new segment. */ /*========================================*/ for(k=0,j=1; k < argCount;k++) { if (GetpType(val_arr+k) == MULTIFIELD) { start = GetpDOBegin(val_arr+k); end = GetpDOEnd(val_arr+k); orig_ptr = (struct multifield *) GetpValue(val_arr+k); for(i=start; i< end + 1; i++,j++) { SetMFType(theMultifield,j,(GetMFType(orig_ptr,i))); SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i))); } } else if (GetpType(val_arr+k) != MULTIFIELD) { SetMFType(theMultifield,j,(short) (GetpType(val_arr+k))); SetMFValue(theMultifield,j,(GetpValue(val_arr+k))); j++; } } /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) seg_size); SetpValue(returnValue,(void *) theMultifield); rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount); return; } } /*************************************************************/ /* MultifieldDOsEqual: determines if two segments are equal. */ /*************************************************************/ globle intBool MultifieldDOsEqual( DATA_OBJECT_PTR dobj1, DATA_OBJECT_PTR dobj2) { long extent1,extent2; /* 6.04 Bug Fix */ FIELD_PTR e1,e2; extent1 = GetpDOLength(dobj1); extent2 = GetpDOLength(dobj2); if (extent1 != extent2) { return(FALSE); } e1 = (FIELD_PTR) GetMFPtr(GetpValue(dobj1),GetpDOBegin(dobj1)); e2 = (FIELD_PTR) GetMFPtr(GetpValue(dobj2),GetpDOBegin(dobj2)); while (extent1 != 0) { if (e1->type != e2->type) { return(FALSE); } if (e1->value != e2->value) { return(FALSE); } extent1--; if (extent1 > 0) { e1++; e2++; } } return(TRUE); } /******************************************************************/ /* MultifieldsEqual: Determines if two multifields are identical. */ /******************************************************************/ globle int MultifieldsEqual( struct multifield *segment1, struct multifield *segment2) { struct field *elem1; struct field *elem2; unsigned long length, i = 0; length = segment1->multifieldLength; if (length != segment2->multifieldLength) { return(FALSE); } elem1 = segment1->theFields; elem2 = segment2->theFields; /*==================================================*/ /* Compare each field of both facts until the facts */ /* match completely or the facts mismatch. */ /*==================================================*/ while (i < length) { if (elem1[i].type != elem2[i].type) { return(FALSE); } if (elem1[i].type == MULTIFIELD) { if (MultifieldsEqual((struct multifield *) elem1[i].value, (struct multifield *) elem2[i].value) == FALSE) { return(FALSE); } } else if (elem1[i].value != elem2[i].value) { return(FALSE); } i++; } return(TRUE); } /************************************************************/ /* HashMultifield: Returns the hash value for a multifield. */ /************************************************************/ unsigned HashMultifield( struct multifield *theSegment, unsigned theRange) { unsigned long length, i; unsigned int tvalue; unsigned int count; struct field *fieldPtr; union { double fv; unsigned int liv; } fis; /*================================================*/ /* Initialize variables for computing hash value. */ /*================================================*/ count = 0; length = theSegment->multifieldLength; fieldPtr = theSegment->theFields; /*====================================================*/ /* Loop through each value in the multifield, compute */ /* its hash value, and add it to the running total. */ /*====================================================*/ for (i = 0; i < length; i++) { switch(fieldPtr[i].type) { case MULTIFIELD: count += HashMultifield((struct multifield *) fieldPtr[i].value,theRange); break; case FLOAT: fis.fv = ValueToDouble(fieldPtr[i].value); count += (fis.liv * (i + 29)) + (int) ValueToDouble(fieldPtr[i].value); break; case INTEGER: count += (((int) ValueToLong(fieldPtr[i].value)) * (i + 29)) + ValueToLong(fieldPtr[i].value); break; case FACT_ADDRESS: case EXTERNAL_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif count += (unsigned int) (((int) fieldPtr[i].value) * (i + 29)); break; case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif tvalue = (unsigned) HashSymbol(ValueToString(fieldPtr[i].value),theRange); count += (unsigned) (tvalue * (i + 29)); break; } } /*========================*/ /* Return the hash value. */ /*========================*/ return(count); } /**********************/ /* GetMultifieldList: */ /**********************/ globle struct multifield *GetMultifieldList( void *theEnv) { return(MultifieldData(theEnv)->ListOfMultifields); } /***************************************/ /* ImplodeMultifield: C access routine */ /* for the implode$ function. */ /***************************************/ globle void *ImplodeMultifield( void *theEnv, DATA_OBJECT *value) { unsigned strsize = 0; long i, j; char *tmp_str; char *ret_str; void *rv; struct multifield *theMultifield; /*===================================================*/ /* Determine the size of the string to be allocated. */ /*===================================================*/ theMultifield = (struct multifield *) GetpValue(value); for (i = GetpDOBegin(value) ; i <= GetpDOEnd(value) ; i++) { if (GetMFType(theMultifield,i) == FLOAT) { tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i))); strsize += strlen(tmp_str) + 1; } else if (GetMFType(theMultifield,i) == INTEGER) { tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i))); strsize += strlen(tmp_str) + 1; } else if (GetMFType(theMultifield,i) == STRING) { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; tmp_str = ValueToString(GetMFValue(theMultifield,i)); while(*tmp_str) { if (*tmp_str == '"') { strsize++; } else if (*tmp_str == '\\') /* GDR 111599 #835 */ { strsize++; } /* GDR 111599 #835 */ tmp_str++; } } #if OBJECT_SYSTEM else if (GetMFType(theMultifield,i) == INSTANCE_NAME) { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; } else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS) { strsize += strlen(ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name)) + 3; } #endif else { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 1; } } /*=============================================*/ /* Allocate the string and copy all components */ /* of the MULTIFIELD variable to it. */ /*=============================================*/ if (strsize == 0) return(EnvAddSymbol(theEnv,"")); ret_str = (char *) gm2(theEnv,strsize); for(j=0, i=GetpDOBegin(value); i <= GetpDOEnd(value) ; i++) { /*============================*/ /* Convert numbers to strings */ /*============================*/ if (GetMFType(theMultifield,i) == FLOAT) { tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i))); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } else if (GetMFType(theMultifield,i) == INTEGER) { tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i))); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } /*=======================================*/ /* Enclose strings in quotes and preceed */ /* imbedded quotes with a backslash */ /*=======================================*/ else if (GetMFType(theMultifield,i) == STRING) { tmp_str = ValueToString(GetMFValue(theMultifield,i)); *(ret_str+j) = '"'; j++; while(*tmp_str) { if (*tmp_str == '"') { *(ret_str+j) = '\\'; j++; } else if (*tmp_str == '\\') /* GDR 111599 #835 */ { /* GDR 111599 #835 */ *(ret_str+j) = '\\'; /* GDR 111599 #835 */ j++; /* GDR 111599 #835 */ } /* GDR 111599 #835 */ *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str+j) = '"'; j++; } #if OBJECT_SYSTEM else if (GetMFType(theMultifield,i) == INSTANCE_NAME) { tmp_str = ValueToString(GetMFValue(theMultifield,i)); *(ret_str + j++) = '['; while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str + j++) = ']'; } else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS) { tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name); *(ret_str + j++) = '['; while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str + j++) = ']'; } #endif else { tmp_str = ValueToString(GetMFValue(theMultifield,i)); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } *(ret_str+j) = ' '; j++; } *(ret_str+j-1) = '\0'; /*====================*/ /* Return the string. */ /*====================*/ rv = EnvAddSymbol(theEnv,ret_str); rm(theEnv,ret_str,strsize); return(rv); } clips-6.24/clipssrc/ruledlt.h0000755000175000017500000000304107422634772014371 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* RULE DELETION MODULE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for deleting a rule including */ /* freeing the defrule data structures and removing the */ /* appropriate joins from the join network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_ruledlt #define _H_ruledlt #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEDLT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ReturnDefrule(void *,void *); LOCALE void DestroyDefrule(void *,void *); #endif clips-6.24/clipssrc/globlbsc.c0000755000175000017500000002661310441143603014471 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFGLOBAL BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the defglobal */ /* construct such as clear, reset, save, undefglobal, */ /* ppdefglobal, list-defglobals, and get-defglobals-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _GLOBLBSC_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT #include "constrct.h" #include "extnfunc.h" #include "watch.h" #include "envrnmnt.h" #include "globlcom.h" #include "globldef.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "globlbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "globlcmp.h" #endif #include "globlbsc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void SaveDefglobals(void *,void *,char *); static void ResetDefglobalAction(void *,struct constructHeader *,void *); #if DEBUGGING_FUNCTIONS && (! RUN_TIME) static unsigned DefglobalWatchAccess(void *,int,unsigned,struct expr *); static unsigned DefglobalWatchPrint(void *,char *,int,struct expr *); #endif /****************************************/ /* GLOBAL INTERNAL VARIABLE DEFINITIONS */ /****************************************/ #if DEBUGGING_FUNCTIONS globle unsigned WatchGlobals = OFF; #endif /*****************************************************************/ /* DefglobalBasicCommands: Initializes basic defglobal commands. */ /*****************************************************************/ globle void DefglobalBasicCommands( void *theEnv) { AddSaveFunction(theEnv,"defglobal",SaveDefglobals,40); EnvAddResetFunction(theEnv,"defglobal",ResetDefglobals,50); #if ! RUN_TIME EnvDefineFunction2(theEnv,"get-defglobal-list",'m',PTIEF GetDefglobalListFunction,"GetDefglobalListFunction","01w"); EnvDefineFunction2(theEnv,"undefglobal",'v',PTIEF UndefglobalCommand,"UndefglobalCommand","11w"); EnvDefineFunction2(theEnv,"defglobal-module",'w',PTIEF DefglobalModuleFunction,"DefglobalModuleFunction","11w"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"list-defglobals",'v', PTIEF ListDefglobalsCommand,"ListDefglobalsCommand","01w"); EnvDefineFunction2(theEnv,"ppdefglobal",'v',PTIEF PPDefglobalCommand,"PPDefglobalCommand","11w"); AddWatchItem(theEnv,"globals",0,&WatchGlobals,0,DefglobalWatchAccess,DefglobalWatchPrint); #endif #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) DefglobalBinarySetup(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefglobalCompilerSetup(theEnv); #endif #endif } /*************************************************************/ /* ResetDefglobals: Defglobal reset routine for use with the */ /* reset command. Restores the values of the defglobals. */ /*************************************************************/ globle void ResetDefglobals( void *theEnv) { if (! EnvGetResetGlobals(theEnv)) return; DoForAllConstructs(theEnv,ResetDefglobalAction,DefglobalData(theEnv)->DefglobalModuleIndex,TRUE,NULL); } /******************************************************/ /* ResetDefglobalAction: Action to be applied to each */ /* defglobal construct during a reset command. */ /******************************************************/ #if IBM_TBC #pragma argsused #endif static void ResetDefglobalAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif struct defglobal *theDefglobal = (struct defglobal *) theConstruct; DATA_OBJECT assignValue; if (EvaluateExpression(theEnv,theDefglobal->initial,&assignValue)) { assignValue.type = SYMBOL; assignValue.value = EnvFalseSymbol(theEnv); } QSetDefglobalValue(theEnv,theDefglobal,&assignValue,FALSE); } /******************************************/ /* SaveDefglobals: Defglobal save routine */ /* for use with the save command. */ /******************************************/ static void SaveDefglobals( void *theEnv, void *theModule, char *logicalName) { SaveConstruct(theEnv,theModule,logicalName,DefglobalData(theEnv)->DefglobalConstruct); } /********************************************/ /* UndefglobalCommand: H/L access routine */ /* for the undefglobal command. */ /********************************************/ globle void UndefglobalCommand( void *theEnv) { UndefconstructCommand(theEnv,"undefglobal",DefglobalData(theEnv)->DefglobalConstruct); } /************************************/ /* EnvUndefglobal: C access routine */ /* for the undefglobal command. */ /************************************/ globle intBool EnvUndefglobal( void *theEnv, void *theDefglobal) { return(Undefconstruct(theEnv,theDefglobal,DefglobalData(theEnv)->DefglobalConstruct)); } /**************************************************/ /* GetDefglobalListFunction: H/L access routine */ /* for the get-defglobal-list function. */ /**************************************************/ globle void GetDefglobalListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { GetConstructListFunction(theEnv,"get-defglobal-list",returnValue,DefglobalData(theEnv)->DefglobalConstruct); } /******************************************/ /* EnvGetDefglobalList: C access routine */ /* for the get-defglobal-list function. */ /******************************************/ globle void EnvGetDefglobalList( void *theEnv, DATA_OBJECT_PTR returnValue, void *theModule) { GetConstructList(theEnv,returnValue,DefglobalData(theEnv)->DefglobalConstruct,(struct defmodule *) theModule); } /*************************************************/ /* DefglobalModuleFunction: H/L access routine */ /* for the defglobal-module function. */ /*************************************************/ globle void *DefglobalModuleFunction( void *theEnv) { return(GetConstructModuleCommand(theEnv,"defglobal-module",DefglobalData(theEnv)->DefglobalConstruct)); } #if DEBUGGING_FUNCTIONS /********************************************/ /* PPDefglobalCommand: H/L access routine */ /* for the ppdefglobal command. */ /********************************************/ globle void PPDefglobalCommand( void *theEnv) { PPConstructCommand(theEnv,"ppdefglobal",DefglobalData(theEnv)->DefglobalConstruct); } /*************************************/ /* PPDefglobal: C access routine for */ /* the ppdefglobal command. */ /*************************************/ globle int PPDefglobal( void *theEnv, char *defglobalName, char *logicalName) { return(PPConstruct(theEnv,defglobalName,logicalName,DefglobalData(theEnv)->DefglobalConstruct)); } /***********************************************/ /* ListDefglobalsCommand: H/L access routine */ /* for the list-defglobals command. */ /***********************************************/ globle void ListDefglobalsCommand( void *theEnv) { ListConstructCommand(theEnv,"list-defglobals",DefglobalData(theEnv)->DefglobalConstruct); } /***************************************/ /* EnvListDefglobals: C access routine */ /* for the list-defglobals command. */ /***************************************/ globle void EnvListDefglobals( void *theEnv, char *logicalName, void *vTheModule) { struct defmodule *theModule = (struct defmodule *) vTheModule; ListConstruct(theEnv,DefglobalData(theEnv)->DefglobalConstruct,logicalName,theModule); } /*********************************************************/ /* EnvGetDefglobalWatch: C access routine for retrieving */ /* the current watch value of a defglobal. */ /*********************************************************/ #if IBM_TBC #pragma argsused #endif globle unsigned EnvGetDefglobalWatch( void *theEnv, void *theGlobal) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((struct defglobal *) theGlobal)->watch); } /********************************************************/ /* EnvSetDeftemplateWatch: C access routine for setting */ /* the current watch value of a deftemplate. */ /********************************************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetDefglobalWatch( void *theEnv, unsigned newState, void *theGlobal) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif ((struct defglobal *) theGlobal)->watch = newState; } #if ! RUN_TIME /********************************************************/ /* DefglobalWatchAccess: Access routine for setting the */ /* watch flag of a defglobal via the watch command. */ /********************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DefglobalWatchAccess( void *theEnv, int code, unsigned newState, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(ConstructSetWatchAccess(theEnv,DefglobalData(theEnv)->DefglobalConstruct,newState,argExprs, EnvGetDefglobalWatch,EnvSetDefglobalWatch)); } /*********************************************************************/ /* DefglobalWatchPrint: Access routine for printing which defglobals */ /* have their watch flag set via the list-watch-items command. */ /*********************************************************************/ #if IBM_TBC #pragma argsused #endif static unsigned DefglobalWatchPrint( void *theEnv, char *logName, int code, EXPRESSION *argExprs) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(code) #endif return(ConstructPrintWatchAccess(theEnv,DefglobalData(theEnv)->DefglobalConstruct,logName,argExprs, EnvGetDefglobalWatch,EnvSetDefglobalWatch)); } #endif #endif /* DEBUGGING_FUNCTIONS */ #endif /* DEFGLOBAL_CONSTRUCT */ clips-6.24/clipssrc/._sysdep.c0000400000175000017500000000452210441602335014406 0ustar jfsjfsMac OS X  2 R TEXTR*ch@nsysdep.cntrol Paneloler------shTEXTR*ch@ p)f " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco0@c0@cRmmnL0BnGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/globlcmp.h0000755000175000017500000000303507422634705014514 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFGLOBAL CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_globlcmp #define _H_globlcmp #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefglobalCompilerSetup(void *); LOCALE void DefglobalCModuleReference(void *,FILE *,int,int,int); LOCALE void DefglobalCConstructReference(void *,FILE *,void *,int,int); #endif clips-6.24/clipssrc/._cstrnops.c0000400000175000017500000000075410441602124014751 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco00.nnjTTFL(rFMPSRMWBBLclips-6.24/clipssrc/prcdrfun.h0000755000175000017500000000551710441150542014532 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* PROCEDURAL FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_prcdrfun #define _H_prcdrfun #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _PRCDRFUN_SOURCE #define LOCALE #else #define LOCALE extern #endif typedef struct loopCounterStack { long loopCounter; struct loopCounterStack *nxt; } LOOP_COUNTER_STACK; #define PRCDRFUN_DATA 13 struct procedureFunctionData { int ReturnFlag; int BreakFlag; LOOP_COUNTER_STACK *LoopCounterStack; struct dataObject *BindList; }; #define ProcedureFunctionData(theEnv) ((struct procedureFunctionData *) GetEnvironmentData(theEnv,PRCDRFUN_DATA)) LOCALE void ProceduralFunctionDefinitions(void *); LOCALE void WhileFunction(void *,DATA_OBJECT_PTR); LOCALE void LoopForCountFunction(void *,DATA_OBJECT_PTR); LOCALE long GetLoopCount(void *); LOCALE void IfFunction(void *,DATA_OBJECT_PTR); LOCALE void BindFunction(void *,DATA_OBJECT_PTR); LOCALE void PrognFunction(void *,DATA_OBJECT_PTR); LOCALE void ReturnFunction(void *,DATA_OBJECT_PTR); LOCALE void BreakFunction(void *); LOCALE void SwitchFunction(void *,DATA_OBJECT_PTR); LOCALE intBool GetBoundVariable(void *,struct dataObject *,struct symbolHashNode *); LOCALE void FlushBindList(void *); #endif clips-6.24/clipssrc/tmpltpsr.c0000755000175000017500000005002210177533463014573 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.23 01/31/05 */ /* */ /* DEFTEMPLATE PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses the deftemplate construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Added support for templates maintaining their */ /* own list of facts. */ /* */ /*************************************************************/ #define _TMPLTPSR_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "memalloc.h" #include "symbol.h" #include "scanner.h" #include "exprnpsr.h" #include "router.h" #include "constrct.h" #include "envrnmnt.h" #include "factmngr.h" #include "cstrnchk.h" #include "cstrnpsr.h" #include "cstrcpsr.h" #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "default.h" #include "pattern.h" #include "watch.h" #include "cstrnutl.h" #include "tmpltdef.h" #include "tmpltbsc.h" #include "tmpltpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct templateSlot *SlotDeclarations(void *,char *,struct token *); static struct templateSlot *ParseSlot(void *,char *,struct token *,struct templateSlot *); static struct templateSlot *DefinedSlots(void *,char *,SYMBOL_HN *,int,struct token *); #endif /*******************************************************/ /* ParseDeftemplate: Parses the deftemplate construct. */ /*******************************************************/ 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,TRUE); 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); } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************************************/ /* InstallDeftemplate: Increments all occurrences in the hash */ /* table of symbols found in an deftemplate and adds it to */ /* the hash table. */ /**************************************************************/ globle void InstallDeftemplate( void *theEnv, struct deftemplate *theDeftemplate) { struct templateSlot *slotPtr; struct expr *tempExpr; IncrementSymbolCount(theDeftemplate->header.name); for (slotPtr = theDeftemplate->slotList; slotPtr != NULL; slotPtr = slotPtr->next) { IncrementSymbolCount(slotPtr->slotName); tempExpr = AddHashedExpression(theEnv,slotPtr->defaultList); ReturnExpression(theEnv,slotPtr->defaultList); slotPtr->defaultList = tempExpr; slotPtr->constraints = AddConstraint(theEnv,slotPtr->constraints); } } /********************************************************************/ /* SlotDeclarations: Parses the slot declarations of a deftemplate. */ /********************************************************************/ static struct templateSlot *SlotDeclarations( void *theEnv, char *readSource, struct token *inputToken) { struct templateSlot *newSlot, *slotList = NULL, *lastSlot = NULL; struct templateSlot *multiSlot = NULL; while (inputToken->type != RPAREN) { /*====================================================*/ /* Slots begin with a '(' followed by a slot keyword. */ /*====================================================*/ if (inputToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"deftemplate"); ReturnSlots(theEnv,slotList); ReturnSlots(theEnv,multiSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"deftemplate"); ReturnSlots(theEnv,slotList); ReturnSlots(theEnv,multiSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*=================*/ /* Parse the slot. */ /*=================*/ newSlot = ParseSlot(theEnv,readSource,inputToken,slotList); if (DeftemplateData(theEnv)->DeftemplateError == TRUE) { ReturnSlots(theEnv,newSlot); ReturnSlots(theEnv,slotList); ReturnSlots(theEnv,multiSlot); return(NULL); } /*===========================================*/ /* Attach the new slot to the list of slots. */ /*===========================================*/ if (newSlot != NULL) { if (lastSlot == NULL) { slotList = newSlot; } else { lastSlot->next = newSlot; } lastSlot = newSlot; } /*================================*/ /* Check for closing parenthesis. */ /*================================*/ GetToken(theEnv,readSource,inputToken); if (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,"\n "); SavePPBuffer(theEnv,inputToken->printForm); } } SavePPBuffer(theEnv,"\n"); /*=======================*/ /* Return the slot list. */ /*=======================*/ return(slotList); } /*****************************************************/ /* ParseSlot: Parses a single slot of a deftemplate. */ /*****************************************************/ static struct templateSlot *ParseSlot( void *theEnv, char *readSource, struct token *inputToken, struct templateSlot *slotList) { int parsingMultislot; SYMBOL_HN *slotName; struct templateSlot *newSlot; int rv; /*=====================================================*/ /* Slots must begin with keyword field or multifield. */ /*=====================================================*/ if ((strcmp(ValueToString(inputToken->value),"field") != 0) && (strcmp(ValueToString(inputToken->value),"multifield") != 0) && (strcmp(ValueToString(inputToken->value),"slot") != 0) && (strcmp(ValueToString(inputToken->value),"multislot") != 0)) { SyntaxErrorMessage(theEnv,"deftemplate"); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*===============================================*/ /* Determine if multifield slot is being parsed. */ /*===============================================*/ if ((strcmp(ValueToString(inputToken->value),"multifield") == 0) || (strcmp(ValueToString(inputToken->value),"multislot") == 0)) { parsingMultislot = TRUE; } else { parsingMultislot = FALSE; } /*========================================*/ /* The name of the slot must be a symbol. */ /*========================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"deftemplate"); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } slotName = (SYMBOL_HN *) inputToken->value; /*================================================*/ /* Determine if the slot has already been parsed. */ /*================================================*/ while (slotList != NULL) { if (slotList->slotName == slotName) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(slotList->slotName)); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } slotList = slotList->next; } /*===================================*/ /* Parse the attributes of the slot. */ /*===================================*/ newSlot = DefinedSlots(theEnv,readSource,slotName,parsingMultislot,inputToken); if (newSlot == NULL) { DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*=================================*/ /* Check for slot conflict errors. */ /*=================================*/ if (CheckConstraintParseConflicts(theEnv,newSlot->constraints) == FALSE) { ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } if ((newSlot->defaultPresent) || (newSlot->defaultDynamic)) { rv = ConstraintCheckExpressionChain(theEnv,newSlot->defaultList,newSlot->constraints); } else { rv = NO_VIOLATION; } if ((rv != NO_VIOLATION) && EnvGetStaticConstraintChecking(theEnv)) { char *temp; if (newSlot->defaultDynamic) temp = "the default-dynamic attribute"; else temp = "the default attribute"; ConstraintViolationErrorMessage(theEnv,"An expression",temp,FALSE,0, newSlot->slotName,0,rv,newSlot->constraints,TRUE); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*==================*/ /* Return the slot. */ /*==================*/ return(newSlot); } /**************************************************************/ /* DefinedSlots: Parses a field or multifield slot attribute. */ /**************************************************************/ 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); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/._ruledef.c0000400000175000017500000000075410441602324014526 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monacohh #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "extnfunc.h" #include "scanner.h" #include "multifld.h" #include "argacces.h" #include "cstrnutl.h" /************************************************/ /* GetConstraintRecord: Creates and initializes */ /* the values of a constraint record. */ /************************************************/ 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); } /********************************************************/ /* SetAnyAllowedFlags: Sets the allowed type flags of a */ /* constraint record to allow all types. If passed an */ /* argument of TRUE, just the "any allowed" flag is */ /* set to TRUE. If passed an argument of FALSE, then */ /* all of the individual type flags are set to TRUE. */ /********************************************************/ globle void SetAnyAllowedFlags( CONSTRAINT_RECORD *theConstraint, int justOne) { int flag1, flag2; if (justOne) { flag1 = TRUE; flag2 = FALSE; } else { flag1 = FALSE; flag2 = TRUE; } theConstraint->anyAllowed = flag1; theConstraint->symbolsAllowed = flag2; theConstraint->stringsAllowed = flag2; theConstraint->floatsAllowed = flag2; theConstraint->integersAllowed = flag2; theConstraint->instanceNamesAllowed = flag2; theConstraint->instanceAddressesAllowed = flag2; theConstraint->externalAddressesAllowed = flag2; theConstraint->voidAllowed = flag2; theConstraint->factAddressesAllowed = flag2; } /*****************************************************/ /* CopyConstraintRecord: Copies a constraint record. */ /*****************************************************/ globle struct constraintRecord *CopyConstraintRecord( void *theEnv, CONSTRAINT_RECORD *sourceConstraint) { CONSTRAINT_RECORD *theConstraint; if (sourceConstraint == NULL) return(NULL); theConstraint = get_struct(theEnv,constraintRecord); theConstraint->anyAllowed = sourceConstraint->anyAllowed; theConstraint->symbolsAllowed = sourceConstraint->symbolsAllowed; theConstraint->stringsAllowed = sourceConstraint->stringsAllowed; theConstraint->floatsAllowed = sourceConstraint->floatsAllowed; theConstraint->integersAllowed = sourceConstraint->integersAllowed; theConstraint->instanceNamesAllowed = sourceConstraint->instanceNamesAllowed; theConstraint->instanceAddressesAllowed = sourceConstraint->instanceAddressesAllowed; theConstraint->externalAddressesAllowed = sourceConstraint->externalAddressesAllowed; theConstraint->voidAllowed = sourceConstraint->voidAllowed; theConstraint->multifieldsAllowed = sourceConstraint->multifieldsAllowed; theConstraint->singlefieldsAllowed = sourceConstraint->singlefieldsAllowed; theConstraint->factAddressesAllowed = sourceConstraint->factAddressesAllowed; theConstraint->anyRestriction = sourceConstraint->anyRestriction; theConstraint->symbolRestriction = sourceConstraint->symbolRestriction; theConstraint->stringRestriction = sourceConstraint->stringRestriction; theConstraint->floatRestriction = sourceConstraint->floatRestriction; theConstraint->integerRestriction = sourceConstraint->integerRestriction; theConstraint->classRestriction = sourceConstraint->classRestriction; theConstraint->instanceNameRestriction = sourceConstraint->instanceNameRestriction; theConstraint->classList = CopyExpression(theEnv,sourceConstraint->classList); theConstraint->restrictionList = CopyExpression(theEnv,sourceConstraint->restrictionList); theConstraint->minValue = CopyExpression(theEnv,sourceConstraint->minValue); theConstraint->maxValue = CopyExpression(theEnv,sourceConstraint->maxValue); theConstraint->minFields = CopyExpression(theEnv,sourceConstraint->minFields); theConstraint->maxFields = CopyExpression(theEnv,sourceConstraint->maxFields); theConstraint->bucket = -1; theConstraint->count = 0; theConstraint->multifield = CopyConstraintRecord(theEnv,sourceConstraint->multifield); theConstraint->next = NULL; return(theConstraint); } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************************************/ /* SetAnyRestrictionFlags: Sets the restriction type flags of */ /* a constraint record to indicate there are restriction on */ /* all types. If passed an argument of TRUE, just the */ /* "any restriction" flag is set to TRUE. If passed an */ /* argument of FALSE, then all of the individual type */ /* restriction flags are set to TRUE. */ /**************************************************************/ globle void SetAnyRestrictionFlags( CONSTRAINT_RECORD *theConstraint, int justOne) { int flag1, flag2; if (justOne) { flag1 = TRUE; flag2 = FALSE; } else { flag1 = FALSE; flag2 = TRUE; } theConstraint->anyRestriction = flag1; theConstraint->symbolRestriction = flag2; theConstraint->stringRestriction = flag2; theConstraint->floatRestriction = flag2; theConstraint->integerRestriction = flag2; theConstraint->instanceNameRestriction = flag2; } /*****************************************************/ /* SetConstraintType: Given a constraint type and a */ /* constraint, sets the allowed type flags for the */ /* specified type in the constraint to TRUE. */ /*****************************************************/ globle int SetConstraintType( int theType, CONSTRAINT_RECORD *constraints) { int rv = TRUE; switch(theType) { case UNKNOWN_VALUE: rv = constraints->anyAllowed; constraints->anyAllowed = TRUE; break; case SYMBOL: rv = constraints->symbolsAllowed; constraints->symbolsAllowed = TRUE; break; case STRING: rv = constraints->stringsAllowed; constraints->stringsAllowed = TRUE; break; case SYMBOL_OR_STRING: rv = (constraints->stringsAllowed | constraints->symbolsAllowed); constraints->symbolsAllowed = TRUE; constraints->stringsAllowed = TRUE; break; case INTEGER: rv = constraints->integersAllowed; constraints->integersAllowed = TRUE; break; case FLOAT: rv = constraints->floatsAllowed; constraints->floatsAllowed = TRUE; break; case INTEGER_OR_FLOAT: rv = (constraints->integersAllowed | constraints->floatsAllowed); constraints->integersAllowed = TRUE; constraints->floatsAllowed = TRUE; break; case INSTANCE_ADDRESS: rv = constraints->instanceAddressesAllowed; constraints->instanceAddressesAllowed = TRUE; break; case INSTANCE_NAME: rv = constraints->instanceNamesAllowed; constraints->instanceNamesAllowed = TRUE; break; case INSTANCE_OR_INSTANCE_NAME: rv = (constraints->instanceNamesAllowed | constraints->instanceAddressesAllowed); constraints->instanceNamesAllowed = TRUE; constraints->instanceAddressesAllowed = TRUE; break; case EXTERNAL_ADDRESS: rv = constraints->externalAddressesAllowed; constraints->externalAddressesAllowed = TRUE; break; case RVOID: rv = constraints->voidAllowed; constraints->voidAllowed = TRUE; break; case FACT_ADDRESS: rv = constraints->factAddressesAllowed; constraints->factAddressesAllowed = TRUE; break; case MULTIFIELD: rv = constraints->multifieldsAllowed; constraints->multifieldsAllowed = TRUE; break; } if (theType != UNKNOWN_VALUE) constraints->anyAllowed = FALSE; return(rv); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ /*************************************************************/ /* CompareNumbers: Given two numbers (which can be integers, */ /* floats, or the symbols for positive/negative infinity) */ /* returns the relationship between the numbers (greater */ /* than, less than or equal). */ /*************************************************************/ globle int CompareNumbers( void *theEnv, int type1, void *vptr1, int type2, void *vptr2) { /*============================================*/ /* Handle the situation in which the values */ /* are exactly equal (same type, same value). */ /*============================================*/ if (vptr1 == vptr2) return(EQUAL); /*=======================================*/ /* Handle the special cases for positive */ /* and negative infinity. */ /*=======================================*/ if (vptr1 == SymbolData(theEnv)->PositiveInfinity) return(GREATER_THAN); if (vptr1 == SymbolData(theEnv)->NegativeInfinity) return(LESS_THAN); if (vptr2 == SymbolData(theEnv)->PositiveInfinity) return(LESS_THAN); if (vptr2 == SymbolData(theEnv)->NegativeInfinity) return(GREATER_THAN); /*=======================*/ /* Compare two integers. */ /*=======================*/ if ((type1 == INTEGER) && (type2 == INTEGER)) { if (ValueToLong(vptr1) < ValueToLong(vptr2)) { return(LESS_THAN); } else if (ValueToLong(vptr1) > ValueToLong(vptr2)) { return(GREATER_THAN); } return(EQUAL); } /*=====================*/ /* Compare two floats. */ /*=====================*/ if ((type1 == FLOAT) && (type2 == FLOAT)) { if (ValueToDouble(vptr1) < ValueToDouble(vptr2)) { return(LESS_THAN); } else if (ValueToDouble(vptr1) > ValueToDouble(vptr2)) { return(GREATER_THAN); } return(EQUAL); } /*================================*/ /* Compare an integer to a float. */ /*================================*/ if ((type1 == INTEGER) && (type2 == FLOAT)) { if (((double) ValueToLong(vptr1)) < ValueToDouble(vptr2)) { return(LESS_THAN); } else if (((double) ValueToLong(vptr1)) > ValueToDouble(vptr2)) { return(GREATER_THAN); } return(EQUAL); } /*================================*/ /* Compare a float to an integer. */ /*================================*/ if ((type1 == FLOAT) && (type2 == INTEGER)) { if (ValueToDouble(vptr1) < ((double) ValueToLong(vptr2))) { return(LESS_THAN); } else if (ValueToDouble(vptr1) > ((double) ValueToLong(vptr2))) { return(GREATER_THAN); } return(EQUAL); } /*===================================*/ /* One of the arguments was invalid. */ /* Return -1 to indicate an error. */ /*===================================*/ return(-1); } /****************************************************************/ /* ExpressionToConstraintRecord: Converts an expression into a */ /* constraint record. For example, an expression representing */ /* the symbol BLUE would be converted to a record with */ /* allowed types SYMBOL and allow-values BLUE. */ /****************************************************************/ globle CONSTRAINT_RECORD *ExpressionToConstraintRecord( void *theEnv, struct expr *theExpression) { CONSTRAINT_RECORD *rv; /*================================================*/ /* A NULL expression is converted to a constraint */ /* record with no values allowed. */ /*================================================*/ if (theExpression == NULL) { rv = GetConstraintRecord(theEnv); rv->anyAllowed = FALSE; return(rv); } /*=============================================================*/ /* Convert variables and function calls to constraint records. */ /*=============================================================*/ if ((theExpression->type == SF_VARIABLE) || (theExpression->type == MF_VARIABLE) || #if DEFGENERIC_CONSTRUCT (theExpression->type == GCALL) || #endif #if DEFFUNCTION_CONSTRUCT (theExpression->type == PCALL) || #endif (theExpression->type == GBL_VARIABLE) || (theExpression->type == MF_GBL_VARIABLE)) { rv = GetConstraintRecord(theEnv); rv->multifieldsAllowed = TRUE; return(rv); } else if (theExpression->type == FCALL) { return(FunctionCallToConstraintRecord(theEnv,theExpression->value)); } /*============================================*/ /* Convert a constant to a constraint record. */ /*============================================*/ rv = GetConstraintRecord(theEnv); rv->anyAllowed = FALSE; if (theExpression->type == FLOAT) { rv->floatRestriction = TRUE; rv->floatsAllowed = TRUE; } else if (theExpression->type == INTEGER) { rv->integerRestriction = TRUE; rv->integersAllowed = TRUE; } else if (theExpression->type == SYMBOL) { rv->symbolRestriction = TRUE; rv->symbolsAllowed = TRUE; } else if (theExpression->type == STRING) { rv->stringRestriction = TRUE; rv->stringsAllowed = TRUE; } else if (theExpression->type == INSTANCE_NAME) { rv->instanceNameRestriction = TRUE; rv->instanceNamesAllowed = TRUE; } else if (theExpression->type == INSTANCE_ADDRESS) { rv->instanceAddressesAllowed = TRUE; } if (rv->floatsAllowed || rv->integersAllowed || rv->symbolsAllowed || rv->stringsAllowed || rv->instanceNamesAllowed) { rv->restrictionList = GenConstant(theEnv,theExpression->type,theExpression->value); } return(rv); } /*******************************************************/ /* FunctionCallToConstraintRecord: Converts a function */ /* call to a constraint record. For example, the + */ /* function when converted would be a constraint */ /* record with allowed types INTEGER and FLOAT. */ /*******************************************************/ globle CONSTRAINT_RECORD *FunctionCallToConstraintRecord( void *theEnv, void *theFunction) { CONSTRAINT_RECORD *rv; rv = GetConstraintRecord(theEnv); rv->anyAllowed = FALSE; switch ((char) ValueFunctionType(theFunction)) { case 'a': rv->externalAddressesAllowed = TRUE; break; case 'f': case 'd': rv->floatsAllowed = TRUE; break; case 'i': case 'l': rv->integersAllowed = TRUE; break; case 'j': rv->instanceNamesAllowed = TRUE; rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; break; case 'k': rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; break; case 'm': rv->singlefieldsAllowed = FALSE; rv->multifieldsAllowed = TRUE; break; case 'n': rv->floatsAllowed = TRUE; rv->integersAllowed = TRUE; break; case 'o': rv->instanceNamesAllowed = TRUE; break; case 's': rv->stringsAllowed = TRUE; break; case 'u': rv->anyAllowed = TRUE; rv->multifieldsAllowed = TRUE; break; case 'w': case 'c': case 'b': rv->symbolsAllowed = TRUE; break; case 'x': rv->instanceAddressesAllowed = TRUE; break; case 'v': rv->voidAllowed = TRUE; break; } return(rv); } /*******************************************************/ /* ArgumentTypeToConstraintRecord: Converts one of the */ /* function argument types (used by DefineFunction2) */ /* to a constraint record. */ /*******************************************************/ globle CONSTRAINT_RECORD *ArgumentTypeToConstraintRecord( void *theEnv, int theRestriction) { CONSTRAINT_RECORD *rv; rv = GetConstraintRecord(theEnv); rv->anyAllowed = FALSE; switch (theRestriction) { case 'a': rv->externalAddressesAllowed = TRUE; break; case 'e': rv->symbolsAllowed = TRUE; rv->instanceNamesAllowed = TRUE; rv->instanceAddressesAllowed = TRUE; break; case 'd': case 'f': rv->floatsAllowed = TRUE; break; case 'g': rv->integersAllowed = TRUE; rv->floatsAllowed = TRUE; rv->symbolsAllowed = TRUE; break; case 'h': rv->factAddressesAllowed = TRUE; rv->integersAllowed = TRUE; rv->symbolsAllowed = TRUE; rv->instanceNamesAllowed = TRUE; rv->instanceAddressesAllowed = TRUE; break; case 'i': case 'l': rv->integersAllowed = TRUE; break; case 'j': rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; rv->instanceNamesAllowed = TRUE; break; case 'k': rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; break; case 'm': rv->singlefieldsAllowed = FALSE; rv->multifieldsAllowed = TRUE; break; case 'n': rv->floatsAllowed = TRUE; rv->integersAllowed = TRUE; break; case 'o': rv->instanceNamesAllowed = TRUE; break; case 'p': rv->instanceNamesAllowed = TRUE; rv->symbolsAllowed = TRUE; break; case 'q': rv->symbolsAllowed = TRUE; rv->stringsAllowed = TRUE; rv->multifieldsAllowed = TRUE; break; case 's': rv->stringsAllowed = TRUE; break; case 'w': rv->symbolsAllowed = TRUE; break; case 'x': rv->instanceAddressesAllowed = TRUE; break; case 'y': rv->factAddressesAllowed = TRUE; break; case 'z': rv->symbolsAllowed = TRUE; rv->factAddressesAllowed = TRUE; rv->integersAllowed = TRUE; break; case 'u': rv->anyAllowed = TRUE; rv->multifieldsAllowed = TRUE; break; case 'v': rv->voidAllowed = TRUE; break; } return(rv); } clips-6.24/clipssrc/cstrcpsr.h0000755000175000017500000000456607422634630014567 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* CONSTRUCT PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parsing routines and utilities for parsing */ /* constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrcpsr #define _H_cstrcpsr #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_scanner #include "scanner.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRCPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define Load(theEnv,a) EnvLoad(theEnv,a) #else #define Load(a) EnvLoad(GetCurrentEnvironment(),a) #endif LOCALE int EnvLoad(void *,char *); LOCALE int LoadConstructsFromLogicalName(void *,char *); LOCALE int ParseConstruct(void *,char *,char *); LOCALE void RemoveConstructFromModule(void *,struct constructHeader *); LOCALE struct symbolHashNode *GetConstructNameAndComment(void *,char *, struct token *,char *, void *(*)(void *,char *), int (*)(void *,void *), char *,int,int,int); LOCALE void ImportExportConflictMessage(void *,char *,char *,char *,char *); #endif clips-6.24/clipssrc/ruledef.c0000755000175000017500000002311310441602324014320 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFRULE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Defines basic defrule primitive functions such */ /* as allocating and deallocating, traversing, and finding */ /* defrule data structures. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warnings. */ /* */ /*************************************************************/ #define _RULEDEF_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "agenda.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "memalloc.h" #include "pattern.h" #include "retract.h" #include "rulebsc.h" #include "rulecom.h" #include "rulepsr.h" #include "ruledlt.h" #if BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY #include "bload.h" #include "rulebin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "rulecmp.h" #endif #include "ruledef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *AllocateModule(void *); static void ReturnModule(void *,void *); static void InitializeDefruleModules(void *); static void DeallocateDefruleData(void *); static void DestroyDefruleAction(void *,struct constructHeader *,void *); /**********************************************************/ /* InitializeDefrules: Initializes the defrule construct. */ /**********************************************************/ globle void InitializeDefrules( void *theEnv) { AllocateEnvironmentData(theEnv,DEFRULE_DATA,sizeof(struct defruleData),DeallocateDefruleData); InitializeEngine(theEnv); InitializeAgenda(theEnv); InitializePatterns(theEnv); InitializeDefruleModules(theEnv); AddReservedPatternSymbol(theEnv,"and",NULL); AddReservedPatternSymbol(theEnv,"not",NULL); AddReservedPatternSymbol(theEnv,"or",NULL); AddReservedPatternSymbol(theEnv,"test",NULL); AddReservedPatternSymbol(theEnv,"logical",NULL); AddReservedPatternSymbol(theEnv,"exists",NULL); AddReservedPatternSymbol(theEnv,"forall",NULL); DefruleBasicCommands(theEnv); DefruleCommands(theEnv); DefruleData(theEnv)->DefruleConstruct = AddConstruct(theEnv,"defrule","defrules", ParseDefrule,EnvFindDefrule, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefrule,SetNextConstruct, EnvIsDefruleDeletable,EnvUndefrule,ReturnDefrule); } /***************************************************/ /* DeallocateDefruleData: Deallocates environment */ /* data for the deffacts construct. */ /***************************************************/ static void DeallocateDefruleData( void *theEnv) { struct defruleModule *theModuleItem; void *theModule; struct activation *theActivation, *tmpActivation; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDefruleAction,DefruleData(theEnv)->DefruleModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct defruleModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefruleData(theEnv)->DefruleModuleIndex); theActivation = theModuleItem->agenda; while (theActivation != NULL) { tmpActivation = theActivation->next; if (theActivation->sortedBasis != NULL) { DestroyPartialMatch(theEnv,theActivation->sortedBasis); } rtn_struct(theEnv,activation,theActivation); theActivation = tmpActivation; } #if ! RUN_TIME rtn_struct(theEnv,defruleModule,theModuleItem); #endif } } /********************************************************/ /* DestroyDefruleAction: Action used to remove defrules */ /* as a result of DestroyEnvironment. */ /********************************************************/ #if IBM_TBC #pragma argsused #endif static void DestroyDefruleAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif struct defrule *theDefrule = (struct defrule *) theConstruct; DestroyDefrule(theEnv,theDefrule); } /*****************************************************/ /* InitializeDefruleModules: Initializes the defrule */ /* construct for use with the defmodule construct. */ /*****************************************************/ static void InitializeDefruleModules( void *theEnv) { DefruleData(theEnv)->DefruleModuleIndex = RegisterModuleItem(theEnv,"defrule", AllocateModule, ReturnModule, #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefruleModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefruleCModuleReference, #else NULL, #endif EnvFindDefrule); } /***********************************************/ /* AllocateModule: Allocates a defrule module. */ /***********************************************/ static void *AllocateModule( void *theEnv) { struct defruleModule *theItem; theItem = get_struct(theEnv,defruleModule); theItem->agenda = NULL; return((void *) theItem); } /*********************************************/ /* ReturnModule: Deallocates a defrule module. */ /*********************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefruleData(theEnv)->DefruleConstruct); rtn_struct(theEnv,defruleModule,theItem); } /************************************************************/ /* GetDefruleModuleItem: Returns a pointer to the defmodule */ /* item for the specified defrule or defmodule. */ /************************************************************/ globle struct defruleModule *GetDefruleModuleItem( void *theEnv, struct defmodule *theModule) { return((struct defruleModule *) GetConstructModuleItemByIndex(theEnv,theModule,DefruleData(theEnv)->DefruleModuleIndex)); } /*******************************************************************/ /* EnvFindDefrule: Searches for a defrule in the list of defrules. */ /* Returns a pointer to the defrule if found, otherwise NULL. */ /*******************************************************************/ globle void *EnvFindDefrule( void *theEnv, char *defruleName) { return(FindNamedConstruct(theEnv,defruleName,DefruleData(theEnv)->DefruleConstruct)); } /************************************************************/ /* EnvGetNextDefrule: If passed a NULL pointer, returns the */ /* first defrule in the ListOfDefrules. Otherwise returns */ /* the next defrule following the defrule passed as an */ /* argument. */ /************************************************************/ globle void *EnvGetNextDefrule( void *theEnv, void *defrulePtr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) defrulePtr,DefruleData(theEnv)->DefruleModuleIndex)); } /*******************************************************/ /* EnvIsDefruleDeletable: Returns TRUE if a particular */ /* defrule can be deleted, otherwise returns FALSE. */ /*******************************************************/ globle intBool EnvIsDefruleDeletable( void *theEnv, void *vTheDefrule) { struct defrule *theDefrule; if (! ConstructsDeletable(theEnv)) { return FALSE; } for (theDefrule = (struct defrule *) vTheDefrule; theDefrule != NULL; theDefrule = theDefrule->disjunct) { if (theDefrule->executing) return(FALSE); } if (EngineData(theEnv)->JoinOperationInProgress) return(FALSE); return(TRUE); } #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._dffnxcmp.c0000400000175000017500000000012207422634773014714 0ustar jfsjfsMac OS X  2 RTEXT????`clips-6.24/clipssrc/._engine.h0000400000175000017500000000075410443656422014364 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco)yy _TTFHOFMPSRMWBBLclips-6.24/clipssrc/defins.h0000755000175000017500000001203710441131552014152 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_defins #define _H_defins #if DEFINSTANCES_CONSTRUCT #define EnvGetDefinstancesName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define EnvGetDefinstancesPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetDefinstancesNamePointer(x) GetConstructNamePointer((struct constructHeader *) x) #define SetDefinstancesPPForm(d,ppf) SetConstructPPForm(theEnv,(struct constructHeader *) d,ppf) #define GetDefinstancesModuleName(x) GetConstructModuleName((struct constructHeader *) x) #define EnvDefinstancesModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) struct definstances; #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_object #include "object.h" #endif typedef struct definstancesModule { struct defmoduleItemHeader header; } DEFINSTANCES_MODULE; typedef struct definstances { struct constructHeader header; unsigned busy; EXPRESSION *mkinstance; } DEFINSTANCES; #define DEFINSTANCES_DATA 22 struct definstancesData { struct construct *DefinstancesConstruct; int DefinstancesModuleIndex; #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefinstancesCodeItem; #endif }; #define DefinstancesData(theEnv) ((struct definstancesData *) GetEnvironmentData(theEnv,DEFINSTANCES_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _DEFINS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DefinstancesModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define FindDefinstances(theEnv,a) EnvFindDefinstances(theEnv,a) #define GetDefinstancesList(theEnv,a,b) EnvGetDefinstancesList(theEnv,a,b) #define GetDefinstancesName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define GetDefinstancesPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetNextDefinstances(theEnv,a) EnvGetNextDefinstances(theEnv,a) #define IsDefinstancesDeletable(theEnv,a) EnvIsDefinstancesDeletable(theEnv,a) #define ListDefinstances(theEnv,a,b) EnvListDefinstances(theEnv,a,b) #define Undefinstances(theEnv,a) EnvUndefinstances(theEnv,a) #else #define DefinstancesModule(x) GetConstructModuleName((struct constructHeader *) x) #define FindDefinstances(a) EnvFindDefinstances(GetCurrentEnvironment(),a) #define GetDefinstancesList(a,b) EnvGetDefinstancesList(GetCurrentEnvironment(),a,b) #define GetDefinstancesName(x) GetConstructNameString((struct constructHeader *) x) #define GetDefinstancesPPForm(x) GetConstructPPForm(GetCurrentEnvironment(),(struct constructHeader *) x) #define GetNextDefinstances(a) EnvGetNextDefinstances(GetCurrentEnvironment(),a) #define IsDefinstancesDeletable(a) EnvIsDefinstancesDeletable(GetCurrentEnvironment(),a) #define ListDefinstances(a,b) EnvListDefinstances(GetCurrentEnvironment(),a,b) #define Undefinstances(a) EnvUndefinstances(GetCurrentEnvironment(),a) #endif LOCALE void SetupDefinstances(void *); LOCALE void *EnvGetNextDefinstances(void *,void *); LOCALE void *EnvFindDefinstances(void *,char *); LOCALE int EnvIsDefinstancesDeletable(void *,void *); LOCALE void UndefinstancesCommand(void *); LOCALE void *GetDefinstancesModuleCommand(void *); LOCALE intBool EnvUndefinstances(void *,void *); #if DEBUGGING_FUNCTIONS LOCALE void PPDefinstancesCommand(void *); LOCALE void ListDefinstancesCommand(void *); LOCALE void EnvListDefinstances(void *,char *,struct defmodule *); #endif LOCALE void GetDefinstancesListFunction(void *,DATA_OBJECT *); LOCALE void EnvGetDefinstancesList(void *,DATA_OBJECT *,struct defmodule *); #endif #endif clips-6.24/clipssrc/filertr.c0000755000175000017500000002412010441602212014334 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FILE I/O ROUTER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: I/O Router routines which allow files to be used */ /* as input and output sources. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Added pragmas to remove compilation warnings. */ /* */ /*************************************************************/ #define _FILERTR_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "sysdep.h" #include "filertr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ExitFile(void *,int); static int PrintFile(void *,char *,char *); static int GetcFile(void *,char *); static int UngetcFile(void *,int,char *); static void DeallocateFileRouterData(void *); /***************************************************************/ /* InitializeFileRouter: Initializes file input/output router. */ /***************************************************************/ globle void InitializeFileRouter( void *theEnv) { AllocateEnvironmentData(theEnv,FILE_ROUTER_DATA,sizeof(struct fileRouterData),DeallocateFileRouterData); EnvAddRouter(theEnv,"fileio",0,FindFile, PrintFile,GetcFile, UngetcFile,ExitFile); } /*****************************************/ /* DeallocateFileRouterData: Deallocates */ /* environment data for file routers. */ /*****************************************/ static void DeallocateFileRouterData( void *theEnv) { struct fileRouter *tmpPtr, *nextPtr; tmpPtr = FileRouterData(theEnv)->ListOfFileRouters; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; GenClose(theEnv,tmpPtr->stream); rtn_struct(theEnv,fileRouter,tmpPtr); tmpPtr = nextPtr; } } /*****************************************/ /* FindFptr: Returns a pointer to a file */ /* stream for a given logical name. */ /*****************************************/ globle FILE *FindFptr( void *theEnv, char *logicalName) { struct fileRouter *fptr; /*========================================================*/ /* Check to see if standard input or output is requested. */ /*========================================================*/ if (strcmp(logicalName,"stdout") == 0) { return(stdout); } else if (strcmp(logicalName,"stdin") == 0) { return(stdin); } else if (strcmp(logicalName,WTRACE) == 0) { return(stdout); } else if (strcmp(logicalName,WDIALOG) == 0) { return(stdout); } else if (strcmp(logicalName,WPROMPT) == 0) { return(stdout); } else if (strcmp(logicalName,WDISPLAY) == 0) { return(stdout); } else if (strcmp(logicalName,WERROR) == 0) { return(stdout); } else if (strcmp(logicalName,WWARNING) == 0) { return(stdout); } /*==============================================================*/ /* Otherwise, look up the logical name on the global file list. */ /*==============================================================*/ fptr = FileRouterData(theEnv)->ListOfFileRouters; while ((fptr != NULL) ? (strcmp(logicalName,fptr->logicalName) != 0) : FALSE) { fptr = fptr->next; } if (fptr != NULL) return(fptr->stream); return(NULL); } /*****************************************************/ /* FindFile: Find routine for file router logical */ /* names. Returns TRUE if the specified logical */ /* name has an associated file stream (which means */ /* that the logical name can be handled by the */ /* file router). Otherwise, FALSE is returned. */ /*****************************************************/ globle int FindFile( void *theEnv, char *logicalName) { if (FindFptr(theEnv,logicalName) != NULL) return(TRUE); return(FALSE); } /********************************************/ /* ExitFile: Exit routine for file router. */ /********************************************/ #if IBM_TBC #pragma argsused #endif static int ExitFile( void *theEnv, int num) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(num) #endif #if BASIC_IO CloseAllFiles(theEnv); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif return(1); } /*********************************************/ /* PrintFile: Print routine for file router. */ /*********************************************/ static int PrintFile( void *theEnv, char *logicalName, char *str) { FILE *fptr; fptr = FindFptr(theEnv,logicalName); fprintf(fptr,"%s",str); fflush(fptr); return(1); } /*******************************************/ /* GetcFile: Getc routine for file router. */ /*******************************************/ static int GetcFile( void *theEnv, char *logicalName) { FILE *fptr; int theChar; fptr = FindFptr(theEnv,logicalName); theChar = getc(fptr); /*=================================================*/ /* The following code prevents Control-D on UNIX */ /* machines from terminating all input from stdin. */ /*=================================================*/ if ((fptr == stdin) && (theChar == EOF)) clearerr(stdin); return(theChar); } /***********************************************/ /* UngetcFile: Ungetc routine for file router. */ /***********************************************/ static int UngetcFile( void *theEnv, int ch, char *logicalName) { FILE *fptr; fptr = FindFptr(theEnv,logicalName); return(ungetc(ch,fptr)); } /*********************************************************/ /* OpenFile: Opens a file with the specified access mode */ /* and stores the opened stream on the list of files */ /* associated with logical names Returns TRUE if the */ /* file was succesfully opened, otherwise FALSE. */ /*********************************************************/ globle int OpenAFile( void *theEnv, char *fileName, char *accessMode, char *logicalName) { FILE *newstream; struct fileRouter *newRouter; /*==================================*/ /* Make sure the file can be opened */ /* with the specified access mode. */ /*==================================*/ if ((newstream = GenOpen(theEnv,fileName,accessMode)) == NULL) { return(FALSE); } /*===========================*/ /* Create a new file router. */ /*===========================*/ newRouter = get_struct(theEnv,fileRouter); newRouter->logicalName = (char *) gm2(theEnv,strlen(logicalName) + 1); strcpy(newRouter->logicalName,logicalName); newRouter->stream = newstream; /*==========================================*/ /* Add the newly opened file to the list of */ /* files associated with logical names. */ /*==========================================*/ newRouter->next = FileRouterData(theEnv)->ListOfFileRouters; FileRouterData(theEnv)->ListOfFileRouters = newRouter; /*==================================*/ /* Return TRUE to indicate the file */ /* was opened successfully. */ /*==================================*/ return(TRUE); } /*************************************************************/ /* CloseFile: Closes the file associated with the specified */ /* logical name. Returns TRUE if the file was successfully */ /* closed, otherwise FALSE. */ /*************************************************************/ globle int CloseFile( void *theEnv, char *fid) { struct fileRouter *fptr, *prev; for (fptr = FileRouterData(theEnv)->ListOfFileRouters, prev = NULL; fptr != NULL; fptr = fptr->next) { if (strcmp(fptr->logicalName,fid) == 0) { GenClose(theEnv,fptr->stream); rm(theEnv,fptr->logicalName,strlen(fptr->logicalName) + 1); if (prev == NULL) { FileRouterData(theEnv)->ListOfFileRouters = fptr->next; } else { prev->next = fptr->next; } rm(theEnv,fptr,(int) sizeof(struct fileRouter)); return(TRUE); } prev = fptr; } return(FALSE); } /**********************************************/ /* CloseAllFiles: Closes all files associated */ /* with a file I/O router. Returns TRUE if */ /* any file was closed, otherwise FALSE. */ /**********************************************/ globle int CloseAllFiles( void *theEnv) { struct fileRouter *fptr, *prev; if (FileRouterData(theEnv)->ListOfFileRouters == NULL) return(FALSE); fptr = FileRouterData(theEnv)->ListOfFileRouters; while (fptr != NULL) { GenClose(theEnv,fptr->stream); prev = fptr; rm(theEnv,fptr->logicalName,strlen(fptr->logicalName) + 1); fptr = fptr->next; rm(theEnv,prev,(int) sizeof(struct fileRouter)); } FileRouterData(theEnv)->ListOfFileRouters = NULL; return(TRUE); } clips-6.24/clipssrc/._insmngr.h0000400000175000017500000000075410441147557014576 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0z0z9TTFS FMWBBMPSRclips-6.24/clipssrc/._factqpsr.c0000400000175000017500000000075410441143423014723 0ustar jfsjfsMac OS X  2 RTEXTCWIETTFH Monaco0c0c1C,,TTFS FMWBBMPSRclips-6.24/clipssrc/._factcmp.c0000400000175000017500000000012207422634722014516 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._clips.h0000400000175000017500000000075410441160271014217 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0t0t=WTTF/B~FMPSRMWBBLclips-6.24/clipssrc/objbin.h0000755000175000017500000000427007422634572014164 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_objbin #define _H_objbin #ifndef _H_object #include "object.h" #endif #define OBJECTBIN_DATA 33 struct objectBinaryData { DEFCLASS *DefclassArray; long ModuleCount; long ClassCount; long LinkCount; long SlotCount; long SlotNameCount; long TemplateSlotCount; long SlotNameMapCount; long HandlerCount; DEFCLASS_MODULE *ModuleArray; DEFCLASS **LinkArray; SLOT_DESC *SlotArray; SLOT_DESC **TmpslotArray; SLOT_NAME *SlotNameArray; unsigned *MapslotArray; HANDLER *HandlerArray; unsigned *MaphandlerArray; }; #define ObjectBinaryData(theEnv) ((struct objectBinaryData *) GetEnvironmentData(theEnv,OBJECTBIN_DATA)) #define DefclassPointer(i) (((i) == -1L) ? NULL : (DEFCLASS *) &ObjectBinaryData(theEnv)->DefclassArray[i]) #define DefclassIndex(cls) (((cls) == NULL) ? -1 : ((struct constructHeader *) cls)->bsaveID) #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectsBload(void *); LOCALE void *BloadDefclassModuleReference(void *,int); #endif clips-6.24/clipssrc/factqpsr.h0000644000175000017500000000323710171555005014527 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.23 01/31/05 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* 6.23: Added fact-set queries. */ /* */ /*************************************************************/ #ifndef _H_factqpsr #define _H_factqpsr #if FACT_SET_QUERIES && (! RUN_TIME) #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTQPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE EXPRESSION *FactParseQueryNoAction(void *,EXPRESSION *,char *); LOCALE EXPRESSION *FactParseQueryAction(void *,EXPRESSION *,char *); #ifndef _FACTQPSR_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/rulebin.h0000755000175000017500000000733007422634661014360 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFRULE BSAVE/BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #if (! RUN_TIME) #ifndef _H_rulebin #define _H_rulebin #include "modulbin.h" #include "cstrcbin.h" #ifndef _H_network #include "network.h" #endif struct bsaveDefrule { struct bsaveConstructHeader header; int salience; int localVarCnt; unsigned int complexity : 12; unsigned int autoFocus : 1; long dynamicSalience; long actions; long logicalJoin; long lastJoin; long disjunct; }; struct bsavePatternNodeHeader { long entryJoin; unsigned int singlefieldNode : 1; unsigned int multifieldNode : 1; unsigned int stopNode : 1; unsigned int blocked : 1; unsigned int initialize : 1; unsigned int marked : 1; unsigned int beginSlot : 1; unsigned int endSlot : 1; }; struct bsaveDefruleModule { struct bsaveDefmoduleItemHeader header; }; struct bsaveJoinNode { unsigned int firstJoin : 1; unsigned int logicalJoin : 1; unsigned int joinFromTheRight : 1; unsigned int patternIsNegated : 1; unsigned int rhsType : 3; unsigned int depth : 7; long networkTest; long rightSideEntryStructure; long nextLevel; long lastLevel; long rightDriveNode; long rightMatchNode; long ruleToActivate; }; #define RULEBIN_DATA 20 struct defruleBinaryData { long NumberOfDefruleModules; long NumberOfDefrules; long NumberOfJoins; struct defruleModule *ModuleArray; struct defrule *DefruleArray; struct joinNode *JoinArray; }; #define DefruleBinaryData(theEnv) ((struct defruleBinaryData *) GetEnvironmentData(theEnv,RULEBIN_DATA)) #define BloadDefrulePointer(x,i) ((struct defrule *) (( i == -1L) ? NULL : &x[i])) #define BsaveJoinIndex(joinPtr) ((joinPtr == NULL) ? -1L : ((struct joinNode *) joinPtr)->bsaveID) #define BloadJoinPointer(i) ((struct joinNode *) ((i == -1L) ? NULL : &DefruleBinaryData(theEnv)->JoinArray[i])) #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void DefruleBinarySetup(void *); LOCALE void UpdatePatternNodeHeader(void *,struct patternNodeHeader *, struct bsavePatternNodeHeader *); LOCALE void AssignBsavePatternHeaderValues(struct bsavePatternNodeHeader *, struct patternNodeHeader *); LOCALE void *BloadDefruleModuleReference(void *,int); #endif #endif clips-6.24/clipssrc/inspsr.h0000755000175000017500000000307407422634725014240 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_inspsr #define _H_inspsr #ifndef _H_expressn #include "expressn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ! RUN_TIME LOCALE EXPRESSION *ParseInitializeInstance(void *,EXPRESSION *,char *); LOCALE EXPRESSION *ParseSlotOverrides(void *,char *,int *); #endif LOCALE EXPRESSION *ParseSimpleInstance(void *,EXPRESSION *,char *); #ifndef _INSCOM_SOURCE_ #endif #endif clips-6.24/clipssrc/globldef.c0000755000175000017500000007302410441602221014452 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFGLOBAL MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for the creation and */ /* maintenance of the defglobal construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove run-time program */ /* compiler warning. */ /* */ /*************************************************************/ #define _GLOBLDEF_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "modulpsr.h" #include "multifld.h" #include "router.h" #include "strngrtr.h" #include "modulutl.h" #include "globlbsc.h" #include "globlpsr.h" #include "globlcom.h" #include "utility.h" #include "commline.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #include "globlbin.h" #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "globlcmp.h" #endif #include "globldef.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void *AllocateModule(void *); static void ReturnModule(void *,void *); static void ReturnDefglobal(void *,void *); static void InitializeDefglobalModules(void *); static intBool GetDefglobalValue2(void *,void *,DATA_OBJECT_PTR); static void IncrementDefglobalBusyCount(void *,void *); static void DecrementDefglobalBusyCount(void *,void *); static void DeallocateDefglobalData(void *); static void DestroyDefglobalAction(void *,struct constructHeader *,void *); static void DestroyDefglobal(void *,void *); /**************************************************************/ /* InitializeDefglobals: Initializes the defglobal construct. */ /**************************************************************/ globle void InitializeDefglobals( void *theEnv) { struct entityRecord globalInfo = { "GBL_VARIABLE", GBL_VARIABLE,0,0,0, NULL, NULL, NULL, GetDefglobalValue2, NULL,NULL, NULL,NULL,NULL }; struct entityRecord defglobalPtrRecord = { "DEFGLOBAL_PTR", DEFGLOBAL_PTR,0,0,0, NULL,NULL,NULL, QGetDefglobalValue, NULL, DecrementDefglobalBusyCount, IncrementDefglobalBusyCount, NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFGLOBAL_DATA,sizeof(struct defglobalData),DeallocateDefglobalData); memcpy(&DefglobalData(theEnv)->GlobalInfo,&globalInfo,sizeof(struct entityRecord)); memcpy(&DefglobalData(theEnv)->DefglobalPtrRecord,&defglobalPtrRecord,sizeof(struct entityRecord)); DefglobalData(theEnv)->ResetGlobals = TRUE; DefglobalData(theEnv)->LastModuleIndex = -1; InstallPrimitive(theEnv,&DefglobalData(theEnv)->GlobalInfo,GBL_VARIABLE); InstallPrimitive(theEnv,&DefglobalData(theEnv)->DefglobalPtrRecord,DEFGLOBAL_PTR); InitializeDefglobalModules(theEnv); DefglobalBasicCommands(theEnv); DefglobalCommandDefinitions(theEnv); DefglobalData(theEnv)->DefglobalConstruct = AddConstruct(theEnv,"defglobal","defglobals",ParseDefglobal,EnvFindDefglobal, GetConstructNamePointer,GetConstructPPForm, GetConstructModuleItem,EnvGetNextDefglobal,SetNextConstruct, EnvIsDefglobalDeletable,EnvUndefglobal,ReturnDefglobal); } /****************************************************/ /* DeallocateDefglobalData: Deallocates environment */ /* data for the defglobal construct. */ /****************************************************/ static void DeallocateDefglobalData( void *theEnv) { #if ! RUN_TIME struct defglobalModule *theModuleItem; void *theModule; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif DoForAllConstructs(theEnv,DestroyDefglobalAction,DefglobalData(theEnv)->DefglobalModuleIndex,FALSE,NULL); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { theModuleItem = (struct defglobalModule *) GetModuleItem(theEnv,(struct defmodule *) theModule, DefglobalData(theEnv)->DefglobalModuleIndex); rtn_struct(theEnv,defglobalModule,theModuleItem); } #else DoForAllConstructs(theEnv,DestroyDefglobalAction,DefglobalData(theEnv)->DefglobalModuleIndex,FALSE,NULL); #endif } /***************************************************/ /* DestroyDefglobalAction: Action used to remove */ /* defglobals as a result of DestroyEnvironment. */ /***************************************************/ #if IBM_TBC #pragma argsused #endif static void DestroyDefglobalAction( void *theEnv, struct constructHeader *theConstruct, void *buffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buffer) #endif #if (! BLOAD_ONLY) struct defglobal *theDefglobal = (struct defglobal *) theConstruct; if (theDefglobal == NULL) return; DestroyDefglobal(theEnv,theDefglobal); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv,theConstruct) #endif #endif } /*********************************************************/ /* InitializeDefglobalModules: Initializes the defglobal */ /* construct for use with the defmodule construct. */ /*********************************************************/ static void InitializeDefglobalModules( void *theEnv) { DefglobalData(theEnv)->DefglobalModuleIndex = RegisterModuleItem(theEnv,"defglobal", AllocateModule, ReturnModule, #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY BloadDefglobalModuleReference, #else NULL, #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) DefglobalCModuleReference, #else NULL, #endif EnvFindDefglobal); #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT AddPortConstructItem(theEnv,"defglobal",SYMBOL); #endif } /*************************************************/ /* AllocateModule: Allocates a defglobal module. */ /*************************************************/ static void *AllocateModule( void *theEnv) { return((void *) get_struct(theEnv,defglobalModule)); } /***********************************************/ /* ReturnModule: Deallocates a defglobal module. */ /***********************************************/ static void ReturnModule( void *theEnv, void *theItem) { FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefglobalData(theEnv)->DefglobalConstruct); rtn_struct(theEnv,defglobalModule,theItem); } /**************************************************************/ /* GetDefglobalModuleItem: Returns a pointer to the defmodule */ /* item for the specified defglobal or defmodule. */ /**************************************************************/ globle struct defglobalModule *GetDefglobalModuleItem( void *theEnv, struct defmodule *theModule) { return((struct defglobalModule *) GetConstructModuleItemByIndex(theEnv,theModule,DefglobalData(theEnv)->DefglobalModuleIndex)); } /*****************************************************/ /* EnvFindDefglobal: Searches for a defglobal in the */ /* list of defglobals. Returns a pointer to the */ /* defglobal if found, otherwise NULL. */ /*****************************************************/ globle void *EnvFindDefglobal( void *theEnv, char *defglobalName) { return(FindNamedConstruct(theEnv,defglobalName,DefglobalData(theEnv)->DefglobalConstruct)); } /********************************************************************/ /* EnvGetNextDefglobal: If passed a NULL pointer, returns the first */ /* defglobal in the defglobal list. Otherwise returns the next */ /* defglobal following the defglobal passed as an argument. */ /********************************************************************/ globle void *EnvGetNextDefglobal( void *theEnv, void *defglobalPtr) { return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) defglobalPtr,DefglobalData(theEnv)->DefglobalModuleIndex)); } /*********************************************************/ /* EnvIsDefglobalDeletable: Returns TRUE if a particular */ /* defglobal can be deleted, otherwise returns FALSE. */ /*********************************************************/ globle intBool EnvIsDefglobalDeletable( void *theEnv, void *ptr) { if (! ConstructsDeletable(theEnv)) { return FALSE; } if (((struct defglobal *) ptr)->busyCount) return(FALSE); return(TRUE); } /************************************************************/ /* ReturnDefglobal: Returns the data structures associated */ /* with a defglobal construct to the pool of free memory. */ /************************************************************/ static void ReturnDefglobal( void *theEnv, void *vTheDefglobal) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,vTheDefglobal) #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct defglobal *theDefglobal = (struct defglobal *) vTheDefglobal; if (theDefglobal == NULL) return; /*====================================*/ /* Return the global's current value. */ /*====================================*/ ValueDeinstall(theEnv,&theDefglobal->current); if (theDefglobal->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theDefglobal->current.value); } /*================================================*/ /* Return the expression representing the initial */ /* value of the defglobal when it was defined. */ /*================================================*/ RemoveHashedExpression(theEnv,theDefglobal->initial); /*===============================*/ /* Release items stored in the */ /* defglobal's construct header. */ /*===============================*/ DeinstallConstructHeader(theEnv,&theDefglobal->header); /*======================================*/ /* Return the defglobal data structure. */ /*======================================*/ rtn_struct(theEnv,defglobal,theDefglobal); /*===========================================*/ /* Set the variable indicating that a change */ /* has been made to a global variable. */ /*===========================================*/ DefglobalData(theEnv)->ChangeToGlobals = TRUE; #endif } /************************************************************/ /* DestroyDefglobal: Returns the data structures associated */ /* with a defglobal construct to the pool of free memory. */ /************************************************************/ static void DestroyDefglobal( void *theEnv, void *vTheDefglobal) { #if (MAC_MCW || IBM_MCW) && BLOAD_ONLY #pragma unused(theEnv,vTheDefglobal) #endif #if (! BLOAD_ONLY) struct defglobal *theDefglobal = (struct defglobal *) vTheDefglobal; if (theDefglobal == NULL) return; /*====================================*/ /* Return the global's current value. */ /*====================================*/ if (theDefglobal->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theDefglobal->current.value); } #if (! RUN_TIME) /*===============================*/ /* Release items stored in the */ /* defglobal's construct header. */ /*===============================*/ DeinstallConstructHeader(theEnv,&theDefglobal->header); /*======================================*/ /* Return the defglobal data structure. */ /*======================================*/ rtn_struct(theEnv,defglobal,theDefglobal); #endif #endif } /************************************************/ /* QSetDefglobalValue: Lowest level routine for */ /* setting a defglobal's value. */ /************************************************/ globle void QSetDefglobalValue( void *theEnv, struct defglobal *theGlobal, DATA_OBJECT_PTR vPtr, int resetVar) { /*====================================================*/ /* If the new value passed for the defglobal is NULL, */ /* then reset the defglobal to the initial value it */ /* had when it was defined. */ /*====================================================*/ if (resetVar) { EvaluateExpression(theEnv,theGlobal->initial,vPtr); if (EvaluationData(theEnv)->EvaluationError) { vPtr->type = SYMBOL; vPtr->value = EnvFalseSymbol(theEnv); } } /*==========================================*/ /* If globals are being watch, then display */ /* the change to the global variable. */ /*==========================================*/ #if DEBUGGING_FUNCTIONS if (theGlobal->watch) { EnvPrintRouter(theEnv,WTRACE,":== ?*"); EnvPrintRouter(theEnv,WTRACE,ValueToString(theGlobal->header.name)); EnvPrintRouter(theEnv,WTRACE,"* ==> "); PrintDataObject(theEnv,WTRACE,vPtr); EnvPrintRouter(theEnv,WTRACE," <== "); PrintDataObject(theEnv,WTRACE,&theGlobal->current); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*==============================================*/ /* Remove the old value of the global variable. */ /*==============================================*/ ValueDeinstall(theEnv,&theGlobal->current); if (theGlobal->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) theGlobal->current.value); } /*===========================================*/ /* Set the new value of the global variable. */ /*===========================================*/ theGlobal->current.type = vPtr->type; if (vPtr->type != MULTIFIELD) theGlobal->current.value = vPtr->value; else DuplicateMultifield(theEnv,&theGlobal->current,vPtr); ValueInstall(theEnv,&theGlobal->current); /*===========================================*/ /* Set the variable indicating that a change */ /* has been made to a global variable. */ /*===========================================*/ DefglobalData(theEnv)->ChangeToGlobals = TRUE; if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } } /**************************************************************/ /* QFindDefglobal: Searches for a defglobal in the list of */ /* defglobals. Returns a pointer to the defglobal if found, */ /* otherwise NULL. */ /**************************************************************/ globle struct defglobal *QFindDefglobal( void *theEnv, SYMBOL_HN *defglobalName) { struct defglobal *theDefglobal; for (theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,NULL); theDefglobal != NULL; theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theDefglobal)) { if (defglobalName == theDefglobal->header.name) return (theDefglobal); } return(NULL); } /*********************************************************************/ /* EnvGetDefglobalValueForm: Returns the pretty print representation */ /* of the current value of the specified defglobal. For example, */ /* if the current value of ?*x* is 5, the string "?*x* = 5" would */ /* be returned. */ /*********************************************************************/ globle void EnvGetDefglobalValueForm( void *theEnv, char *buffer, unsigned bufferLength, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; OpenStringDestination(theEnv,"GlobalValueForm",buffer,bufferLength); EnvPrintRouter(theEnv,"GlobalValueForm","?*"); EnvPrintRouter(theEnv,"GlobalValueForm",ValueToString(theGlobal->header.name)); EnvPrintRouter(theEnv,"GlobalValueForm","* = "); PrintDataObject(theEnv,"GlobalValueForm",&theGlobal->current); CloseStringDestination(theEnv,"GlobalValueForm"); } /************************************************************/ /* EnvGetGlobalsChanged: Returns the defglobal change flag. */ /************************************************************/ globle int EnvGetGlobalsChanged( void *theEnv) { return(DefglobalData(theEnv)->ChangeToGlobals); } /*********************************************************/ /* EnvSetGlobalsChanged: Sets the defglobal change flag. */ /*********************************************************/ globle void EnvSetGlobalsChanged( void *theEnv, int value) { DefglobalData(theEnv)->ChangeToGlobals = value; } /**********************************************************/ /* GetDefglobalValue2: Returns the value of the specified */ /* global variable in the supplied DATA_OBJECT. */ /**********************************************************/ static intBool GetDefglobalValue2( void *theEnv, void *theValue, DATA_OBJECT_PTR vPtr) { struct defglobal *theGlobal; int count; /*===========================================*/ /* Search for the specified defglobal in the */ /* modules visible to the current module. */ /*===========================================*/ theGlobal = (struct defglobal *) FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(theValue), &count,TRUE,NULL); /*=============================================*/ /* If it wasn't found, print an error message. */ /*=============================================*/ if (theGlobal == NULL) { PrintErrorID(theEnv,"GLOBLDEF",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Global variable ?*"); EnvPrintRouter(theEnv,WERROR,ValueToString(theValue)); EnvPrintRouter(theEnv,WERROR,"* is unbound.\n"); vPtr->type = SYMBOL; vPtr->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*========================================================*/ /* The current implementation of the defmodules shouldn't */ /* allow a construct to be defined which would cause an */ /* ambiguous reference, but we'll check for it anyway. */ /*========================================================*/ if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"defglobal",ValueToString(theValue)); vPtr->type = SYMBOL; vPtr->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*=================================*/ /* Get the value of the defglobal. */ /*=================================*/ QGetDefglobalValue(theEnv,theGlobal,vPtr); return(TRUE); } /***************************************************************/ /* QGetDefglobalValue: Returns the value of a global variable. */ /***************************************************************/ globle int QGetDefglobalValue( void *theEnv, void *vTheGlobal, DATA_OBJECT_PTR vPtr) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; /*===============================================*/ /* Transfer values which can be copied directly. */ /*===============================================*/ vPtr->type = theGlobal->current.type; vPtr->value = theGlobal->current.value; vPtr->begin = theGlobal->current.begin; vPtr->end = theGlobal->current.end; /*===========================================================*/ /* If the global contains a multifield value, return a copy */ /* of the value so that routines which use this value are */ /* not affected if the value of the global is later changed. */ /*===========================================================*/ if (vPtr->type == MULTIFIELD) { vPtr->value = EnvCreateMultifield(theEnv,(unsigned long) (vPtr->end + 1)); GenCopyMemory(struct field,vPtr->end + 1, &((struct multifield *) vPtr->value)->theFields[0], &((struct multifield *) theGlobal->current.value)->theFields[theGlobal->current.begin]); } return(TRUE); } /************************************************************/ /* EnvGetDefglobalValue: Returns the value of the specified */ /* global variable in the supplied DATA_OBJECT. */ /************************************************************/ globle intBool EnvGetDefglobalValue( void *theEnv, char *variableName, DATA_OBJECT_PTR vPtr) { struct defglobal *theDefglobal; if ((theDefglobal = (struct defglobal *) EnvFindDefglobal(theEnv,variableName)) == NULL) { return(FALSE); } QGetDefglobalValue(theEnv,theDefglobal,vPtr); return(TRUE); } /****************************************************************/ /* EnvSetDefglobalValue: Sets the value of the specified global */ /* variable to the value stored in the supplied DATA_OBJECT. */ /****************************************************************/ globle intBool EnvSetDefglobalValue( void *theEnv, char *variableName, DATA_OBJECT_PTR vPtr) { struct defglobal *theGlobal; if ((theGlobal = QFindDefglobal(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,variableName))) == NULL) { return(FALSE); } QSetDefglobalValue(theEnv,theGlobal,vPtr,FALSE); return(TRUE); } /**********************************************************/ /* DecrementDefglobalBusyCount: Decrements the busy count */ /* of a defglobal data structure. */ /**********************************************************/ static void DecrementDefglobalBusyCount( void *theEnv, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; if (! ConstructData(theEnv)->ClearInProgress) theGlobal->busyCount--; } /**********************************************************/ /* IncrementDefglobalBusyCount: Increments the busy count */ /* of a defglobal data structure. */ /**********************************************************/ #if IBM_TBC #pragma argsused #endif static void IncrementDefglobalBusyCount( void *theEnv, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif theGlobal->busyCount++; } /***********************************************************************/ /* UpdateDefglobalScope: Updates the scope flag of all the defglobals. */ /***********************************************************************/ globle void UpdateDefglobalScope( void *theEnv) { struct defglobal *theDefglobal; int moduleCount; struct defmodule *theModule; struct defmoduleItemHeader *theItem; /*============================*/ /* Loop through every module. */ /*============================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*============================================================*/ /* Loop through every defglobal in the module being examined. */ /*============================================================*/ theItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,DefglobalData(theEnv)->DefglobalModuleIndex); for (theDefglobal = (struct defglobal *) theItem->firstItem; theDefglobal != NULL ; theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theDefglobal)) { /*====================================================*/ /* If the defglobal is visible to the current module, */ /* then mark it as being in scope, otherwise mark it */ /* as being out of scope. */ /*====================================================*/ if (FindImportedConstruct(theEnv,"defglobal",theModule, ValueToString(theDefglobal->header.name), &moduleCount,TRUE,NULL) != NULL) { theDefglobal->inScope = TRUE; } else { theDefglobal->inScope = FALSE; } } } } /*******************************************************/ /* GetNextDefglobalInScope: Returns the next defglobal */ /* that is scope of the current module. Works in a */ /* similar fashion to GetNextDefglobal, but skips */ /* defglobals that are out of scope. */ /*******************************************************/ globle void *GetNextDefglobalInScope( void *theEnv, void *vTheGlobal) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; struct defmoduleItemHeader *theItem; /*=======================================*/ /* If we're beginning the search for the */ /* first defglobal in scope, then ... */ /*=======================================*/ if (theGlobal == NULL) { /*==============================================*/ /* If the current module has been changed since */ /* the last time the scopes were computed, then */ /* recompute the scopes. */ /*==============================================*/ if (DefglobalData(theEnv)->LastModuleIndex != DefmoduleData(theEnv)->ModuleChangeIndex) { UpdateDefglobalScope(theEnv); DefglobalData(theEnv)->LastModuleIndex = DefmoduleData(theEnv)->ModuleChangeIndex; } /*==========================================*/ /* Get the first module and first defglobal */ /* to start the search with. */ /*==========================================*/ DefglobalData(theEnv)->TheDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,DefglobalData(theEnv)->TheDefmodule,DefglobalData(theEnv)->DefglobalModuleIndex); theGlobal = (struct defglobal *) theItem->firstItem; } /*==================================================*/ /* Otherwise, see if the last defglobal returned by */ /* this function has a defglobal following it. */ /*==================================================*/ else { theGlobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theGlobal); } /*======================================*/ /* Continue looping through the modules */ /* until a defglobal in scope is found. */ /*======================================*/ while (DefglobalData(theEnv)->TheDefmodule != NULL) { /*=====================================================*/ /* Loop through the defglobals in the module currently */ /* being examined to see if one is in scope. */ /*=====================================================*/ for (; theGlobal != NULL; theGlobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theGlobal)) { if (theGlobal->inScope) return((void *) theGlobal); } /*================================================*/ /* If a global in scope couldn't be found in this */ /* module, then move on to the next module. */ /*================================================*/ DefglobalData(theEnv)->TheDefmodule = (struct defmodule *) EnvGetNextDefmodule(theEnv,DefglobalData(theEnv)->TheDefmodule); theItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,DefglobalData(theEnv)->TheDefmodule,DefglobalData(theEnv)->DefglobalModuleIndex); theGlobal = (struct defglobal *) theItem->firstItem; } /*====================================*/ /* All the globals in scope have been */ /* traversed and there are none left. */ /*====================================*/ return(NULL); } #endif /* DEFGLOBAL_CONSTRUCT */ clips-6.24/clipssrc/._globlbsc.c0000400000175000017500000000075410441143603014667 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0c0c1llTTFS FMWBBMPSRclips-6.24/clipssrc/._dffnxexe.c0000400000175000017500000000075410170037501014705 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco..a((TTF~$rFMPSRMWBBLclips-6.24/clipssrc/._strngfun.h0000400000175000017500000000075410357047750014767 0ustar jfsjfsMac OS X  2 RTEXT????`aTTFH Monaco* * # RTTF{HFMPSRMWBBLclips-6.24/clipssrc/._agenda.h0000400000175000017500000000075410441602024014321 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH MonacoB phB phnDTTFH$DFMWBBMPSRclips-6.24/clipssrc/._objrtcmp.c0000400000175000017500000000075410441131113014711 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z{vvTTFS FMWBBMPSRclips-6.24/clipssrc/modulutl.h0000755000175000017500000000576607422634655014603 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFMODULE UTILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for parsing module/construct */ /* names and searching through modules for specific */ /* constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_modulutl #define _H_modulutl #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _MODULUTL_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE unsigned FindModuleSeparator(char *); LOCALE SYMBOL_HN *ExtractModuleName(void *,unsigned,char *); LOCALE SYMBOL_HN *ExtractConstructName(void *,unsigned,char *); LOCALE char *ExtractModuleAndConstructName(void *,char *); LOCALE void *FindImportedConstruct(void *,char *,struct defmodule *, char *,int *,int,struct defmodule *); LOCALE void AmbiguousReferenceErrorMessage(void *,char *,char *); LOCALE void MarkModulesAsUnvisited(void *); LOCALE void ListItemsDriver(void *, char *,struct defmodule *, char *,char *, void *(*)(void *,void *), char *(*)(void *), void (*)(void *,char *,void *), int (*)(void *,void *)); LOCALE long DoForAllModules(void *, void (*)(struct defmodule *,void *), int,void *); #endif clips-6.24/clipssrc/cstrncmp.c0000755000175000017500000001712210441602121014521 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for */ /* constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /* Added environment parameter to GenClose. */ /* */ /*************************************************************/ #define _CSTRNCMP_SOURCE_ #include "setup.h" #if CONSTRUCT_COMPILER && (! RUN_TIME) #include "constant.h" #include "conscomp.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "sysdep.h" #include "cstrncmp.h" /***********************************************/ /* ConstraintsToCode: Produces the constraint */ /* record code for a run-time module created */ /* using the constructs-to-c function. */ /***********************************************/ globle int ConstraintsToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int i, j, count; int newHeader = TRUE; FILE *fp; int version = 1; int arrayVersion = 1; unsigned short numberOfConstraints = 0; CONSTRAINT_RECORD *tmpPtr; /*===============================================*/ /* Count the total number of constraint records. */ /*===============================================*/ for (i = 0 ; i < SIZE_CONSTRAINT_HASH; i++) { for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { tmpPtr->bsaveIndex = numberOfConstraints++; } } /*=====================================================*/ /* If dynamic constraint checking is disabled, then */ /* contraints won't be saved. If there are constraints */ /* which could be saved, then issue a warning message. */ /*=====================================================*/ if ((! EnvGetDynamicConstraintChecking(theEnv)) && (numberOfConstraints != 0)) { numberOfConstraints = 0; PrintWarningID(theEnv,"CSTRNCMP",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Constraints are not saved with a constructs-to-c image\n"); EnvPrintRouter(theEnv,WWARNING," when dynamic constraint checking is disabled.\n"); } if (numberOfConstraints == 0) return(-1); /*=================================================*/ /* Print the extern definition in the header file. */ /*=================================================*/ for (i = 1; i <= (numberOfConstraints / maxIndices) + 1 ; i++) { fprintf(headerFP,"extern CONSTRAINT_RECORD C%d_%d[];\n",imageID,i); } /*==================*/ /* Create the file. */ /*==================*/ if ((fp = NewCFile(theEnv,fileName,fileID,version,FALSE)) == NULL) return(-1); /*===================*/ /* List the entries. */ /*===================*/ j = 0; count = 0; for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) { for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i]; tmpPtr != NULL; tmpPtr = tmpPtr->next) { if (newHeader) { fprintf(fp,"CONSTRAINT_RECORD C%d_%d[] = {\n",imageID,arrayVersion); newHeader = FALSE; } fprintf(fp,"{%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d", tmpPtr->anyAllowed, tmpPtr->symbolsAllowed, tmpPtr->stringsAllowed, tmpPtr->floatsAllowed, tmpPtr->integersAllowed, tmpPtr->instanceNamesAllowed, tmpPtr->instanceAddressesAllowed, tmpPtr->externalAddressesAllowed, tmpPtr->factAddressesAllowed, 0, /* void allowed */ tmpPtr->anyRestriction, tmpPtr->symbolRestriction, tmpPtr->stringRestriction, tmpPtr->floatRestriction, tmpPtr->integerRestriction, tmpPtr->classRestriction, tmpPtr->instanceNameRestriction, tmpPtr->multifieldsAllowed, tmpPtr->singlefieldsAllowed); fprintf(fp,",0,"); /* bsaveIndex */ PrintHashedExpressionReference(theEnv,fp,tmpPtr->classList,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->restrictionList,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->minValue,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->maxValue,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->minFields,imageID,maxIndices); fprintf(fp,","); PrintHashedExpressionReference(theEnv,fp,tmpPtr->maxFields,imageID,maxIndices); /* multifield slot */ fprintf(fp,",NULL"); /* next slot */ if (tmpPtr->next == NULL) { fprintf(fp,",NULL,"); } else { if ((j + 1) >= maxIndices) { fprintf(fp,",&C%d_%d[%d],",imageID,arrayVersion + 1,0); } else { fprintf(fp,",&C%d_%d[%d],",imageID,arrayVersion,j + 1); } } fprintf(fp,"%d,%d",tmpPtr->bucket,tmpPtr->count + 1); count++; j++; if ((count == numberOfConstraints) || (j >= maxIndices)) { fprintf(fp,"}};\n"); GenClose(theEnv,fp); j = 0; version++; arrayVersion++; if (count < numberOfConstraints) { if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(0); newHeader = TRUE; } } else { fprintf(fp,"},\n"); } } } return(version); } /**********************************************************/ /* PrintConstraintReference: Prints C code representation */ /* of a constraint record data structure reference. */ /**********************************************************/ globle void PrintConstraintReference( void *theEnv, FILE *fp, CONSTRAINT_RECORD *cPtr, int imageID, int maxIndices) { if ((cPtr == NULL) || (! EnvGetDynamicConstraintChecking(theEnv))) { fprintf(fp,"NULL"); } else fprintf(fp,"&C%d_%d[%d]",imageID, (int) (cPtr->bsaveIndex / maxIndices) + 1, (int) cPtr->bsaveIndex % maxIndices); } #endif /* CONSTRUCT_COMPILER && (! RUN_TIME) */ clips-6.24/clipssrc/rulebld.h0000755000175000017500000000351107422634552014345 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* RULE BUILD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines to ntegrates a set of pattern */ /* and join tests associated with a rule into the pattern */ /* and join networks. The joins are integrated into the */ /* join network by routines in this module. The pattern */ /* is integrated by calling the external routine */ /* associated with the pattern parser that originally */ /* parsed the pattern. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_rulebld #define _H_rulebld #ifndef _H_reorder #include "reorder.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _RULEBLD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct joinNode *ConstructJoins(void *,int,struct lhsParseNode *); #endif clips-6.24/clipssrc/._msgpass.c0000400000175000017500000000075410443377640014571 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco5c5ciTTFLFMWBBMPSRclips-6.24/clipssrc/._scanner.c0000400000175000017500000000075407422634766014555 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH MonacoYYp??TTFTDFMWBBMPSRclips-6.24/clipssrc/factbin.c0000755000175000017500000003645507422634570014332 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* fact pattern network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _FACTBIN_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "tmpltdef.h" #include "bload.h" #include "bsave.h" #include "reteutil.h" #include "rulebin.h" #include "moduldef.h" #include "envrnmnt.h" #include "factbin.h" /********************************************/ /* INTERNAL DATA STRUCTURES AND DEFINITIONS */ /********************************************/ struct bsaveFactPatternNode { struct bsavePatternNodeHeader header; unsigned short whichSlot; unsigned short whichField; unsigned short leaveFields; long networkTest; long nextLevel; long lastLevel; long leftNode; long rightNode; }; #define BSAVE_FIND 0 #define BSAVE_PATTERNS 1 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveDriver(void *,int,FILE *,struct factPatternNode *); static void BsaveFind(void *); static void BsaveStorage(void *,FILE *); static void BsaveFactPatterns(void *,FILE *); static void BsavePatternNode(void *,struct factPatternNode *,FILE *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateFactPatterns(void *,void *,long); static void ClearBload(void *); static void DeallocateFactBloadData(void *); /*****************************************************/ /* FactBinarySetup: Initializes the binary load/save */ /* feature for the fact pattern network. */ /*****************************************************/ globle void FactBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,FACTBIN_DATA,sizeof(struct factBinaryData),DeallocateFactBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"facts",0,BsaveFind,NULL, BsaveStorage,BsaveFactPatterns, BloadStorage,BloadBinaryItem, ClearBload); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"facts",0,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /****************************************************/ /* DeallocateFactBloadData: Deallocates environment */ /* data for the fact bsave functionality. */ /****************************************************/ static void DeallocateFactBloadData( void *theEnv) { unsigned long space; int i; for (i = 0; i < FactBinaryData(theEnv)->NumberOfPatterns; i++) { DestroyAlphaBetaMemory(theEnv,FactBinaryData(theEnv)->FactPatternArray[i].header.alphaMemory); } space = FactBinaryData(theEnv)->NumberOfPatterns * sizeof(struct factPatternNode); if (space != 0) genlongfree(theEnv,(void *) FactBinaryData(theEnv)->FactPatternArray,space); } #if BLOAD_AND_BSAVE /*********************************************************/ /* BsaveFind: Counts the number of data structures which */ /* must be saved in the binary image for the fact */ /* pattern network in the current environment. */ /*********************************************************/ static void BsaveFind( void *theEnv) { struct deftemplate *theDeftemplate; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,FactBinaryData(theEnv)->NumberOfPatterns); /*=======================================*/ /* Set the count of fact pattern network */ /* data structures to zero. */ /*=======================================*/ FactBinaryData(theEnv)->NumberOfPatterns = 0L; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*===============================*/ /* Set the current module to the */ /* module being examined. */ /*===============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*=====================================================*/ /* Loop through each deftemplate in the current module */ /* and count the number of data structures which must */ /* be saved for its pattern network. */ /*=====================================================*/ for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { BsaveDriver(theEnv,BSAVE_FIND,NULL,theDeftemplate->patternNetwork); } } } /**********************************************************/ /* BsaveDriver: Binary save driver routine which handles */ /* both finding/marking the data structures to be saved */ /* and saving the data structures to a file. */ /**********************************************************/ static void BsaveDriver( void *theEnv, int action, FILE *fp, struct factPatternNode *thePattern) { while (thePattern != NULL) { switch(action) { case BSAVE_FIND: thePattern->bsaveID = FactBinaryData(theEnv)->NumberOfPatterns++; break; case BSAVE_PATTERNS: BsavePatternNode(theEnv,thePattern,fp); break; default: break; } if (thePattern->nextLevel == NULL) { while (thePattern->rightNode == NULL) { thePattern = thePattern->lastLevel; if (thePattern == NULL) return; } thePattern = thePattern->rightNode; } else { thePattern = thePattern->nextLevel; } } } /*********************************************************/ /* BsaveStorage: Writes out storage requirements for all */ /* factPatternNode data structures to the binary file */ /*********************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { unsigned long space; space = sizeof(long); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); GenWrite(&FactBinaryData(theEnv)->NumberOfPatterns,(unsigned long) sizeof(long int),fp); } /*****************************************************/ /* BsaveFactPatterns: Writes out all factPatternNode */ /* data structures to the binary file. */ /*****************************************************/ static void BsaveFactPatterns( void *theEnv, FILE *fp) { unsigned long int space; struct deftemplate *theDeftemplate; struct defmodule *theModule; /*========================================*/ /* Write out the amount of space taken up */ /* by the factPatternNode data structures */ /* in the binary image. */ /*========================================*/ space = FactBinaryData(theEnv)->NumberOfPatterns * sizeof(struct bsaveFactPatternNode); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=====================================================*/ /* Loop through each deftemplate in the current module */ /* and save its fact pattern network to the file. */ /*=====================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { BsaveDriver(theEnv,BSAVE_PATTERNS,fp,theDeftemplate->patternNetwork); } } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of factPatternNode data structures in the binary image */ /* (these were overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&FactBinaryData(theEnv)->NumberOfPatterns); } /******************************************************/ /* BsavePatternNode: Writes out a single fact pattern */ /* node to the binary image save file. */ /******************************************************/ static void BsavePatternNode( void *theEnv, struct factPatternNode *thePattern, FILE *fp) { struct bsaveFactPatternNode tempNode; AssignBsavePatternHeaderValues(&tempNode.header,&thePattern->header); tempNode.whichField = thePattern->whichField; tempNode.leaveFields = thePattern->leaveFields; tempNode.whichSlot = thePattern->whichSlot; tempNode.networkTest = HashedExpressionIndex(theEnv,thePattern->networkTest); tempNode.nextLevel = BsaveFactPatternIndex(thePattern->nextLevel); tempNode.lastLevel = BsaveFactPatternIndex(thePattern->lastLevel); tempNode.leftNode = BsaveFactPatternIndex(thePattern->leftNode); tempNode.rightNode = BsaveFactPatternIndex(thePattern->rightNode); GenWrite(&tempNode,(unsigned long) sizeof(struct bsaveFactPatternNode),fp); } #endif /* BLOAD_AND_BSAVE */ /*****************************************************/ /* BloadStorage: Allocates storage requirements for */ /* the factPatternNodes used by this binary image. */ /*****************************************************/ static void BloadStorage( void *theEnv) { unsigned long space; /*=========================================*/ /* Determine the number of factPatternNode */ /* data structures to be read. */ /*=========================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); GenReadBinary(theEnv,&FactBinaryData(theEnv)->NumberOfPatterns,(unsigned long) sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* factPatternNode data structures. */ /*===================================*/ if (FactBinaryData(theEnv)->NumberOfPatterns == 0) { FactBinaryData(theEnv)->FactPatternArray = NULL; return; } space = FactBinaryData(theEnv)->NumberOfPatterns * sizeof(struct factPatternNode); FactBinaryData(theEnv)->FactPatternArray = (struct factPatternNode *) genlongalloc(theEnv,space); } /************************************************************/ /* BloadBinaryItem: Loads and refreshes the factPatternNode */ /* data structures used by this binary image. */ /************************************************************/ static void BloadBinaryItem( void *theEnv) { unsigned long space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); /*=============================================*/ /* Read in the factPatternNode data structures */ /* and refresh the pointers. */ /*=============================================*/ BloadandRefresh(theEnv,FactBinaryData(theEnv)->NumberOfPatterns,(unsigned) sizeof(struct bsaveFactPatternNode), UpdateFactPatterns); } /*************************************************/ /* UpdateFactPatterns: Bload refresh routine for */ /* the factPatternNode structure. */ /*************************************************/ static void UpdateFactPatterns( void *theEnv, void *buf, long obji) { struct bsaveFactPatternNode *bp; bp = (struct bsaveFactPatternNode *) buf; UpdatePatternNodeHeader(theEnv,&FactBinaryData(theEnv)->FactPatternArray[obji].header,&bp->header); FactBinaryData(theEnv)->FactPatternArray[obji].bsaveID = 0L; FactBinaryData(theEnv)->FactPatternArray[obji].whichField = bp->whichField; FactBinaryData(theEnv)->FactPatternArray[obji].leaveFields = bp->leaveFields; FactBinaryData(theEnv)->FactPatternArray[obji].whichSlot = bp->whichSlot; FactBinaryData(theEnv)->FactPatternArray[obji].networkTest = HashedExpressionPointer(bp->networkTest); FactBinaryData(theEnv)->FactPatternArray[obji].rightNode = BloadFactPatternPointer(bp->rightNode); FactBinaryData(theEnv)->FactPatternArray[obji].nextLevel = BloadFactPatternPointer(bp->nextLevel); FactBinaryData(theEnv)->FactPatternArray[obji].lastLevel = BloadFactPatternPointer(bp->lastLevel); FactBinaryData(theEnv)->FactPatternArray[obji].leftNode = BloadFactPatternPointer(bp->leftNode); } /***************************************************/ /* ClearBload: Fact pattern network clear routine */ /* when a binary load is in effect. */ /***************************************************/ static void ClearBload( void *theEnv) { unsigned long int space; space = FactBinaryData(theEnv)->NumberOfPatterns * sizeof(struct factPatternNode); if (space != 0) genlongfree(theEnv,(void *) FactBinaryData(theEnv)->FactPatternArray,space); FactBinaryData(theEnv)->NumberOfPatterns = 0; } #endif /* DEFTEMPLATE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips-6.24/clipssrc/objrtfnx.c0000755000175000017500000013660410441150305014535 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INFERENCE ENGINE OBJECT ACCESS ROUTINES MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: RETE Network Interface for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #include #define _STDIO_INCLUDED_ #include #include "classcom.h" #include "classfun.h" #if DEVELOPER #include "exprnops.h" #endif #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "constant.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "memalloc.h" #include "multifld.h" #include "objrtmch.h" #include "reteutil.h" #include "router.h" #define _OBJRTFNX_SOURCE_ #include "objrtfnx.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ #define GetInsSlot(ins,si) ins->slotAddresses[ins->cls->slotNameMap[si]-1] /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PrintObjectGetVarJN1(void *,char *,void *); static intBool ObjectGetVarJNFunction1(void *,void *,DATA_OBJECT *); static void PrintObjectGetVarJN2(void *,char *,void *); static intBool ObjectGetVarJNFunction2(void *,void *,DATA_OBJECT *); static void PrintObjectGetVarPN1(void *,char *,void *); static intBool ObjectGetVarPNFunction1(void *,void *,DATA_OBJECT *); static void PrintObjectGetVarPN2(void *,char *,void *); static intBool ObjectGetVarPNFunction2(void *,void *,DATA_OBJECT *); static void PrintObjectCmpConstant(void *,char *,void *); static void PrintSlotLengthTest(void *,char *,void *); static intBool SlotLengthTestFunction(void *,void *,DATA_OBJECT *); static void PrintPNSimpleCompareFunction1(void *,char *,void *); static intBool PNSimpleCompareFunction1(void *,void *,DATA_OBJECT *); static void PrintPNSimpleCompareFunction2(void *,char *,void *); static intBool PNSimpleCompareFunction2(void *,void *,DATA_OBJECT *); static void PrintPNSimpleCompareFunction3(void *,char *,void *); static intBool PNSimpleCompareFunction3(void *,void *,DATA_OBJECT *); static void PrintJNSimpleCompareFunction1(void *,char *,void *); static intBool JNSimpleCompareFunction1(void *,void *,DATA_OBJECT *); static void PrintJNSimpleCompareFunction2(void *,char *,void *); static intBool JNSimpleCompareFunction2(void *,void *,DATA_OBJECT *); static void PrintJNSimpleCompareFunction3(void *,char *,void *); static intBool JNSimpleCompareFunction3(void *,void *,DATA_OBJECT *); static void GetPatternObjectAndMarks(void *,int,INSTANCE_TYPE **,struct multifieldMarker **); static void GetObjectValueGeneral(void *,DATA_OBJECT *,INSTANCE_TYPE *, struct multifieldMarker *,struct ObjectMatchVar1 *); static void GetObjectValueSimple(void *,DATA_OBJECT *,INSTANCE_TYPE *,struct ObjectMatchVar2 *); static long CalculateSlotField(struct multifieldMarker *,INSTANCE_SLOT *,long,long *); /* 6.04 Bug Fix */ static void GetInsMultiSlotField(FIELD *,INSTANCE_TYPE *,unsigned,unsigned,unsigned); static void DeallocateObjectReteData(void *); static void DestroyObjectPatternNetwork(void *,OBJECT_PATTERN_NODE *); static void DestroyObjectAlphaNodes(void *,OBJECT_ALPHA_NODE *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : InstallObjectPrimitives DESCRIPTION : Installs all the entity records associated with object pattern matching operations INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Primitive operations installed NOTES : None ***************************************************/ globle void InstallObjectPrimitives( void *theEnv) { struct entityRecord objectGVInfo1 = { "OBJ_GET_SLOT_JNVAR1", OBJ_GET_SLOT_JNVAR1,0,1,0, PrintObjectGetVarJN1, PrintObjectGetVarJN1,NULL, ObjectGetVarJNFunction1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord objectGVInfo2 = { "OBJ_GET_SLOT_JNVAR2", OBJ_GET_SLOT_JNVAR2,0,1,0, PrintObjectGetVarJN2, PrintObjectGetVarJN2,NULL, ObjectGetVarJNFunction2, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord objectGVPNInfo1 = { "OBJ_GET_SLOT_PNVAR1", OBJ_GET_SLOT_PNVAR1,0,1,0, PrintObjectGetVarPN1, PrintObjectGetVarPN1,NULL, ObjectGetVarPNFunction1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord objectGVPNInfo2 = { "OBJ_GET_SLOT_PNVAR2", OBJ_GET_SLOT_PNVAR2,0,1,0, PrintObjectGetVarPN2, PrintObjectGetVarPN2,NULL, ObjectGetVarPNFunction2, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord objectCmpConstantInfo = { "OBJ_PN_CONSTANT", OBJ_PN_CONSTANT,0,1,1, PrintObjectCmpConstant, PrintObjectCmpConstant,NULL, ObjectCmpConstantFunction, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord lengthTestInfo = { "OBJ_SLOT_LENGTH", OBJ_SLOT_LENGTH,0,1,0, PrintSlotLengthTest, PrintSlotLengthTest,NULL, SlotLengthTestFunction, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord pNSimpleCompareInfo1 = { "OBJ_PN_CMP1", OBJ_PN_CMP1,0,1,1, PrintPNSimpleCompareFunction1, PrintPNSimpleCompareFunction1,NULL, PNSimpleCompareFunction1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord pNSimpleCompareInfo2 = { "OBJ_PN_CMP2", OBJ_PN_CMP2,0,1,1, PrintPNSimpleCompareFunction2, PrintPNSimpleCompareFunction2,NULL, PNSimpleCompareFunction2, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord pNSimpleCompareInfo3 = { "OBJ_PN_CMP3", OBJ_PN_CMP3,0,1,1, PrintPNSimpleCompareFunction3, PrintPNSimpleCompareFunction3,NULL, PNSimpleCompareFunction3, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord jNSimpleCompareInfo1 = { "OBJ_JN_CMP1", OBJ_JN_CMP1,0,1,1, PrintJNSimpleCompareFunction1, PrintJNSimpleCompareFunction1,NULL, JNSimpleCompareFunction1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord jNSimpleCompareInfo2 = { "OBJ_JN_CMP2", OBJ_JN_CMP2,0,1,1, PrintJNSimpleCompareFunction2, PrintJNSimpleCompareFunction2,NULL, JNSimpleCompareFunction2, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord jNSimpleCompareInfo3 = { "OBJ_JN_CMP3", OBJ_JN_CMP3,0,1,1, PrintJNSimpleCompareFunction3, PrintJNSimpleCompareFunction3,NULL, JNSimpleCompareFunction3, NULL,NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,OBJECT_RETE_DATA,sizeof(struct objectReteData),DeallocateObjectReteData); ObjectReteData(theEnv)->CurrentObjectSlotLength = 1; memcpy(&ObjectReteData(theEnv)->ObjectGVInfo1,&objectGVInfo1,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->ObjectGVInfo2,&objectGVInfo2,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->ObjectGVPNInfo1,&objectGVPNInfo1,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->ObjectGVPNInfo2,&objectGVPNInfo2,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->ObjectCmpConstantInfo,&objectCmpConstantInfo,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->LengthTestInfo,&lengthTestInfo,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo1,&pNSimpleCompareInfo1,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo2,&pNSimpleCompareInfo2,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo3,&pNSimpleCompareInfo3,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo1,&jNSimpleCompareInfo1,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo2,&jNSimpleCompareInfo2,sizeof(struct entityRecord)); memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo3,&jNSimpleCompareInfo3,sizeof(struct entityRecord)); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVInfo1,OBJ_GET_SLOT_JNVAR1); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVInfo2,OBJ_GET_SLOT_JNVAR2); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVPNInfo1,OBJ_GET_SLOT_PNVAR1); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVPNInfo2,OBJ_GET_SLOT_PNVAR2); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectCmpConstantInfo,OBJ_PN_CONSTANT); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->LengthTestInfo,OBJ_SLOT_LENGTH); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo1,OBJ_PN_CMP1); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo2,OBJ_PN_CMP2); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo3,OBJ_PN_CMP3); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo1,OBJ_JN_CMP1); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo2,OBJ_JN_CMP2); InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo3,OBJ_JN_CMP3); } /*****************************************************/ /* DeallocateObjectReteData: Deallocates environment */ /* data for the object rete network. */ /*****************************************************/ static void DeallocateObjectReteData( void *theEnv) { OBJECT_PATTERN_NODE *theNetwork; #if BLOAD || BLOAD_AND_BSAVE if (Bloaded(theEnv)) return; #endif theNetwork = ObjectReteData(theEnv)->ObjectPatternNetworkPointer; DestroyObjectPatternNetwork(theEnv,theNetwork); } /****************************************************************/ /* DestroyObjectPatternNetwork: Deallocates the data structures */ /* associated with the object pattern network. */ /****************************************************************/ static void DestroyObjectPatternNetwork( void *theEnv, OBJECT_PATTERN_NODE *thePattern) { OBJECT_PATTERN_NODE *patternPtr; if (thePattern == NULL) return; while (thePattern != NULL) { patternPtr = thePattern->rightNode; DestroyObjectPatternNetwork(theEnv,thePattern->nextLevel); DestroyObjectAlphaNodes(theEnv,thePattern->alphaNode); #if ! RUN_TIME rtn_struct(theEnv,objectPatternNode,thePattern); #endif thePattern = patternPtr; } } /************************************************************/ /* DestroyObjectAlphaNodes: Deallocates the data structures */ /* associated with the object alpha nodes. */ /************************************************************/ static void DestroyObjectAlphaNodes( void *theEnv, OBJECT_ALPHA_NODE *theNode) { OBJECT_ALPHA_NODE *nodePtr; if (theNode == NULL) return; while (theNode != NULL) { nodePtr = theNode->nxtInGroup; DestroyAlphaBetaMemory(theEnv,theNode->header.alphaMemory); #if ! RUN_TIME rtn_struct(theEnv,objectAlphaNode,theNode); #endif theNode = nodePtr; } } /***************************************************** NAME : ObjectCmpConstantFunction DESCRIPTION : Used to compare object slot values against a constant INPUTS : 1) The constant test bitmap 2) Data object buffer to hold result RETURNS : TRUE if test successful, FALSE otherwise SIDE EFFECTS : Buffer set to symbol TRUE if test successful, FALSE otherwise NOTES : Called directly by EvaluatePatternExpression() *****************************************************/ globle intBool ObjectCmpConstantFunction( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectCmpPNConstant *hack; DATA_OBJECT theVar; EXPRESSION *constantExp; int rv; SEGMENT *theSegment; hack = (struct ObjectCmpPNConstant *) ValueToBitMap(theValue); if (hack->general) { EvaluateExpression(theEnv,GetFirstArgument(),&theVar); constantExp = GetFirstArgument()->nextArg; } else { constantExp = GetFirstArgument(); if (ObjectReteData(theEnv)->CurrentPatternObjectSlot->type == MULTIFIELD) { theSegment = (struct multifield *) ObjectReteData(theEnv)->CurrentPatternObjectSlot->value; if (hack->fromBeginning) { theVar.type = theSegment->theFields[hack->offset].type; theVar.value = theSegment->theFields[hack->offset].value; } else { theVar.type = theSegment->theFields[theSegment->multifieldLength - (hack->offset + 1)].type; theVar.value = theSegment->theFields[theSegment->multifieldLength - (hack->offset + 1)].value; } } else { theVar.type = (unsigned short) ObjectReteData(theEnv)->CurrentPatternObjectSlot->type; theVar.value = ObjectReteData(theEnv)->CurrentPatternObjectSlot->value; } } if (theVar.type != constantExp->type) rv = hack->fail; else if (theVar.value != constantExp->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintObjectGetVarJN1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar1 *hack; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); if (hack->objectAddress) { EnvPrintRouter(theEnv,logicalName,"(obj-ptr "); PrintLongInteger(theEnv,logicalName,(long) hack->whichPattern); } else if (hack->allFields) { EnvPrintRouter(theEnv,logicalName,"(obj-slot-contents "); PrintLongInteger(theEnv,logicalName,(long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); } else { EnvPrintRouter(theEnv,logicalName,"(obj-slot-var "); PrintLongInteger(theEnv,logicalName,(long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->whichField); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool ObjectGetVarJNFunction1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchVar1 *hack; INSTANCE_TYPE *theInstance; struct multifieldMarker *theMarks; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->whichPattern) - 1,&theInstance,&theMarks); GetObjectValueGeneral(theEnv,theResult,theInstance,theMarks,hack); return(TRUE); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintObjectGetVarJN2( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar2 *hack; hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(obj-slot-quick-var "); PrintLongInteger(theEnv,logicalName,(long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); if (hack->fromBeginning) { EnvPrintRouter(theEnv,logicalName," B"); PrintLongInteger(theEnv,logicalName,(long) (hack->beginningOffset + 1)); } if (hack->fromEnd) { EnvPrintRouter(theEnv,logicalName," E"); PrintLongInteger(theEnv,logicalName,(long) (hack->endOffset + 1)); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool ObjectGetVarJNFunction2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchVar2 *hack; INSTANCE_TYPE *theInstance; struct multifieldMarker *theMarks; hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->whichPattern) - 1,&theInstance,&theMarks); GetObjectValueSimple(theEnv,theResult,theInstance,hack); return(TRUE); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintObjectGetVarPN1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar1 *hack; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); if (hack->objectAddress) EnvPrintRouter(theEnv,logicalName,"(ptn-obj-ptr "); else if (hack->allFields) { EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-contents "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); } else { EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-var "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->whichField); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool ObjectGetVarPNFunction1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchVar1 *hack; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); GetObjectValueGeneral(theEnv,theResult,ObjectReteData(theEnv)->CurrentPatternObject,ObjectReteData(theEnv)->CurrentPatternObjectMarks,hack); return(TRUE); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintObjectGetVarPN2( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar2 *hack; hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-quick-var "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); if (hack->fromBeginning) { EnvPrintRouter(theEnv,logicalName," B"); PrintLongInteger(theEnv,logicalName,(long) (hack->beginningOffset + 1)); } if (hack->fromEnd) { EnvPrintRouter(theEnv,logicalName," E"); PrintLongInteger(theEnv,logicalName,(long) (hack->endOffset + 1)); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool ObjectGetVarPNFunction2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchVar2 *hack; hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue); GetObjectValueSimple(theEnv,theResult,ObjectReteData(theEnv)->CurrentPatternObject,hack); return(TRUE); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintObjectCmpConstant( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpPNConstant *hack; hack = (struct ObjectCmpPNConstant *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(obj-const "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); if (hack->general) PrintExpression(theEnv,logicalName,GetFirstArgument()); else { EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? "B" : "E"); PrintLongInteger(theEnv,logicalName,(long) hack->offset); EnvPrintRouter(theEnv,logicalName," "); PrintExpression(theEnv,logicalName,GetFirstArgument()); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintSlotLengthTest( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchLength *hack; hack = (struct ObjectMatchLength *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(obj-slot-len "); if (hack->exactly) EnvPrintRouter(theEnv,logicalName,"= "); else EnvPrintRouter(theEnv,logicalName,">= "); PrintLongInteger(theEnv,logicalName,(long) hack->minLength); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool SlotLengthTestFunction( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectMatchLength *hack; theResult->type = SYMBOL; theResult->value = EnvFalseSymbol(theEnv); hack = (struct ObjectMatchLength *) ValueToBitMap(theValue); if (ObjectReteData(theEnv)->CurrentObjectSlotLength < hack->minLength) return(FALSE); if (hack->exactly && (ObjectReteData(theEnv)->CurrentObjectSlotLength > hack->minLength)) return(FALSE); theResult->value = EnvTrueSymbol(theEnv); return(TRUE); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintPNSimpleCompareFunction1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpPNSingleSlotVars1 *hack; hack = (struct ObjectCmpPNSingleSlotVars1 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(pslot-cmp1 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool PNSimpleCompareFunction1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectCmpPNSingleSlotVars1 *hack; INSTANCE_SLOT *is1,*is2; int rv; hack = (struct ObjectCmpPNSingleSlotVars1 *) ValueToBitMap(theValue); is1 = GetInsSlot(ObjectReteData(theEnv)->CurrentPatternObject,hack->firstSlot); is2 = GetInsSlot(ObjectReteData(theEnv)->CurrentPatternObject,hack->secondSlot); if (is1->type != is2->type) rv = hack->fail; else if (is1->value != is2->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintPNSimpleCompareFunction2( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpPNSingleSlotVars2 *hack; hack = (struct ObjectCmpPNSingleSlotVars2 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(pslot-cmp2 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long) hack->offset); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool PNSimpleCompareFunction2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectCmpPNSingleSlotVars2 *hack; int rv; FIELD f1; INSTANCE_SLOT *is2; hack = (struct ObjectCmpPNSingleSlotVars2 *) ValueToBitMap(theValue); GetInsMultiSlotField(&f1,ObjectReteData(theEnv)->CurrentPatternObject,(unsigned) hack->firstSlot, (unsigned) hack->fromBeginning,(unsigned) hack->offset); is2 = GetInsSlot(ObjectReteData(theEnv)->CurrentPatternObject,hack->secondSlot); if (f1.type != is2->type) rv = hack->fail; else if (f1.value != is2->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintPNSimpleCompareFunction3( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpPNSingleSlotVars3 *hack; hack = (struct ObjectCmpPNSingleSlotVars3 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(pslot-cmp3 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName,hack->firstFromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long) hack->firstOffset); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,hack->secondFromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long) hack->secondOffset); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool PNSimpleCompareFunction3( void *theEnv, void *theValue, DATA_OBJECT *theResult) { struct ObjectCmpPNSingleSlotVars3 *hack; int rv; FIELD f1,f2; hack = (struct ObjectCmpPNSingleSlotVars3 *) ValueToBitMap(theValue); GetInsMultiSlotField(&f1,ObjectReteData(theEnv)->CurrentPatternObject,(unsigned) hack->firstSlot, (unsigned) hack->firstFromBeginning,(unsigned) hack->firstOffset); GetInsMultiSlotField(&f2,ObjectReteData(theEnv)->CurrentPatternObject,(unsigned) hack->secondSlot, (unsigned) hack->secondFromBeginning,(unsigned) hack->secondOffset); if (f1.type != f2.type) rv = hack->fail; else if (f1.value != f2.value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintJNSimpleCompareFunction1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpJoinSingleSlotVars1 *hack; hack = (struct ObjectCmpJoinSingleSlotVars1 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(jslot-cmp1 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); PrintLongInteger(theEnv,logicalName,(long) hack->firstPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->secondPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool JNSimpleCompareFunction1( void *theEnv, void *theValue, DATA_OBJECT *theResult) { INSTANCE_TYPE *ins1,*ins2; struct multifieldMarker *theMarks; struct ObjectCmpJoinSingleSlotVars1 *hack; int rv; INSTANCE_SLOT *is1,*is2; hack = (struct ObjectCmpJoinSingleSlotVars1 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern) - 1,&ins1,&theMarks); is1 = GetInsSlot(ins1,hack->firstSlot); GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern) - 1,&ins2,&theMarks); is2 = GetInsSlot(ins2,hack->secondSlot); if (is1->type != is2->type) rv = hack->fail; else if (is1->value != is2->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintJNSimpleCompareFunction2( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpJoinSingleSlotVars2 *hack; hack = (struct ObjectCmpJoinSingleSlotVars2 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(jslot-cmp2 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); PrintLongInteger(theEnv,logicalName,(long) hack->firstPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long) hack->offset); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->secondPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool JNSimpleCompareFunction2( void *theEnv, void *theValue, DATA_OBJECT *theResult) { INSTANCE_TYPE *ins1,*ins2; struct multifieldMarker *theMarks; struct ObjectCmpJoinSingleSlotVars2 *hack; int rv; FIELD f1; INSTANCE_SLOT *is2; hack = (struct ObjectCmpJoinSingleSlotVars2 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern) - 1,&ins1,&theMarks); GetInsMultiSlotField(&f1,ins1,(unsigned) hack->firstSlot, (unsigned) hack->fromBeginning,(unsigned) hack->offset); GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern) - 1,&ins2,&theMarks); is2 = GetInsSlot(ins2,hack->secondSlot); if (f1.type != is2->type) rv = hack->fail; else if (f1.value != is2->value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif static void PrintJNSimpleCompareFunction3( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct ObjectCmpJoinSingleSlotVars3 *hack; hack = (struct ObjectCmpJoinSingleSlotVars3 *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(jslot-cmp3 "); EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n "); PrintLongInteger(theEnv,logicalName,(long) hack->firstPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot))); EnvPrintRouter(theEnv,logicalName,hack->firstFromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long) hack->firstOffset); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->secondPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot))); EnvPrintRouter(theEnv,logicalName,hack->secondFromBeginning ? " B" : " E"); PrintLongInteger(theEnv,logicalName,(long) hack->secondOffset); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } static intBool JNSimpleCompareFunction3( void *theEnv, void *theValue, DATA_OBJECT *theResult) { INSTANCE_TYPE *ins1,*ins2; struct multifieldMarker *theMarks; struct ObjectCmpJoinSingleSlotVars3 *hack; int rv; FIELD f1,f2; hack = (struct ObjectCmpJoinSingleSlotVars3 *) ValueToBitMap(theValue); GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern) - 1,&ins1,&theMarks); GetInsMultiSlotField(&f1,ins1,(unsigned) hack->firstSlot, (unsigned) hack->firstFromBeginning, (unsigned) hack->firstOffset); GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern) - 1,&ins2,&theMarks); GetInsMultiSlotField(&f2,ins2,(unsigned) hack->secondSlot, (unsigned) hack->secondFromBeginning, (unsigned) hack->secondOffset); if (f1.type != f2.type) rv = hack->fail; else if (f1.value != f2.value) rv = hack->fail; else rv = hack->pass; theResult->type = SYMBOL; theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv); return(rv); } /**************************************************** NAME : GetPatternObjectAndMarks DESCRIPTION : Finds the instance and multfiield markers corresponding to a specified pattern in the join network INPUTS : 1) The index of the desired pattern 2) A buffer to hold the instance address 3) A buffer to hold the list of multifield markers RETURNS : Nothing useful SIDE EFFECTS : Buffers set NOTES : None ****************************************************/ static void GetPatternObjectAndMarks( void *theEnv, int pattern, INSTANCE_TYPE **theInstance, struct multifieldMarker **theMarkers) { if (EngineData(theEnv)->GlobalRHSBinds == NULL) { *theInstance = (INSTANCE_TYPE *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->matchingItem; *theMarkers = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->markers; } else if ((((int) EngineData(theEnv)->GlobalJoin->depth) - 1) == pattern) { *theInstance = (INSTANCE_TYPE *) get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->matchingItem; *theMarkers = get_nth_pm_match(EngineData(theEnv)->GlobalRHSBinds,0)->markers; } else { *theInstance = (INSTANCE_TYPE *) get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->matchingItem; *theMarkers = get_nth_pm_match(EngineData(theEnv)->GlobalLHSBinds,pattern)->markers; } } /*************************************************** NAME : GetObjectValueGeneral DESCRIPTION : Access function for getting pattern variable values within the object pattern and join networks INPUTS : 1) The result data object buffer 2) The instance to access 3) The list of multifield markers for the pattern 4) Data for variable reference RETURNS : Nothing useful SIDE EFFECTS : Data object is filled with the values of the pattern variable NOTES : None ***************************************************/ static void GetObjectValueGeneral( void *theEnv, DATA_OBJECT *result, INSTANCE_TYPE *theInstance, struct multifieldMarker *theMarks, struct ObjectMatchVar1 *matchVar) { long field, extent; /* 6.04 Bug Fix */ INSTANCE_SLOT **insSlot,*basisSlot; if (matchVar->objectAddress) { result->type = INSTANCE_ADDRESS; result->value = (void *) theInstance; return; } if (matchVar->whichSlot == ISA_ID) { result->type = SYMBOL; result->value = (void *) GetDefclassNamePointer((void *) theInstance->cls); return; } if (matchVar->whichSlot == NAME_ID) { result->type = INSTANCE_NAME; result->value = (void *) theInstance->name; return; } insSlot = &theInstance->slotAddresses [theInstance->cls->slotNameMap[matchVar->whichSlot] - 1]; /* ========================================= We need to reference the basis slots if the slot of this object has changed while the RHS was executing However, if the reference is being done by the LHS of a rule (as a consequence of an RHS action), give the pattern matcher the real value of the slot ========================================= */ if ((theInstance->basisSlots != NULL) && (! EngineData(theEnv)->JoinOperationInProgress)) { basisSlot = theInstance->basisSlots + (insSlot - theInstance->slotAddresses); if (basisSlot->value != NULL) insSlot = &basisSlot; } /* ================================================== If we know we are accessing the entire slot, the don't bother with searching multifield markers or calculating offsets ================================================== */ if (matchVar->allFields) { result->type = (unsigned short) (*insSlot)->type; result->value = (*insSlot)->value; if (result->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetMFLength((*insSlot)->value)); } return; } /* ============================================= Access a general field in a slot pattern with two or more multifield variables ============================================= */ field = CalculateSlotField(theMarks,*insSlot,matchVar->whichField,&extent); if (extent == -1) { if ((*insSlot)->desc->multiple) { result->type = GetMFType((*insSlot)->value,field); result->value = GetMFValue((*insSlot)->value,field); } else { result->type = (unsigned short) (*insSlot)->type; result->value = (*insSlot)->value; } } else { result->type = MULTIFIELD; result->value = (*insSlot)->value; result->begin = field - 1; result->end = field + extent - 2; } } /*************************************************** NAME : GetObjectValueSimple DESCRIPTION : Access function for getting pattern variable values within the object pattern and join networks INPUTS : 1) The result data object buffer 2) The instance to access 3) Data for variable reference RETURNS : Nothing useful SIDE EFFECTS : Data object is filled with the values of the pattern variable NOTES : None ***************************************************/ static void GetObjectValueSimple( void *theEnv, DATA_OBJECT *result, INSTANCE_TYPE *theInstance, struct ObjectMatchVar2 *matchVar) { INSTANCE_SLOT **insSlot,*basisSlot; SEGMENT *segmentPtr; FIELD *fieldPtr; insSlot = &theInstance->slotAddresses [theInstance->cls->slotNameMap[matchVar->whichSlot] - 1]; /* ========================================= We need to reference the basis slots if the slot of this object has changed while the RHS was executing However, if the reference is being done by the LHS of a rule (as a consequence of an RHS action), give the pattern matcher the real value of the slot ========================================= */ if ((theInstance->basisSlots != NULL) && (! EngineData(theEnv)->JoinOperationInProgress)) { basisSlot = theInstance->basisSlots + (insSlot - theInstance->slotAddresses); if (basisSlot->value != NULL) insSlot = &basisSlot; } if ((*insSlot)->desc->multiple) { segmentPtr = (SEGMENT *) (*insSlot)->value; if (matchVar->fromBeginning) { if (matchVar->fromEnd) { result->type = MULTIFIELD; result->value = (void *) segmentPtr; result->begin = matchVar->beginningOffset; SetpDOEnd(result,GetMFLength(segmentPtr) - matchVar->endOffset); } else { fieldPtr = &segmentPtr->theFields[matchVar->beginningOffset]; result->type = fieldPtr->type; result->value = fieldPtr->value; } } else { fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (matchVar->endOffset + 1)]; result->type = fieldPtr->type; result->value = fieldPtr->value; } } else { result->type = (unsigned short) (*insSlot)->type; result->value = (*insSlot)->value; } } /**************************************************** NAME : CalculateSlotField DESCRIPTION : Determines the actual index into the an object slot for a given pattern variable INPUTS : 1) The list of markers to examine 2) The instance slot (can be NULL) 3) The pattern index of the variable 4) A buffer in which to store the extent of the pattern variable (-1 for single-field vars) RETURNS : The actual index SIDE EFFECTS : None NOTES : None ****************************************************/ static long CalculateSlotField( struct multifieldMarker *theMarkers, INSTANCE_SLOT *theSlot, long theIndex, long *extent) { register long actualIndex; void *theSlotName; actualIndex = theIndex; *extent = -1; if (theSlot == NULL) return(actualIndex); theSlotName = (void *) theSlot->desc->slotName->name; while (theMarkers != NULL) { if (theMarkers->where.whichSlot == theSlotName) break; theMarkers = theMarkers->next; } while ((theMarkers != NULL) ? (theMarkers->where.whichSlot == theSlotName) : FALSE) { if (theMarkers->whichField == theIndex) { *extent = theMarkers->endPosition - theMarkers->startPosition + 1; return(actualIndex); } if (theMarkers->whichField > theIndex) return(actualIndex); actualIndex += theMarkers->endPosition - theMarkers->startPosition; theMarkers = theMarkers->next; } return(actualIndex); } /**************************************************** NAME : GetInsMultiSlotField DESCRIPTION : Gets the values of simple single field references in multifield slots for Rete comparisons INPUTS : 1) A multifield field structure to store the type and value in 2) The instance 3) The id of the slot 4) A flag indicating if offset is from beginning or end of multifield slot 5) The offset RETURNS : The multifield field SIDE EFFECTS : None NOTES : Should only be used to access single-field reference in multifield slots for pattern and join network comparisons ****************************************************/ static void GetInsMultiSlotField( FIELD *theField, INSTANCE_TYPE *theInstance, unsigned theSlotID, unsigned fromBeginning, unsigned offset) { register INSTANCE_SLOT * insSlot; register SEGMENT *theSegment; register FIELD *tmpField; insSlot = theInstance->slotAddresses [theInstance->cls->slotNameMap[theSlotID] - 1]; /* Bug fix for 6.05 */ if (insSlot->desc->multiple) { theSegment = (SEGMENT *) insSlot->value; if (fromBeginning) tmpField = &theSegment->theFields[offset]; else tmpField = &theSegment->theFields[theSegment->multifieldLength - offset - 1]; theField->type = tmpField->type; theField->value = tmpField->value; } else { theField->type = (unsigned short) insSlot->type; theField->value = insSlot->value; } } #endif clips-6.24/clipssrc/factcmp.h0000755000175000017500000000303007422634536014327 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factcmp #define _H_factcmp #ifndef _H_pattern #include "pattern.h" #endif #ifndef _H_network #include "network.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FactPatternsCompilerSetup(void *); LOCALE void FactPatternNodeReference(void *,void *,FILE *,int,int); #endif clips-6.24/clipssrc/._factmngr.c0000400000175000017500000000075410441162076014706 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoK[BK[BNnWWS~TTFLeFMPSRMWBBLclips-6.24/clipssrc/._lgcldpnd.h0000400000175000017500000000075410441147665014710 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0z9TTFS FMWBBMPSRclips-6.24/clipssrc/._sysdep.h0000400000175000017500000000075410443607651014426 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0101y99TTFHFMPSRMWBBLclips-6.24/clipssrc/tmpltfun.c0000755000175000017500000020213610443377406014563 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* DEFTEMPLATE FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the modify and duplicate functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added deftemplate-slot-names, */ /* deftemplate-slot-default-value, */ /* deftemplate-slot-cardinality, */ /* deftemplate-slot-allowed-values, */ /* deftemplate-slot-range, */ /* deftemplate-slot-types, */ /* deftemplate-slot-multip, */ /* deftemplate-slot-singlep, */ /* deftemplate-slot-existp, and */ /* deftemplate-slot-defaultp functions. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _TMPLTFUN_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include #include "constant.h" #include "memalloc.h" #include "symbol.h" #include "scanner.h" #include "exprnpsr.h" #include "envrnmnt.h" #include "argacces.h" #include "router.h" #include "cstrnchk.h" #include "default.h" #include "factmngr.h" #include "commline.h" #include "factrhs.h" #include "modulutl.h" #include "reorder.h" #include "tmpltdef.h" #include "tmpltlhs.h" #include "tmpltutl.h" #include "tmpltrhs.h" #include "tmpltfun.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DuplicateModifyCommand(void *,int,DATA_OBJECT_PTR); static SYMBOL_HN *CheckDeftemplateAndSlotArguments(void *,char *,struct deftemplate **); #if (! RUN_TIME) && (! BLOAD_ONLY) static struct expr *ModAndDupParse(void *,struct expr *,char *,char *); static SYMBOL_HN *FindTemplateForFactAddress(SYMBOL_HN *,struct lhsParseNode *); #endif /****************************************************************/ /* DeftemplateFunctions: Initializes the deftemplate functions. */ /****************************************************************/ globle void DeftemplateFunctions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction(theEnv,"modify",'u', PTIEF ModifyCommand,"ModifyCommand"); EnvDefineFunction(theEnv,"duplicate",'u', PTIEF DuplicateCommand,"DuplicateCommand"); EnvDefineFunction2(theEnv,"deftemplate-slot-names",'u', PTIEF DeftemplateSlotNamesFunction, "DeftemplateSlotNamesFunction", "11z"); EnvDefineFunction2(theEnv,"deftemplate-slot-default-value",'u',PTIEF DeftemplateSlotDefaultValueFunction, "DeftemplateSlotDefaultValueFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-cardinality",'u',PTIEF DeftemplateSlotCardinalityFunction, "DeftemplateSlotCardinalityFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-allowed-values",'u',PTIEF DeftemplateSlotAllowedValuesFunction, "DeftemplateSlotAllowedValuesFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-range",'u',PTIEF DeftemplateSlotRangeFunction, "DeftemplateSlotRangeFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-types",'u',PTIEF DeftemplateSlotTypesFunction, "DeftemplateSlotTypesFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-multip",'b',PTIEF DeftemplateSlotMultiPFunction, "DeftemplateSlotMultiPFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-singlep",'b',PTIEF DeftemplateSlotSinglePFunction, "DeftemplateSlotSinglePFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-existp",'b',PTIEF DeftemplateSlotExistPFunction, "DeftemplateSlotExistPFunction","22w"); EnvDefineFunction2(theEnv,"deftemplate-slot-defaultp",'w',PTIEF DeftemplateSlotDefaultPFunction, "DeftemplateSlotDefaultPFunction","22w"); #if (! BLOAD_ONLY) AddFunctionParser(theEnv,"modify",ModifyParse); AddFunctionParser(theEnv,"duplicate",DuplicateParse); #endif FuncSeqOvlFlags(theEnv,"modify",FALSE,FALSE); FuncSeqOvlFlags(theEnv,"duplicate",FALSE,FALSE); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /*********************************************************************/ /* ModifyCommand: H/L access routine for the modify command. Calls */ /* the DuplicateModifyCommand function to perform the actual work. */ /*********************************************************************/ globle void ModifyCommand( void *theEnv, DATA_OBJECT_PTR returnValue) { DuplicateModifyCommand(theEnv,TRUE,returnValue); } /***************************************************************************/ /* DuplicateCommand: H/L access routine for the duplicate command. Calls */ /* the DuplicateModifyCommand function to perform the actual work. */ /***************************************************************************/ globle void DuplicateCommand( void *theEnv, DATA_OBJECT_PTR returnValue) { DuplicateModifyCommand(theEnv,FALSE,returnValue); } /***************************************************************/ /* DuplicateModifyCommand: Implements the duplicate and modify */ /* commands. The fact being duplicated or modified is first */ /* copied to a new fact. Replacements to the fields of the */ /* new fact are then made. If a modify command is being */ /* performed, the original fact is retracted. Lastly, the */ /* new fact is asserted. */ /***************************************************************/ static void DuplicateModifyCommand( void *theEnv, int retractIt, DATA_OBJECT_PTR returnValue) { long int factNum; struct fact *oldFact, *newFact, *theFact; struct expr *testPtr; DATA_OBJECT computeResult; struct deftemplate *templatePtr; struct templateSlot *slotPtr; int i, position, found; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*==================================================*/ /* Evaluate the first argument which is used to get */ /* a pointer to the fact to be modified/duplicated. */ /*==================================================*/ testPtr = GetFirstArgument(); EvaluateExpression(theEnv,testPtr,&computeResult); /*==============================================================*/ /* If an integer is supplied, then treat it as a fact-index and */ /* search the fact-list for the fact with that fact-index. */ /*==============================================================*/ if (computeResult.type == INTEGER) { factNum = ValueToLong(computeResult.value); if (factNum < 0) { if (retractIt) ExpectedTypeError2(theEnv,"modify",1); else ExpectedTypeError2(theEnv,"duplicate",1); SetEvaluationError(theEnv,TRUE); return; } oldFact = (struct fact *) EnvGetNextFact(theEnv,NULL); while (oldFact != NULL) { if (oldFact->factIndex == factNum) { break; } else { oldFact = oldFact->nextFact; } } if (oldFact == NULL) { char tempBuffer[20]; sprintf(tempBuffer,"f-%ld",factNum); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); return; } } /*==========================================*/ /* Otherwise, if a pointer is supplied then */ /* no lookup is required. */ /*==========================================*/ else if (computeResult.type == FACT_ADDRESS) { oldFact = (struct fact *) computeResult.value; } /*===========================================*/ /* Otherwise, the first argument is invalid. */ /*===========================================*/ else { if (retractIt) ExpectedTypeError2(theEnv,"modify",1); else ExpectedTypeError2(theEnv,"duplicate",1); SetEvaluationError(theEnv,TRUE); return; } /*==================================*/ /* See if it is a deftemplate fact. */ /*==================================*/ templatePtr = oldFact->whichDeftemplate; if (templatePtr->implied) return; /*================================================================*/ /* Duplicate the values from the old fact (skipping multifields). */ /*================================================================*/ newFact = (struct fact *) CreateFactBySize(theEnv,oldFact->theProposition.multifieldLength); newFact->whichDeftemplate = templatePtr; for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++) { newFact->theProposition.theFields[i].type = oldFact->theProposition.theFields[i].type; if (newFact->theProposition.theFields[i].type != MULTIFIELD) { newFact->theProposition.theFields[i].value = oldFact->theProposition.theFields[i].value; } else { newFact->theProposition.theFields[i].value = NULL; } } /*========================*/ /* Start replacing slots. */ /*========================*/ testPtr = testPtr->nextArg; while (testPtr != NULL) { /*============================================================*/ /* If the slot identifier is an integer, then the slot was */ /* previously identified and its position within the template */ /* was stored. Otherwise, the position of the slot within the */ /* deftemplate has to be determined by comparing the name of */ /* the slot against the list of slots for the deftemplate. */ /*============================================================*/ if (testPtr->type == INTEGER) { position = (int) ValueToLong(testPtr->value); } else { found = FALSE; position = 0; slotPtr = templatePtr->slotList; while (slotPtr != NULL) { if (slotPtr->slotName == (SYMBOL_HN *) testPtr->value) { found = TRUE; slotPtr = NULL; } else { slotPtr = slotPtr->next; position++; } } if (! found) { InvalidDeftemplateSlotMessage(theEnv,ValueToString(testPtr->value), ValueToString(templatePtr->header.name),TRUE); SetEvaluationError(theEnv,TRUE); ReturnFact(theEnv,newFact); return; } } /*===================================================*/ /* If a single field slot is being replaced, then... */ /*===================================================*/ if (newFact->theProposition.theFields[position].type != MULTIFIELD) { /*======================================================*/ /* If the list of values to store in the slot is empty */ /* or contains more than one member than an error has */ /* occured because a single field slot can only contain */ /* a single value. */ /*======================================================*/ if ((testPtr->argList == NULL) ? TRUE : (testPtr->argList->nextArg != NULL)) { MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr); ReturnFact(theEnv,newFact); return; } /*===================================================*/ /* Evaluate the expression to be stored in the slot. */ /*===================================================*/ EvaluateExpression(theEnv,testPtr->argList,&computeResult); SetEvaluationError(theEnv,FALSE); /*====================================================*/ /* If the expression evaluated to a multifield value, */ /* then an error occured since a multifield value can */ /* not be stored in a single field slot. */ /*====================================================*/ if (computeResult.type == MULTIFIELD) { ReturnFact(theEnv,newFact); MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr); return; } /*=============================*/ /* Store the value in the slot */ /*=============================*/ newFact->theProposition.theFields[position].type = computeResult.type; newFact->theProposition.theFields[position].value = computeResult.value; } /*=================================*/ /* Else replace a multifield slot. */ /*=================================*/ else { /*======================================*/ /* Determine the new value of the slot. */ /*======================================*/ StoreInMultifield(theEnv,&computeResult,testPtr->argList,FALSE); SetEvaluationError(theEnv,FALSE); /*=============================*/ /* Store the value in the slot */ /*=============================*/ newFact->theProposition.theFields[position].type = computeResult.type; newFact->theProposition.theFields[position].value = computeResult.value; } testPtr = testPtr->nextArg; } /*=====================================*/ /* Copy the multifield values from the */ /* old fact that were not replaced. */ /*=====================================*/ for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++) { if ((newFact->theProposition.theFields[i].type == MULTIFIELD) && (newFact->theProposition.theFields[i].value == NULL)) { newFact->theProposition.theFields[i].value = CopyMultifield(theEnv,(struct multifield *) oldFact->theProposition.theFields[i].value); } } /*======================================*/ /* Perform the duplicate/modify action. */ /*======================================*/ if (retractIt) EnvRetract(theEnv,oldFact); theFact = (struct fact *) EnvAssert(theEnv,newFact); /*========================================*/ /* The asserted fact is the return value. */ /*========================================*/ if (theFact != NULL) { SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,theFact->theProposition.multifieldLength); SetpType(returnValue,FACT_ADDRESS); SetpValue(returnValue,(void *) theFact); } return; } /****************************************************/ /* DeftemplateSlotNamesFunction: H/L access routine */ /* for the deftemplate-slot-names function. */ /****************************************************/ globle void DeftemplateSlotNamesFunction( void *theEnv, DATA_OBJECT *returnValue) { char *deftemplateName; struct deftemplate *theDeftemplate; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"deftemplate-slot-names",EXACTLY,1) == -1) return; /*=======================================*/ /* Get the reference to the deftemplate. */ /*=======================================*/ deftemplateName = GetConstructName(theEnv,"deftemplate-slot-names","deftemplate name"); if (deftemplateName == NULL) return; theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,deftemplateName); if (theDeftemplate == NULL) { CantFindItemErrorMessage(theEnv,"deftemplate",deftemplateName); return; } /*=====================*/ /* Get the slot names. */ /*=====================*/ EnvDeftemplateSlotNames(theEnv,theDeftemplate,returnValue); } /**********************************************/ /* EnvDeftemplateSlotNames: C access routine */ /* for the deftemplate-slot-names function. */ /**********************************************/ globle void EnvDeftemplateSlotNames( void *theEnv, void *vTheDeftemplate, DATA_OBJECT *returnValue) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; struct multifield *theList; struct templateSlot *theSlot; unsigned long count; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,1); theList = (struct multifield *) EnvCreateMultifield(theEnv,(int) 1); SetMFType(theList,1,SYMBOL); SetMFValue(theList,1,EnvAddSymbol(theEnv,"implied")); SetpValue(returnValue,(void *) theList); return; } /*=================================*/ /* Count the number of slot names. */ /*=================================*/ for (count = 0, theSlot = theDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { /* Do Nothing */ } /*=============================================================*/ /* Create a multifield value in which to store the slot names. */ /*=============================================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*===============================================*/ /* Store the slot names in the multifield value. */ /*===============================================*/ for (count = 1, theSlot = theDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,theSlot->slotName); } } /*******************************************************/ /* DeftemplateSlotDefaultPFunction: H/L access routine */ /* for the deftemplate-slot-defaultp function. */ /*******************************************************/ globle void *DeftemplateSlotDefaultPFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; int defaultType; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-existp",&theDeftemplate); if (slotName == NULL) { return(EnvFalseSymbol(theEnv)); } /*===============================*/ /* Does the slot have a default? */ /*===============================*/ defaultType = EnvDeftemplateSlotDefaultP(theEnv,theDeftemplate,ValueToString(slotName)); if (defaultType == STATIC_DEFAULT) { return(EnvAddSymbol(theEnv,"static")); } else if (defaultType == DYNAMIC_DEFAULT) { return(EnvAddSymbol(theEnv,"dynamic")); } return(EnvFalseSymbol(theEnv)); } /*************************************************/ /* EnvDeftemplateSlotDefaultP: C access routine */ /* for the deftemplate-slot-defaultp function. */ /*************************************************/ globle int EnvDeftemplateSlotDefaultP( void *theEnv, void *vTheDeftemplate, char *slotName) { short position; struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; struct templateSlot *theSlot; /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { return(STATIC_DEFAULT); } else { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(NO_DEFAULT); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(NO_DEFAULT); } /*======================================*/ /* Return the default type of the slot. */ /*======================================*/ if (theSlot->noDefault) { return(NO_DEFAULT); } else if (theSlot->defaultDynamic) { return(DYNAMIC_DEFAULT); } return(STATIC_DEFAULT); } /*************************************************************/ /* DeftemplateSlotDefaultValueFunction: H/L access routine */ /* for the deftemplate-slot-default-value function. */ /*************************************************************/ globle void DeftemplateSlotDefaultValueFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-default-value",&theDeftemplate); if (slotName == NULL) { theValue->type = SYMBOL; theValue->value = EnvFalseSymbol(theEnv); return; } /*=========================================*/ /* Get the deftemplate slot default value. */ /*=========================================*/ EnvDeftemplateSlotDefaultValue(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /******************************************************/ /* EnvDeftemplateSlotDefaultValue: C access routine */ /* for the deftemplate-slot-default-value function. */ /******************************************************/ globle intBool EnvDeftemplateSlotDefaultValue( void *theEnv, void *vTheDeftemplate, char *slotName, DATA_OBJECT_PTR theValue) { short position; struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; struct templateSlot *theSlot; DATA_OBJECT tempDO; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ SetpType(theValue,SYMBOL); SetpValue(theValue,EnvFalseSymbol(theEnv)); /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { theValue->type = MULTIFIELD; theValue->value = EnvCreateMultifield(theEnv,0L); theValue->begin = 1; theValue->end = 0; return(TRUE); } else { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } /*=======================================*/ /* Return the default value of the slot. */ /*=======================================*/ if (theSlot->noDefault) { SetpType(theValue,SYMBOL); SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE")); } else if (DeftemplateSlotDefault(theEnv,theDeftemplate,theSlot,&tempDO,TRUE)) { SetpDOBegin(theValue,GetDOBegin(tempDO)); SetpDOEnd(theValue,GetDOEnd(tempDO)); SetpType(theValue,tempDO.type); SetpValue(theValue,tempDO.value); } else { return (FALSE); } return(TRUE); } /**********************************************************/ /* DeftemplateSlotCardinalityFunction: H/L access routine */ /* for the deftemplate-slot-cardinality function. */ /**********************************************************/ globle void DeftemplateSlotCardinalityFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-cardinality",&theDeftemplate); if (slotName == NULL) { EnvSetMultifieldErrorValue(theEnv,theValue); return; } /*=======================================*/ /* Get the deftemplate slot cardinality. */ /*=======================================*/ EnvDeftemplateSlotCardinality(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /****************************************************/ /* EnvDeftemplateSlotCardinality: C access routine */ /* for the deftemplate-slot-cardinality function. */ /****************************************************/ globle void EnvDeftemplateSlotCardinality( void *theEnv, void *vTheDeftemplate, char *slotName, DATA_OBJECT *result) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { result->type = MULTIFIELD; result->begin = 0; result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); return; } else { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } /*=====================================*/ /* Return the cardinality of the slot. */ /*=====================================*/ if (theSlot->multislot == 0) { EnvSetMultifieldErrorValue(theEnv,result); return; } result->type = MULTIFIELD; result->begin = 0; result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); if (theSlot->constraints != NULL) { SetMFType(result->value,1,theSlot->constraints->minFields->type); SetMFValue(result->value,1,theSlot->constraints->minFields->value); SetMFType(result->value,2,theSlot->constraints->maxFields->type); SetMFValue(result->value,2,theSlot->constraints->maxFields->value); } else { SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); } } /************************************************************/ /* DeftemplateSlotAllowedValuesFunction: H/L access routine */ /* for the deftemplate-slot-allowed-values function. */ /************************************************************/ globle void DeftemplateSlotAllowedValuesFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-allowed-values",&theDeftemplate); if (slotName == NULL) { EnvSetMultifieldErrorValue(theEnv,theValue); return; } /*==========================================*/ /* Get the deftemplate slot allowed values. */ /*==========================================*/ EnvDeftemplateSlotAllowedValues(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /*******************************************************/ /* EnvDeftemplateSlotAllowedValues: C access routine */ /* for the deftemplate-slot-allowed-values function. */ /*******************************************************/ globle void EnvDeftemplateSlotAllowedValues( void *theEnv, void *vTheDeftemplate, char *slotName, DATA_OBJECT *result) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; int i; EXPRESSION *theExp; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } else { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } /*========================================*/ /* Return the allowed values of the slot. */ /*========================================*/ if ((theSlot->constraints != NULL) ? (theSlot->constraints->restrictionList == NULL) : TRUE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->type = MULTIFIELD; result->begin = 0; result->end = ExpressionSize(theSlot->constraints->restrictionList) - 1; result->value = EnvCreateMultifield(theEnv,(unsigned long) (result->end + 1)); i = 1; theExp = theSlot->constraints->restrictionList; while (theExp != NULL) { SetMFType(result->value,i,theExp->type); SetMFValue(result->value,i,theExp->value); theExp = theExp->nextArg; i++; } } /****************************************************/ /* DeftemplateSlotRangeFunction: H/L access routine */ /* for the deftemplate-slot-range function. */ /****************************************************/ globle void DeftemplateSlotRangeFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-range",&theDeftemplate); if (slotName == NULL) { EnvSetMultifieldErrorValue(theEnv,theValue); return; } /*=================================*/ /* Get the deftemplate slot range. */ /*=================================*/ EnvDeftemplateSlotRange(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /**********************************************/ /* EnvDeftemplateSlotRange: C access routine */ /* for the deftemplate-slot-range function. */ /**********************************************/ globle void EnvDeftemplateSlotRange( void *theEnv, void *vTheDeftemplate, char *slotName, DATA_OBJECT *result) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { result->type = MULTIFIELD; result->begin = 0; result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,SYMBOL); SetMFValue(result->value,1,SymbolData(theEnv)->NegativeInfinity); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); return; } else { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } /*===============================*/ /* Return the range of the slot. */ /*===============================*/ if ((theSlot->constraints == NULL) ? FALSE : (theSlot->constraints->anyAllowed || theSlot->constraints->floatsAllowed || theSlot->constraints->integersAllowed)) { result->type = MULTIFIELD; result->begin = 0; result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,theSlot->constraints->minValue->type); SetMFValue(result->value,1,theSlot->constraints->minValue->value); SetMFType(result->value,2,theSlot->constraints->maxValue->type); SetMFValue(result->value,2,theSlot->constraints->maxValue->value); } else { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } } /****************************************************/ /* DeftemplateSlotTypesFunction: H/L access routine */ /* for the deftemplate-slot-types function. */ /****************************************************/ globle void DeftemplateSlotTypesFunction( void *theEnv, DATA_OBJECT_PTR theValue) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-types",&theDeftemplate); if (slotName == NULL) { EnvSetMultifieldErrorValue(theEnv,theValue); return; } /*=================================*/ /* Get the deftemplate slot types. */ /*=================================*/ EnvDeftemplateSlotTypes(theEnv,theDeftemplate,ValueToString(slotName),theValue); } /**********************************************/ /* EnvDeftemplateSlotTypes: C access routine */ /* for the deftemplate-slot-types function. */ /**********************************************/ globle void EnvDeftemplateSlotTypes( void *theEnv, void *vTheDeftemplate, char *slotName, DATA_OBJECT *result) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot = NULL; int numTypes, i, allTypes = FALSE; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot name is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") != 0) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { EnvSetMultifieldErrorValue(theEnv,result); SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return; } /*==============================================*/ /* If the slot has no constraint information or */ /* there is no type restriction, then all types */ /* are allowed for the slot. */ /*==============================================*/ if ((theDeftemplate->implied) || ((theSlot->constraints != NULL) ? theSlot->constraints->anyAllowed : TRUE)) { #if OBJECT_SYSTEM numTypes = 8; #else numTypes = 6; #endif allTypes = TRUE; } /*==============================================*/ /* Otherwise count the number of types allowed. */ /*==============================================*/ else { numTypes = theSlot->constraints->symbolsAllowed + theSlot->constraints->stringsAllowed + theSlot->constraints->floatsAllowed + theSlot->constraints->integersAllowed + theSlot->constraints->instanceNamesAllowed + theSlot->constraints->instanceAddressesAllowed + theSlot->constraints->externalAddressesAllowed + theSlot->constraints->factAddressesAllowed; } /*========================================*/ /* Return the allowed types for the slot. */ /*========================================*/ result->type = MULTIFIELD; result->begin = 0; result->end = numTypes - 1; result->value = EnvCreateMultifield(theEnv,(long) numTypes); i = 1; if (allTypes || theSlot->constraints->floatsAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"FLOAT")); } if (allTypes || theSlot->constraints->integersAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"INTEGER")); } if (allTypes || theSlot->constraints->symbolsAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"SYMBOL")); } if (allTypes || theSlot->constraints->stringsAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"STRING")); } if (allTypes || theSlot->constraints->externalAddressesAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"EXTERNAL-ADDRESS")); } if (allTypes || theSlot->constraints->factAddressesAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"FACT-ADDRESS")); } #if OBJECT_SYSTEM if (allTypes || theSlot->constraints->instanceAddressesAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"INSTANCE-ADDRESS")); } if (allTypes || theSlot->constraints->instanceNamesAllowed) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,"INSTANCE-NAME")); } #endif } /*****************************************************/ /* DeftemplateSlotMultiPFunction: H/L access routine */ /* for the deftemplate-slot-multip function. */ /*****************************************************/ globle int DeftemplateSlotMultiPFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-multip",&theDeftemplate); if (slotName == NULL) { return(FALSE); } /*================================*/ /* Is the slot a multifield slot? */ /*================================*/ return EnvDeftemplateSlotMultiP(theEnv,theDeftemplate,ValueToString(slotName)); } /***********************************************/ /* EnvDeftemplateSlotMultiP: C access routine */ /* for the deftemplate-slot-multip function. */ /***********************************************/ globle int EnvDeftemplateSlotMultiP( void *theEnv, void *vTheDeftemplate, char *slotName) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { return(TRUE); } else { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } /*================================*/ /* Is the slot a multifield slot? */ /*================================*/ return(theSlot->multislot); } /******************************************************/ /* DeftemplateSlotSinglePFunction: H/L access routine */ /* for the deftemplate-slot-singlep function. */ /******************************************************/ globle int DeftemplateSlotSinglePFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-singlep",&theDeftemplate); if (slotName == NULL) { return(FALSE); } /*==================================*/ /* Is the slot a single field slot? */ /*==================================*/ return EnvDeftemplateSlotSingleP(theEnv,theDeftemplate,ValueToString(slotName)); } /************************************************/ /* EnvDeftemplateSlotSingleP: C access routine */ /* for the deftemplate-slot-singlep function. */ /************************************************/ globle int EnvDeftemplateSlotSingleP( void *theEnv, void *vTheDeftemplate, char *slotName) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; struct templateSlot *theSlot; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { return(FALSE); } else { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if ((theSlot = FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position)) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,slotName, ValueToString(theDeftemplate->header.name),FALSE); return(FALSE); } /*==================================*/ /* Is the slot a single field slot? */ /*==================================*/ return(! theSlot->multislot); } /*****************************************************/ /* DeftemplateSlotExistPFunction: H/L access routine */ /* for the deftemplate-slot-existp function. */ /*****************************************************/ globle int DeftemplateSlotExistPFunction( void *theEnv) { struct deftemplate *theDeftemplate; SYMBOL_HN *slotName; /*===================================================*/ /* Retrieve the deftemplate and slot name arguments. */ /*===================================================*/ slotName = CheckDeftemplateAndSlotArguments(theEnv,"deftemplate-slot-existp",&theDeftemplate); if (slotName == NULL) { return(FALSE); } /*======================*/ /* Does the slot exist? */ /*======================*/ return EnvDeftemplateSlotExistP(theEnv,theDeftemplate,ValueToString(slotName)); } /************************************************/ /* EnvDeftemplateSlotExistP: C access routine */ /* for the deftemplate-slot-existp function. */ /************************************************/ globle int EnvDeftemplateSlotExistP( void *theEnv, void *vTheDeftemplate, char *slotName) { struct deftemplate *theDeftemplate = (struct deftemplate *) vTheDeftemplate; short position; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theDeftemplate->implied) { if (strcmp(slotName,"implied") == 0) { return(TRUE); } else { return(FALSE); } } /*============================================*/ /* Otherwise search for the slot name in the */ /* list of slots defined for the deftemplate. */ /*============================================*/ else if (FindSlot(theDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,slotName),&position) == NULL) { return(FALSE); } /*==================*/ /* The slot exists. */ /*==================*/ return(TRUE); } /************************************************************/ /* CheckDeftemplateAndSlotArguments: Checks the deftemplate */ /* and slot arguments for various functions. */ /************************************************************/ globle SYMBOL_HN *CheckDeftemplateAndSlotArguments( void *theEnv, char *functionName, struct deftemplate **theDeftemplate) { DATA_OBJECT tempDO; char *deftemplateName; /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,functionName,EXACTLY,2) == -1) { return(NULL); } /*=======================================*/ /* Get the reference to the deftemplate. */ /*=======================================*/ EnvRtnUnknown(theEnv,1,&tempDO); if (GetType(tempDO) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,1,"deftemplate name"); return(NULL); } deftemplateName = DOToString(tempDO); *theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,deftemplateName); if (*theDeftemplate == NULL) { CantFindItemErrorMessage(theEnv,"deftemplate",deftemplateName); return(NULL); } /*===========================*/ /* Get the name of the slot. */ /*===========================*/ if (EnvArgTypeCheck(theEnv,functionName,2,SYMBOL,&tempDO) == FALSE) { return(NULL); } return((SYMBOL_HN *) GetValue(tempDO)); } #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************************************/ /* UpdateModifyDuplicate: Changes the modify/duplicate command */ /* found on the RHS of a rule such that the positions of the */ /* slots for replacement are stored rather than the slot */ /* name which allows quicker replacement of slots. This */ /* substitution can only take place when the deftemplate */ /* type is known (i.e. if a fact-index is used you don't */ /* know which type of deftemplate is going to be replaced */ /* until you actually do the replacement of slots). */ /***************************************************************/ globle intBool UpdateModifyDuplicate( void *theEnv, struct expr *top, char *name, void *vTheLHS) { struct expr *functionArgs, *tempArg; SYMBOL_HN *templateName; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; short position; /*========================================*/ /* Determine the fact-address or index to */ /* be retracted by the modify command. */ /*========================================*/ functionArgs = top->argList; if (functionArgs->type == SF_VARIABLE) { templateName = FindTemplateForFactAddress((SYMBOL_HN *) functionArgs->value, (struct lhsParseNode *) vTheLHS); if (templateName == NULL) return(TRUE); } else { return(TRUE); } /*========================================*/ /* Make sure that the fact being modified */ /* has a corresponding deftemplate. */ /*========================================*/ theDeftemplate = (struct deftemplate *) LookupConstruct(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct, ValueToString(templateName), FALSE); if (theDeftemplate == NULL) return(TRUE); if (theDeftemplate->implied) return(TRUE); /*=============================================================*/ /* Make sure all the slot names are valid for the deftemplate. */ /*=============================================================*/ tempArg = functionArgs->nextArg; while (tempArg != NULL) { /*======================*/ /* Does the slot exist? */ /*======================*/ if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempArg->value,&position)) == NULL) { InvalidDeftemplateSlotMessage(theEnv,ValueToString(tempArg->value), ValueToString(theDeftemplate->header.name),TRUE); return(FALSE); } /*=========================================================*/ /* Is a multifield value being put in a single field slot? */ /*=========================================================*/ if (slotPtr->multislot == FALSE) { if (tempArg->argList == NULL) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); return(FALSE); } else if (tempArg->argList->nextArg != NULL) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); return(FALSE); } else if ((tempArg->argList->type == MF_VARIABLE) || ((tempArg->argList->type == FCALL) ? (((struct FunctionDefinition *) tempArg->argList->value)->returnValueType == 'm') : FALSE)) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); return(FALSE); } } /*======================================*/ /* Are the slot restrictions satisfied? */ /*======================================*/ if (CheckRHSSlotTypes(theEnv,tempArg->argList,slotPtr,name) == 0) return(FALSE); /*=============================================*/ /* Replace the slot with the integer position. */ /*=============================================*/ tempArg->type = INTEGER; tempArg->value = (void *) EnvAddLong(theEnv,(long) (FindSlotPosition(theDeftemplate,(SYMBOL_HN *) tempArg->value) - 1)); tempArg = tempArg->nextArg; } return(TRUE); } /**************************************************/ /* FindTemplateForFactAddress: Searches for the */ /* deftemplate name associated with the pattern */ /* to which a fact address has been bound. */ /**************************************************/ static SYMBOL_HN *FindTemplateForFactAddress( SYMBOL_HN *factAddress, struct lhsParseNode *theLHS) { struct lhsParseNode *thePattern = NULL; /*===============================================*/ /* Look through the LHS patterns for the pattern */ /* which is bound to the fact address used by */ /* the modify/duplicate function. */ /*===============================================*/ while (theLHS != NULL) { if (theLHS->value == (void *) factAddress) { thePattern = theLHS; theLHS = NULL; } else { theLHS = theLHS->bottom; } } if (thePattern == NULL) return(NULL); /*=====================================*/ /* Verify that just a symbol is stored */ /* as the first field of the pattern. */ /*=====================================*/ thePattern = thePattern->right; if ((thePattern->type != SF_WILDCARD) || (thePattern->bottom == NULL)) { return(NULL); } thePattern = thePattern->bottom; if ((thePattern->type != SYMBOL) || (thePattern->right != NULL) || (thePattern->bottom != NULL)) { return(NULL); } /*==============================*/ /* Return the deftemplate name. */ /*==============================*/ return((SYMBOL_HN *) thePattern->value); } /*******************************************/ /* ModifyParse: Parses the modify command. */ /*******************************************/ globle struct expr *ModifyParse( void *theEnv, struct expr *top, char *logicalName) { return(ModAndDupParse(theEnv,top,logicalName,"modify")); } /*************************************************/ /* DuplicateParse: Parses the duplicate command. */ /*************************************************/ globle struct expr *DuplicateParse( void *theEnv, struct expr *top, char *logicalName) { return(ModAndDupParse(theEnv,top,logicalName,"duplicate")); } /*************************************************************/ /* ModAndDupParse: Parses the modify and duplicate commands. */ /*************************************************************/ static struct expr *ModAndDupParse( void *theEnv, struct expr *top, char *logicalName, char *name) { int error = FALSE; struct token theToken; struct expr *nextOne, *tempSlot; struct expr *newField, *firstField, *lastField; int printError; short done; /*==================================================================*/ /* Parse the fact-address or index to the modify/duplicate command. */ /*==================================================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,logicalName,&theToken); if ((theToken.type == SF_VARIABLE) || (theToken.type == GBL_VARIABLE)) { nextOne = GenConstant(theEnv,theToken.type,theToken.value); } else if (theToken.type == INTEGER) { if (! TopLevelCommand(theEnv)) { PrintErrorID(theEnv,"TMPLTFUN",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Fact-indexes can only be used by "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR," as a top level command.\n"); ReturnExpression(theEnv,top); return(NULL); } nextOne = GenConstant(theEnv,INTEGER,theToken.value); } else { ExpectedTypeError2(theEnv,name,1); ReturnExpression(theEnv,top); return(NULL); } nextOne->nextArg = NULL; nextOne->argList = NULL; top->argList = nextOne; nextOne = top->argList; /*=======================================================*/ /* Parse the remaining modify/duplicate slot specifiers. */ /*=======================================================*/ GetToken(theEnv,logicalName,&theToken); while (theToken.type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); /*=================================================*/ /* Slot definition begins with a left parenthesis. */ /*=================================================*/ if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); return(NULL); } /*=================================*/ /* The slot name must be a symbol. */ /*=================================*/ GetToken(theEnv,logicalName,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); return(NULL); } /*=================================*/ /* Check for duplicate slot names. */ /*=================================*/ for (tempSlot = top->argList->nextArg; tempSlot != NULL; tempSlot = tempSlot->nextArg) { if (tempSlot->value == theToken.value) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(theToken.value)); ReturnExpression(theEnv,top); return(NULL); } } /*=========================================*/ /* Add the slot name to the list of slots. */ /*=========================================*/ nextOne->nextArg = GenConstant(theEnv,SYMBOL,theToken.value); nextOne = nextOne->nextArg; /*====================================================*/ /* Get the values to be stored in the specified slot. */ /*====================================================*/ firstField = NULL; lastField = NULL; done = FALSE; while (! done) { SavePPBuffer(theEnv," "); newField = GetAssertArgument(theEnv,logicalName,&theToken,&error, RPAREN,FALSE,&printError); if (error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); ReturnExpression(theEnv,top); return(NULL); } if (newField == NULL) { done = TRUE; } if (lastField == NULL) { firstField = newField; } else { lastField->nextArg = newField; } lastField = newField; } /*================================================*/ /* Slot definition ends with a right parenthesis. */ /*================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,firstField); return(NULL); } else { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } nextOne->argList = firstField; GetToken(theEnv,logicalName,&theToken); } /*================================================*/ /* Return the parsed modify/duplicate expression. */ /*================================================*/ return(top); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/._objrtfnx.h0000400000175000017500000000075410441150326014741 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z;TTFS GFMWBBMPSRclips-6.24/clipssrc/incrrset.c0000755000175000017500000003522110441147376014541 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INCREMENTAL RESET MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functionality for the incremental */ /* reset of the pattern and join networks when a new */ /* rule is added. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _INCRRSET_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #if DEFRULE_CONSTRUCT #include "agenda.h" #include "argacces.h" #include "constant.h" #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "evaluatn.h" #include "pattern.h" #include "router.h" #include "incrrset.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static void MarkNetworkForIncrementalReset(void *,struct defrule *,int); static void CheckForPrimableJoins(void *,struct defrule *); static void PrimeJoin(void *,struct joinNode *); static void MarkPatternForIncrementalReset(void *,int,struct patternNodeHeader *,int); #endif /**************************************************************/ /* IncrementalReset: Incrementally resets the specified rule. */ /**************************************************************/ globle void IncrementalReset( void *theEnv, struct defrule *tempRule) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,tempRule) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) struct defrule *tempPtr; struct patternParser *theParser; /*================================================*/ /* If incremental reset is disabled, then return. */ /*================================================*/ if (! EnvGetIncrementalReset(theEnv)) return; /*=====================================================*/ /* Mark the pattern and join network data structures */ /* associated with the rule being incrementally reset. */ /*=====================================================*/ MarkNetworkForIncrementalReset(theEnv,tempRule,TRUE); /*==========================*/ /* Begin incremental reset. */ /*==========================*/ EngineData(theEnv)->IncrementalResetInProgress = TRUE; /*============================================================*/ /* If the new rule shares patterns or joins with other rules, */ /* then it is necessary to update its join network based on */ /* existing partial matches it shares with other rules. */ /*============================================================*/ for (tempPtr = tempRule; tempPtr != NULL; tempPtr = tempPtr->disjunct) { CheckForPrimableJoins(theEnv,tempPtr); } /*===============================================*/ /* Filter existing data entities through the new */ /* portions of the pattern and join networks. */ /*===============================================*/ for (theParser = PatternData(theEnv)->ListOfPatternParsers; theParser != NULL; theParser = theParser->next) { if (theParser->incrementalResetFunction != NULL) { (*theParser->incrementalResetFunction)(theEnv); } } /*========================*/ /* End incremental reset. */ /*========================*/ EngineData(theEnv)->IncrementalResetInProgress = FALSE; /*====================================================*/ /* Remove the marks in the pattern and join networks. */ /*====================================================*/ MarkNetworkForIncrementalReset(theEnv,tempRule,FALSE); #endif } #if (! RUN_TIME) && (! BLOAD_ONLY) /**********************************************************************/ /* MarkNetworkForIncrementalReset: Coordinates marking the initialize */ /* flags in the pattern and join networks both before and after an */ /* incremental reset. */ /**********************************************************************/ static void MarkNetworkForIncrementalReset( void *theEnv, struct defrule *tempRule, int value) { struct joinNode *joinPtr; struct patternNodeHeader *patternPtr; /*============================================*/ /* Loop through each of the rule's disjuncts. */ /*============================================*/ for (; tempRule != NULL; tempRule = tempRule->disjunct) { /*============================================*/ /* Loop through each of the disjunct's joins. */ /*============================================*/ for (joinPtr = tempRule->lastJoin; joinPtr != NULL; joinPtr = GetPreviousJoin(joinPtr)) { /*================*/ /* Mark the join. */ /*================*/ joinPtr->marked = FALSE; /* GDR 6.05 */ if ((joinPtr->initialize) && (joinPtr->joinFromTheRight == FALSE)) { joinPtr->initialize = value; patternPtr = (struct patternNodeHeader *) GetPatternForJoin(joinPtr); MarkPatternForIncrementalReset(theEnv,(int) joinPtr->rhsType,patternPtr,value); } } } } /*******************************************************************************/ /* CheckForPrimableJoins: Updates the joins of a rule for an incremental reset */ /* if portions of that rule are shared with other rules that have already */ /* been incrementally reset. A join for a new rule will be updated if it is */ /* marked for initialization and either its parent join or its associated */ /* entry pattern node has not been marked for initialization. The function */ /* PrimeJoin is used to update joins which meet these criteria. */ /*******************************************************************************/ static void CheckForPrimableJoins( void *theEnv, struct defrule *tempRule) { struct joinNode *joinPtr; struct partialMatch *theList; /*========================================*/ /* Loop through each of the rule's joins. */ /*========================================*/ for (joinPtr = tempRule->lastJoin; joinPtr != NULL; joinPtr = GetPreviousJoin(joinPtr)) { /*===============================*/ /* Update the join if necessary. */ /*===============================*/ if ((joinPtr->initialize) && (! joinPtr->marked)) /* GDR 6.05 */ { if (joinPtr->firstJoin == TRUE) { if (((struct patternNodeHeader *) GetPatternForJoin(joinPtr))->initialize == FALSE) { PrimeJoin(theEnv,joinPtr); joinPtr->marked = TRUE; /* GDR 6.05 */ } } else if (joinPtr->lastLevel->initialize == FALSE) { PrimeJoin(theEnv,joinPtr); joinPtr->marked = TRUE; /* GDR 6.05 */ } } /*================================================================*/ /* If the join is associated with a rule activation (i.e. partial */ /* matches that reach this join cause an activation to be placed */ /* on the agenda), then add activations to the agenda for the */ /* rule being incrementally reset. */ /*================================================================*/ else if (joinPtr->ruleToActivate == tempRule) { for (theList = joinPtr->beta; theList != NULL; theList = theList->next) { AddActivation(theEnv,tempRule,theList); } } } } /****************************************************************************/ /* PrimeJoin: Updates a join in a rule for an incremental reset. Joins are */ /* updated by "priming" them only if the join (or its associated pattern) */ /* is shared with other rules that have already been incrementally reset. */ /* A join for a new rule will be updated if it is marked for */ /* initialization and either its parent join or its associated entry */ /* pattern node has not been marked for initialization. */ /****************************************************************************/ static void PrimeJoin( void *theEnv, struct joinNode *joinPtr) { struct partialMatch *theList; /*===========================================================*/ /* If the join is the first join of a rule, then send all of */ /* the partial matches from the alpha memory of the pattern */ /* associated with this join to the join for processing and */ /* the priming process is then complete. */ /*===========================================================*/ if (joinPtr->firstJoin == TRUE) { for (theList = ((struct patternNodeHeader *) joinPtr->rightSideEntryStructure)->alphaMemory; theList != NULL; theList = theList->next) { NetworkAssert(theEnv,theList,joinPtr,RHS); } return; } /*======================================================*/ /* If the join already has partial matches in its beta */ /* memory, then don't bother priming it. I don't recall */ /* if this situation is possible. */ /*======================================================*/ if (joinPtr->beta != NULL) return; /*================================================================*/ /* Send all partial matches from the preceding join to this join. */ /*================================================================*/ for (theList = joinPtr->lastLevel->beta; theList != NULL; theList = theList->next) { if (! theList->counterf) /* 6.05 incremental reset bug fix */ { NetworkAssert(theEnv,theList,joinPtr,LHS); } } } /*********************************************************************/ /* MarkPatternForIncrementalReset: Given a pattern node and its type */ /* (fact, instance, etc.), calls the appropriate function to mark */ /* the pattern for an incremental reset. Used to mark the pattern */ /* nodes both before and after an incremental reset. */ /*********************************************************************/ static void MarkPatternForIncrementalReset( void *theEnv, int rhsType, struct patternNodeHeader *theHeader, int value) { struct patternParser *tempParser; tempParser = GetPatternParser(theEnv,rhsType); if (tempParser != NULL) { if (tempParser->markIRPatternFunction != NULL) { (*tempParser->markIRPatternFunction)(theEnv,theHeader,value); } } } #endif /********************************************/ /* EnvGetIncrementalReset: C access routine */ /* for the get-incremental-reset command. */ /********************************************/ globle intBool EnvGetIncrementalReset( void *theEnv) { return(EngineData(theEnv)->IncrementalResetFlag); } /********************************************/ /* EnvSetIncrementalReset: C access routine */ /* for the set-incremental-reset command. */ /********************************************/ globle intBool EnvSetIncrementalReset( void *theEnv, int value) { int ov; ov = EngineData(theEnv)->IncrementalResetFlag; if (EnvGetNextDefrule(theEnv,NULL) != NULL) return(-1); EngineData(theEnv)->IncrementalResetFlag = value; return(ov); } /****************************************************/ /* SetIncrementalResetCommand: H/L access routine */ /* for the set-incremental-reset command. */ /****************************************************/ globle int SetIncrementalResetCommand( void *theEnv) { int oldValue; DATA_OBJECT argPtr; oldValue = EnvGetIncrementalReset(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-incremental-reset",EXACTLY,1) == -1) { return(oldValue); } /*=========================================*/ /* The incremental reset behavior can't be */ /* changed when rules are loaded. */ /*=========================================*/ if (EnvGetNextDefrule(theEnv,NULL) != NULL) { PrintErrorID(theEnv,"INCRRSET",1,FALSE); EnvPrintRouter(theEnv,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n"); SetEvaluationError(theEnv,TRUE); return(oldValue); } /*==================================================*/ /* The symbol FALSE disables incremental reset. Any */ /* other value enables incremental reset. */ /*==================================================*/ EnvRtnUnknown(theEnv,1,&argPtr); if ((argPtr.value == EnvFalseSymbol(theEnv)) && (argPtr.type == SYMBOL)) { EnvSetIncrementalReset(theEnv,FALSE); } else { EnvSetIncrementalReset(theEnv,TRUE); } /*=======================*/ /* Return the old value. */ /*=======================*/ return(oldValue); } /****************************************************/ /* GetIncrementalResetCommand: H/L access routine */ /* for the get-incremental-reset command. */ /****************************************************/ globle int GetIncrementalResetCommand( void *theEnv) { int oldValue; oldValue = EnvGetIncrementalReset(theEnv); if (EnvArgCountCheck(theEnv,"get-incremental-reset",EXACTLY,0) == -1) { return(oldValue); } return(oldValue); } #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._prdctfun.c0000400000175000017500000000075410441150603014723 0ustar jfsjfsMac OS X  2 RTEXT???? aTTFH Monaco0z0z;TTFS kFMWBBMPSRclips-6.24/clipssrc/._cstrnpsr.c0000400000175000017500000000075410441131501014750 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoOOqTTFS ZFMWBBMPSRclips-6.24/clipssrc/router.h0000755000175000017500000001425710441602321014225 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* ROUTER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a centralized mechanism for handling */ /* input and output requests. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added support for passing context information */ /* to the router functions. */ /* */ /*************************************************************/ #ifndef _H_router #define _H_router #ifndef _H_prntutil #include "prntutil.h" #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #define WWARNING "wwarning" #define WERROR "werror" #define WTRACE "wtrace" #define WDIALOG "wdialog" #define WPROMPT WPROMPT_STRING #define WDISPLAY "wdisplay" #define ROUTER_DATA 46 struct router { char *name; int active; int priority; short int environmentAware; void *context; int (*query)(void *,char *); int (*printer)(void *,char *,char *); int (*exiter)(void *,int); int (*charget)(void *,char *); int (*charunget)(void *,int,char *); struct router *next; }; struct routerData { int CommandBufferInputCount; char *LineCountRouter; char *FastCharGetRouter; char *FastCharGetString; long FastCharGetIndex; struct router *ListOfRouters; FILE *FastLoadFilePtr; FILE *FastSaveFilePtr; int Abort; }; #define RouterData(theEnv) ((struct routerData *) GetEnvironmentData(theEnv,ROUTER_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _ROUTER_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define ExitRouter(theEnv,a) EnvExitRouter(theEnv,a) #define GetcRouter(theEnv,a) EnvGetcRouter(theEnv,a) #define PrintRouter(theEnv,a,b) EnvPrintRouter(theEnv,a,b) #define UngetcRouter(theEnv,a,b) EnvUngetcRouter(theEnv,a,b) #define ActivateRouter(theEnv,a) EnvActivateRouter(theEnv,a) #define DeactivateRouter(theEnv,a) EnvDeactivateRouter(theEnv,a) #define DeleteRouter(theEnv,a) EnvDeleteRouter(theEnv,a) #else #define ExitRouter(a) EnvExitRouter(GetCurrentEnvironment(),a) #define GetcRouter(a) EnvGetcRouter(GetCurrentEnvironment(),a) #define PrintRouter(a,b) EnvPrintRouter(GetCurrentEnvironment(),a,b) #define UngetcRouter(a,b) EnvUngetcRouter(GetCurrentEnvironment(),a,b) #define ActivateRouter(a) EnvActivateRouter(GetCurrentEnvironment(),a) #define DeactivateRouter(a) EnvDeactivateRouter(GetCurrentEnvironment(),a) #define DeleteRouter(a) EnvDeleteRouter(GetCurrentEnvironment(),a) #endif LOCALE void InitializeDefaultRouters(void *); LOCALE int EnvPrintRouter(void *,char *,char *); LOCALE int EnvGetcRouter(void *,char *); LOCALE int EnvUngetcRouter(void *,int,char *); LOCALE void EnvExitRouter(void *,int); LOCALE void AbortExit(void *); LOCALE intBool EnvAddRouterWithContext(void *, char *,int, int (*)(void *,char *), int (*)(void *,char *,char *), int (*)(void *,char *), int (*)(void *,int,char *), int (*)(void *,int), void *); LOCALE intBool EnvAddRouter(void *, char *,int, int (*)(void *,char *), int (*)(void *,char *,char *), int (*)(void *,char *), int (*)(void *,int,char *), int (*)(void *,int)); LOCALE intBool AddRouter(char *,int, int (*)(char *), int (*)(char *,char *), int (*)(char *), int (*)(int,char *), int (*)(int)); LOCALE int EnvDeleteRouter(void *,char *); LOCALE int QueryRouters(void *,char *); LOCALE int EnvDeactivateRouter(void *,char *); LOCALE int EnvActivateRouter(void *,char *); LOCALE void SetFastLoad(void *,FILE *); LOCALE void SetFastSave(void *,FILE *); LOCALE FILE *GetFastLoad(void *); LOCALE FILE *GetFastSave(void *); LOCALE void UnrecognizedRouterMessage(void *,char *); LOCALE void ExitCommand(void *); LOCALE int PrintNRouter(void *,char *,char *,unsigned long); #endif clips-6.24/clipssrc/inscom.c0000755000175000017500000015213710441147426014202 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* INSTANCE COMMAND MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Kernel Interface Commands for Instances */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Loading a binary instance file from a run-time */ /* program caused a bus error. DR0866 */ /* */ /* Removed LOGICAL_DEPENDENCIES compilation flag. */ /* */ /* Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "classinf.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "evaluatn.h" #include "insfile.h" #include "insfun.h" #include "insmngr.h" #include "insmoddp.h" #include "insmult.h" #include "inspsr.h" #include "lgcldpnd.h" #include "memalloc.h" #include "msgcom.h" #include "msgfun.h" #include "router.h" #include "strngrtr.h" #include "sysdep.h" #include "utility.h" #include "commline.h" #define _INSCOM_SOURCE_ #include "inscom.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define ALL_QUALIFIER "inherit" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS static long ListInstancesInModule(void *,int,char *,char *,intBool,intBool); static long TabulateInstances(void *,int,char *,DEFCLASS *,intBool,intBool); #endif static void PrintInstance(void *,char *,INSTANCE_TYPE *,char *); static INSTANCE_SLOT *FindISlotByName(void *,INSTANCE_TYPE *,char *); static void DeallocateInstanceData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************* NAME : SetupInstances DESCRIPTION : Initializes instance Hash Table, Function Parsers, and Data Structures INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None *********************************************************/ globle void SetupInstances( void *theEnv) { struct patternEntityRecord instanceInfo = { { "INSTANCE_ADDRESS", INSTANCE_ADDRESS,0,0,0, PrintInstanceName, PrintInstanceLongForm, EnvUnmakeInstance, NULL, EnvGetNextInstance, EnvDecrementInstanceCount, EnvIncrementInstanceCount, NULL,NULL,NULL,NULL }, #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM DecrementObjectBasisCount, IncrementObjectBasisCount, MatchObjectFunction, NetworkSynchronized #else NULL,NULL,NULL,NULL #endif }; INSTANCE_TYPE dummyInstance = { { NULL }, NULL,NULL, 0, 1 }; AllocateEnvironmentData(theEnv,INSTANCE_DATA,sizeof(struct instanceData),DeallocateInstanceData); InstanceData(theEnv)->MkInsMsgPass = TRUE; memcpy(&InstanceData(theEnv)->InstanceInfo,&instanceInfo,sizeof(struct patternEntityRecord)); dummyInstance.header.theInfo = &InstanceData(theEnv)->InstanceInfo; memcpy(&InstanceData(theEnv)->DummyInstance,&dummyInstance,sizeof(INSTANCE_TYPE)); InitializeInstanceTable(theEnv); InstallPrimitive(theEnv,(struct entityRecord *) &InstanceData(theEnv)->InstanceInfo,INSTANCE_ADDRESS); #if ! RUN_TIME #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM EnvDefineFunction2(theEnv,"initialize-instance",'u', PTIEF InactiveInitializeInstance,"InactiveInitializeInstance",NULL); EnvDefineFunction2(theEnv,"active-initialize-instance",'u', PTIEF InitializeInstanceCommand,"InitializeInstanceCommand",NULL); AddFunctionParser(theEnv,"active-initialize-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"make-instance",'u',PTIEF InactiveMakeInstance,"InactiveMakeInstance",NULL); EnvDefineFunction2(theEnv,"active-make-instance",'u',PTIEF MakeInstanceCommand,"MakeInstanceCommand",NULL); AddFunctionParser(theEnv,"active-make-instance",ParseInitializeInstance); #else EnvDefineFunction2(theEnv,"initialize-instance",'u', PTIEF InitializeInstanceCommand,"InitializeInstanceCommand",NULL); EnvDefineFunction2(theEnv,"make-instance",'u',PTIEF MakeInstanceCommand,"MakeInstanceCommand",NULL); #endif AddFunctionParser(theEnv,"initialize-instance",ParseInitializeInstance); AddFunctionParser(theEnv,"make-instance",ParseInitializeInstance); EnvDefineFunction2(theEnv,"init-slots",'u',PTIEF InitSlotsCommand,"InitSlotsCommand","00"); EnvDefineFunction2(theEnv,"delete-instance",'b',PTIEF DeleteInstanceCommand, "DeleteInstanceCommand","00"); EnvDefineFunction2(theEnv,"(create-instance)",'b',PTIEF CreateInstanceHandler, "CreateInstanceHandler","00"); EnvDefineFunction2(theEnv,"unmake-instance",'b',PTIEF UnmakeInstanceCommand, "UnmakeInstanceCommand","1*e"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"instances",'v',PTIEF InstancesCommand,"InstancesCommand","*3w"); EnvDefineFunction2(theEnv,"ppinstance",'v',PTIEF PPInstanceCommand,"PPInstanceCommand","00"); #endif EnvDefineFunction2(theEnv,"symbol-to-instance-name",'u', PTIEF SymbolToInstanceName,"SymbolToInstanceName","11w"); EnvDefineFunction2(theEnv,"instance-name-to-symbol",'w', PTIEF InstanceNameToSymbol,"InstanceNameToSymbol","11p"); EnvDefineFunction2(theEnv,"instance-address",'u',PTIEF InstanceAddressCommand, "InstanceAddressCommand","12eep"); EnvDefineFunction2(theEnv,"instance-addressp",'b',PTIEF InstanceAddressPCommand, "InstanceAddressPCommand","11"); EnvDefineFunction2(theEnv,"instance-namep",'b',PTIEF InstanceNamePCommand, "InstanceNamePCommand","11"); EnvDefineFunction2(theEnv,"instance-name",'u',PTIEF InstanceNameCommand, "InstanceNameCommand","11e"); EnvDefineFunction2(theEnv,"instancep",'b',PTIEF InstancePCommand,"InstancePCommand","11"); EnvDefineFunction2(theEnv,"instance-existp",'b',PTIEF InstanceExistPCommand, "InstanceExistPCommand","11e"); EnvDefineFunction2(theEnv,"class",'u',PTIEF ClassCommand,"ClassCommand","11"); SetupInstanceModDupCommands(theEnv); /* SetupInstanceFileCommands(theEnv); DR0866 */ SetupInstanceMultifieldCommands(theEnv); #endif SetupInstanceFileCommands(theEnv); /* DR0866 */ AddCleanupFunction(theEnv,"instances",CleanupInstances,0); EnvAddResetFunction(theEnv,"instances",DestroyAllInstances,60); } /***************************************/ /* DeallocateInstanceData: Deallocates */ /* environment data for instances. */ /***************************************/ static void DeallocateInstanceData( void *theEnv) { INSTANCE_TYPE *tmpIPtr, *nextIPtr; register unsigned i; INSTANCE_SLOT *sp; IGARBAGE *tmpGPtr, *nextGPtr; struct patternMatch *theMatch, *tmpMatch; /*=================================*/ /* Remove the instance hash table. */ /*=================================*/ rm(theEnv,InstanceData(theEnv)->InstanceTable, (int) (sizeof(INSTANCE_TYPE *) * INSTANCE_TABLE_HASH_SIZE)); /*=======================*/ /* Return all instances. */ /*=======================*/ tmpIPtr = InstanceData(theEnv)->InstanceList; while (tmpIPtr != NULL) { nextIPtr = tmpIPtr->nxtList; theMatch = (struct patternMatch *) tmpIPtr->partialMatchList; while (theMatch != NULL) { tmpMatch = theMatch->next; rtn_struct(theEnv,patternMatch,theMatch); theMatch = tmpMatch; } #if DEFRULE_CONSTRUCT ReturnEntityDependencies(theEnv,(struct patternEntity *) tmpIPtr); #endif for (i = 0 ; i < tmpIPtr->cls->instanceSlotCount ; i++) { sp = tmpIPtr->slotAddresses[i]; if ((sp == &sp->desc->sharedValue) ? (--sp->desc->sharedCount == 0) : TRUE) { if (sp->desc->multiple) { ReturnMultifield(theEnv,(MULTIFIELD_PTR) sp->value); } } } if (tmpIPtr->cls->instanceSlotCount != 0) { rm(theEnv,(void *) tmpIPtr->slotAddresses, (tmpIPtr->cls->instanceSlotCount * sizeof(INSTANCE_SLOT *))); if (tmpIPtr->cls->localInstanceSlotCount != 0) { rm(theEnv,(void *) tmpIPtr->slots, (tmpIPtr->cls->localInstanceSlotCount * sizeof(INSTANCE_SLOT))); } } rtn_struct(theEnv,instance,tmpIPtr); tmpIPtr = nextIPtr; } /*===============================*/ /* Get rid of garbage instances. */ /*===============================*/ tmpGPtr = InstanceData(theEnv)->InstanceGarbageList; while (tmpGPtr != NULL) { nextGPtr = tmpGPtr->nxt; rtn_struct(theEnv,instance,tmpGPtr->ins); rtn_struct(theEnv,igarbage,tmpGPtr); tmpGPtr = nextGPtr; } } /******************************************************************* NAME : EnvDeleteInstance DESCRIPTION : DIRECTLY removes a named instance from the hash table and its class's instance list INPUTS : The instance address (NULL to delete all instances) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Instance is deallocated NOTES : C interface for deleting instances *******************************************************************/ globle intBool EnvDeleteInstance( void *theEnv, void *iptr) { INSTANCE_TYPE *ins,*itmp; int success = 1; if (iptr != NULL) return(QuashInstance(theEnv,(INSTANCE_TYPE *) iptr)); ins = InstanceData(theEnv)->InstanceList; while (ins != NULL) { itmp = ins; ins = ins->nxtList; if (QuashInstance(theEnv,(INSTANCE_TYPE *) itmp) == 0) success = 0; } if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } return(success); } /******************************************************************* NAME : EnvUnmakeInstance DESCRIPTION : Removes a named instance via message-passing INPUTS : The instance address (NULL to delete all instances) RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Instance is deallocated NOTES : C interface for deleting instances *******************************************************************/ globle intBool EnvUnmakeInstance( void *theEnv, void *iptr) { INSTANCE_TYPE *ins; int success = 1,svmaintain; svmaintain = InstanceData(theEnv)->MaintainGarbageInstances; InstanceData(theEnv)->MaintainGarbageInstances = TRUE; ins = (INSTANCE_TYPE *) iptr; if (ins != NULL) { if (ins->garbage) success = 0; else { DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL); if (ins->garbage == 0) success = 0; } } else { ins = InstanceData(theEnv)->InstanceList; while (ins != NULL) { DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL); if (ins->garbage == 0) success = 0; ins = ins->nxtList; while ((ins != NULL) ? ins->garbage : FALSE) ins = ins->nxtList; } } InstanceData(theEnv)->MaintainGarbageInstances = svmaintain; CleanupInstances(theEnv); if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } return(success); } #if DEBUGGING_FUNCTIONS /******************************************************************* NAME : InstancesCommand DESCRIPTION : Lists all instances associated with a particular class INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (instances [ [inherit]]) *******************************************************************/ globle void InstancesCommand( void *theEnv) { int argno, inheritFlag = FALSE; void *theDefmodule; char *className = NULL; DATA_OBJECT temp; theDefmodule = (void *) EnvGetCurrentModule(theEnv); argno = EnvRtnArgCount(theEnv); if (argno > 0) { if (EnvArgTypeCheck(theEnv,"instances",1,SYMBOL,&temp) == FALSE) return; theDefmodule = EnvFindDefmodule(theEnv,DOToString(temp)); if ((theDefmodule != NULL) ? FALSE : (strcmp(DOToString(temp),"*") != 0)) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"instances",1,"defmodule name"); return; } if (argno > 1) { if (EnvArgTypeCheck(theEnv,"instances",2,SYMBOL,&temp) == FALSE) return; className = DOToString(temp); if (LookupDefclassAnywhere(theEnv,(struct defmodule *) theDefmodule,className) == NULL) { if (strcmp(className,"*") == 0) className = NULL; else { ClassExistError(theEnv,"instances",className); return; } } if (argno > 2) { if (EnvArgTypeCheck(theEnv,"instances",3,SYMBOL,&temp) == FALSE) return; if (strcmp(DOToString(temp),ALL_QUALIFIER) != 0) { SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"instances",3,"keyword \"inherit\""); return; } inheritFlag = TRUE; } } } EnvInstances(theEnv,WDISPLAY,theDefmodule,className,inheritFlag); } /******************************************************** NAME : PPInstanceCommand DESCRIPTION : Displays the current slot-values of an instance INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (ppinstance ) ********************************************************/ globle void PPInstanceCommand( void *theEnv) { INSTANCE_TYPE *ins; if (CheckCurrentMessage(theEnv,"ppinstance",TRUE) == FALSE) return; ins = GetActiveInstance(theEnv); if (ins->garbage == 1) return; PrintInstance(theEnv,WDISPLAY,ins,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } /*************************************************************** NAME : EnvInstances DESCRIPTION : Lists instances of classes INPUTS : 1) The logical name for the output 2) Address of the module (NULL for all classes) 3) Name of the class (NULL for all classes in specified module) 4) A flag indicating whether to print instances of subclasses or not RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None **************************************************************/ globle void EnvInstances( void *theEnv, char *logicalName, void *theVModule, char *className, int inheritFlag) { int id; struct defmodule *theModule; long count = 0L; /* =========================================== Grab a traversal id to avoid printing out instances twice due to multiple inheritance =========================================== */ if ((id = GetTraversalID(theEnv)) == -1) return; SaveCurrentModule(theEnv); /* ==================================== For all modules, print out instances of specified class(es) ==================================== */ if (theVModule == NULL) { theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { if (GetHaltExecution(theEnv) == TRUE) { RestoreCurrentModule(theEnv); ReleaseTraversalID(theEnv); return; } EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,logicalName,":\n"); EnvSetCurrentModule(theEnv,(void *) theModule); count += ListInstancesInModule(theEnv,id,logicalName,className,inheritFlag,TRUE); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } } /* ==================================== For the specified module, print out instances of the specified class(es) ==================================== */ else { EnvSetCurrentModule(theEnv,(void *) theVModule); count = ListInstancesInModule(theEnv,id,logicalName,className,inheritFlag,FALSE); } RestoreCurrentModule(theEnv); ReleaseTraversalID(theEnv); if (EvaluationData(theEnv)->HaltExecution == FALSE) PrintTally(theEnv,logicalName,count,"instance","instances"); } #endif /********************************************************* NAME : EnvMakeInstance DESCRIPTION : C Interface for creating and initializing a class instance INPUTS : The make-instance call string, e.g. "([bill] of man (age 34))" RETURNS : The instance address if instance created, NULL otherwise SIDE EFFECTS : Creates the instance and returns the result in caller's buffer NOTES : None *********************************************************/ globle void *EnvMakeInstance( void *theEnv, char *mkstr) { char *router = "***MKINS***"; struct token tkn; EXPRESSION *top; DATA_OBJECT result; result.type = SYMBOL; result.value = EnvFalseSymbol(theEnv); if (OpenStringSource(theEnv,router,mkstr,0) == 0) return(NULL); GetToken(theEnv,router,&tkn); if (tkn.type == LPAREN) { top = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance")); if (ParseSimpleInstance(theEnv,top,router) != NULL) { GetToken(theEnv,router,&tkn); if (tkn.type == STOP) { ExpressionInstall(theEnv,top); EvaluateExpression(theEnv,top,&result); ExpressionDeinstall(theEnv,top); } else SyntaxErrorMessage(theEnv,"instance definition"); ReturnExpression(theEnv,top); } } else SyntaxErrorMessage(theEnv,"instance definition"); CloseStringSource(theEnv,router); if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } if ((result.type == SYMBOL) && (result.value == EnvFalseSymbol(theEnv))) return(NULL); return((void *) FindInstanceBySymbol(theEnv,(SYMBOL_HN *) result.value)); } /*************************************************************** NAME : EnvCreateRawInstance DESCRIPTION : Creates an empty of instance of the specified class. No slot-overrides or class defaults are applied. INPUTS : 1) Address of class 2) Name of the new instance RETURNS : The instance address if instance created, NULL otherwise SIDE EFFECTS : Old instance of same name deleted (if possible) NOTES : None ***************************************************************/ globle void *EnvCreateRawInstance( void *theEnv, void *cptr, char *iname) { return((void *) BuildInstance(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,iname),(DEFCLASS *) cptr,FALSE)); } /*************************************************************************** NAME : EnvFindInstance DESCRIPTION : Looks up a specified instance in the instance hash table INPUTS : Name-string of the instance RETURNS : The address of the found instance, NULL otherwise SIDE EFFECTS : None NOTES : None ***************************************************************************/ globle void *EnvFindInstance( void *theEnv, void *theModule, char *iname, unsigned searchImports) { SYMBOL_HN *isym; isym = FindSymbolHN(theEnv,iname); if (isym == NULL) return(NULL); if (theModule == NULL) theModule = (void *) EnvGetCurrentModule(theEnv); return((void *) FindInstanceInModule(theEnv,isym,(struct defmodule *) theModule, ((struct defmodule *) EnvGetCurrentModule(theEnv)),searchImports)); } /*************************************************************************** NAME : EnvValidInstanceAddress DESCRIPTION : Determines if an instance address is still valid INPUTS : Instance address RETURNS : 1 if the address is still valid, 0 otherwise SIDE EFFECTS : None NOTES : None ***************************************************************************/ #if IBM_TBC #pragma argsused #endif globle int EnvValidInstanceAddress( void *theEnv, void *iptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return((((INSTANCE_TYPE *) iptr)->garbage == 0) ? 1 : 0); } /*************************************************** NAME : EnvDirectGetSlot DESCRIPTION : Gets a slot value INPUTS : 1) Instance address 2) Slot name 3) Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************/ globle void EnvDirectGetSlot( void *theEnv, void *ins, char *sname, DATA_OBJECT *result) { INSTANCE_SLOT *sp; if (((INSTANCE_TYPE *) ins)->garbage == 1) { SetEvaluationError(theEnv,TRUE); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } sp = FindISlotByName(theEnv,(INSTANCE_TYPE *) ins,sname); if (sp == NULL) { SetEvaluationError(theEnv,TRUE); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->type = (unsigned short) sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetInstanceSlotLength(sp)); } PropagateReturnValue(theEnv,result); } /********************************************************* NAME : EnvDirectPutSlot DESCRIPTION : Gets a slot value INPUTS : 1) Instance address 2) Slot name 3) Caller's new value buffer RETURNS : TRUE if put successful, FALSE otherwise SIDE EFFECTS : None NOTES : None *********************************************************/ globle int EnvDirectPutSlot( void *theEnv, void *ins, char *sname, DATA_OBJECT *val) { INSTANCE_SLOT *sp; DATA_OBJECT junk; if ((((INSTANCE_TYPE *) ins)->garbage == 1) || (val == NULL)) { SetEvaluationError(theEnv,TRUE); return(FALSE); } sp = FindISlotByName(theEnv,(INSTANCE_TYPE *) ins,sname); if (sp == NULL) { SetEvaluationError(theEnv,TRUE); return(FALSE); } if (PutSlotValue(theEnv,(INSTANCE_TYPE *) ins,sp,val,&junk,"external put")) { if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL)) { PeriodicCleanup(theEnv,TRUE,FALSE); } return(TRUE); } return(FALSE); } /*************************************************** NAME : GetInstanceName DESCRIPTION : Returns name of instance INPUTS : Pointer to instance RETURNS : Name of instance SIDE EFFECTS : None NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle char *EnvGetInstanceName( void *theEnv, void *iptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (((INSTANCE_TYPE *) iptr)->garbage == 1) return(NULL); return(ValueToString(((INSTANCE_TYPE *) iptr)->name)); } /*************************************************** NAME : EnvGetInstanceClass DESCRIPTION : Returns class of instance INPUTS : Pointer to instance RETURNS : Pointer to class of instance SIDE EFFECTS : None NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle void *EnvGetInstanceClass( void *theEnv, void *iptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (((INSTANCE_TYPE *) iptr)->garbage == 1) return(NULL); return((void *) ((INSTANCE_TYPE *) iptr)->cls); } /*************************************************** NAME : GetGlobalNumberOfInstances DESCRIPTION : Returns the total number of instances in all modules INPUTS : None RETURNS : The instance count SIDE EFFECTS : None NOTES : None ***************************************************/ globle unsigned long GetGlobalNumberOfInstances( void *theEnv) { return(InstanceData(theEnv)->GlobalNumberOfInstances); } /*************************************************** NAME : EnvGetNextInstance DESCRIPTION : Returns next instance in list (or first instance in list) INPUTS : Pointer to previous instance (or NULL to get first instance) RETURNS : The next instance or first instance SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvGetNextInstance( void *theEnv, void *iptr) { if (iptr == NULL) return((void *) InstanceData(theEnv)->InstanceList); if (((INSTANCE_TYPE *) iptr)->garbage == 1) return(NULL); return((void *) ((INSTANCE_TYPE *) iptr)->nxtList); } /*************************************************** NAME : GetNextInstanceInScope DESCRIPTION : Returns next instance in list (or first instance in list) which class is in scope INPUTS : Pointer to previous instance (or NULL to get first instance) RETURNS : The next instance or first instance which class is in scope of the current module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *GetNextInstanceInScope( void *theEnv, void *iptr) { INSTANCE_TYPE *ins = (INSTANCE_TYPE *) iptr; if (ins == NULL) ins = InstanceData(theEnv)->InstanceList; else if (ins->garbage) return(NULL); else ins = ins->nxtList; while (ins != NULL) { if (DefclassInScope(theEnv,ins->cls,NULL)) return((void *) ins); ins = ins->nxtList; } return(NULL); } /*************************************************** NAME : EnvGetNextInstanceInClass DESCRIPTION : Finds next instance of class (or first instance of class) INPUTS : 1) Class address 2) Instance address (NULL to get first instance) RETURNS : The next or first class instance SIDE EFFECTS : None NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif globle void *EnvGetNextInstanceInClass( void *theEnv, void *cptr, void *iptr) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (iptr == NULL) return((void *) ((DEFCLASS *) cptr)->instanceList); if (((INSTANCE_TYPE *) iptr)->garbage == 1) return(NULL); return((void *) ((INSTANCE_TYPE *) iptr)->nxtClass); } /*************************************************** NAME : EnvGetNextInstanceInClassAndSubclasses DESCRIPTION : Finds next instance of class (or first instance of class) and all of its subclasses INPUTS : 1) Class address 2) Instance address (NULL to get first instance) RETURNS : The next or first class instance SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *EnvGetNextInstanceInClassAndSubclasses( void *theEnv, void **cptr, void *iptr, DATA_OBJECT *iterationInfo) { INSTANCE_TYPE *nextInstance; DEFCLASS *theClass; theClass = (DEFCLASS *) *cptr; if (iptr == NULL) { ClassSubclassAddresses(theEnv,theClass,iterationInfo,TRUE); nextInstance = theClass->instanceList; } else if (((INSTANCE_TYPE *) iptr)->garbage == 1) { nextInstance = NULL; } else { nextInstance = ((INSTANCE_TYPE *) iptr)->nxtClass; } while ((nextInstance == NULL) && (GetpDOBegin(iterationInfo) <= GetpDOEnd(iterationInfo))) { theClass = (struct defclass *) GetMFValue(DOPToPointer(iterationInfo), GetpDOBegin(iterationInfo)); *cptr = theClass; SetpDOBegin(iterationInfo,GetpDOBegin(iterationInfo) + 1); nextInstance = theClass->instanceList; } return(nextInstance); } /*************************************************** NAME : EnvGetInstancePPForm DESCRIPTION : Writes slot names and values to caller's buffer INPUTS : 1) Caller's buffer 2) Size of buffer (not including space for terminating '\0') 3) Instance address RETURNS : Nothing useful SIDE EFFECTS : Caller's buffer written NOTES : None ***************************************************/ globle void EnvGetInstancePPForm( void *theEnv, char *buf, unsigned buflen, void *iptr) { char *pbuf = "***InstancePPForm***"; if (((INSTANCE_TYPE *) iptr)->garbage == 1) return; if (OpenStringDestination(theEnv,pbuf,buf,buflen+1) == 0) return; PrintInstance(theEnv,pbuf,(INSTANCE_TYPE *) iptr," "); CloseStringDestination(theEnv,pbuf); } /********************************************************* NAME : ClassCommand DESCRIPTION : Returns the class of an instance INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax : (class ) Can also be called by (type ) if you have generic functions installed *********************************************************/ globle void ClassCommand( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; char *func; DATA_OBJECT temp; func = ValueToString(((struct FunctionDefinition *) EvaluationData(theEnv)->CurrentExpression->value)->callFunctionName); result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,func,0); SetEvaluationError(theEnv,TRUE); return; } result->value = (void *) GetDefclassNamePointer((void *) ins->cls); } else if (temp.type == INSTANCE_NAME) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins == NULL) { NoInstanceError(theEnv,ValueToString(temp.value),func); return; } result->value = (void *) GetDefclassNamePointer((void *) ins->cls); } else { switch (temp.type) { case INTEGER : case FLOAT : case SYMBOL : case STRING : case MULTIFIELD : case EXTERNAL_ADDRESS : case FACT_ADDRESS : result->value = (void *) GetDefclassNamePointer((void *) DefclassData(theEnv)->PrimitiveClassMap[temp.type]); return; default : PrintErrorID(theEnv,"INSCOM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Undefined type in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } } } /****************************************************** NAME : CreateInstanceHandler DESCRIPTION : Message handler called after instance creation INPUTS : None RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : None NOTES : Does nothing. Provided so it can be overridden. ******************************************************/ #if IBM_TBC #pragma argsused #endif globle intBool CreateInstanceHandler( void *theEnv) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(TRUE); } /****************************************************** NAME : DeleteInstanceCommand DESCRIPTION : Removes a named instance from the hash table and its class's instance list INPUTS : None RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Instance is deallocated NOTES : This is an internal function that only be called by a handler ******************************************************/ globle intBool DeleteInstanceCommand( void *theEnv) { if (CheckCurrentMessage(theEnv,"delete-instance",TRUE)) return(QuashInstance(theEnv,GetActiveInstance(theEnv))); return(FALSE); } /******************************************************************** NAME : UnmakeInstanceCommand DESCRIPTION : Uses message-passing to delete the specified instance INPUTS : None RETURNS : TRUE if successful, FALSE otherwise SIDE EFFECTS : Instance is deallocated NOTES : Syntax: (unmake-instance + | *) ********************************************************************/ globle intBool UnmakeInstanceCommand( void *theEnv) { EXPRESSION *theArgument; DATA_OBJECT theResult; INSTANCE_TYPE *ins; int argNumber = 1,rtn = TRUE; theArgument = GetFirstArgument(); while (theArgument != NULL) { EvaluateExpression(theEnv,theArgument,&theResult); if ((theResult.type == INSTANCE_NAME) || (theResult.type == SYMBOL)) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) theResult.value); if ((ins == NULL) ? (strcmp(DOToString(theResult),"*") != 0) : FALSE) { NoInstanceError(theEnv,DOToString(theResult),"unmake-instance"); return(FALSE); } } else if (theResult.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) theResult.value; if (ins->garbage) { StaleInstanceAddress(theEnv,"unmake-instance",0); SetEvaluationError(theEnv,TRUE); return(FALSE); } } else { ExpectedTypeError1(theEnv,"retract",argNumber,"instance-address, instance-name, or the symbol *"); SetEvaluationError(theEnv,TRUE); return(FALSE); } if (EnvUnmakeInstance(theEnv,ins) == FALSE) rtn = FALSE; if (ins == NULL) return(rtn); argNumber++; theArgument = GetNextArgument(theArgument); } return(rtn); } /***************************************************************** NAME : SymbolToInstanceName DESCRIPTION : Converts a symbol from type SYMBOL to type INSTANCE_NAME INPUTS : The address of the value buffer RETURNS : The new INSTANCE_NAME symbol SIDE EFFECTS : None NOTES : H/L Syntax : (symbol-to-instance-name ) *****************************************************************/ globle void SymbolToInstanceName( void *theEnv, DATA_OBJECT *result) { if (EnvArgTypeCheck(theEnv,"symbol-to-instance-name",1,SYMBOL,result) == FALSE) { SetpType(result,SYMBOL); SetpValue(result,EnvFalseSymbol(theEnv)); return; } SetpType(result,INSTANCE_NAME); } /***************************************************************** NAME : InstanceNameToSymbol DESCRIPTION : Converts a symbol from type INSTANCE_NAME to type SYMBOL INPUTS : None RETURNS : Symbol FALSE on errors - or converted instance name SIDE EFFECTS : None NOTES : H/L Syntax : (instance-name-to-symbol ) *****************************************************************/ globle void *InstanceNameToSymbol( void *theEnv) { DATA_OBJECT result; if (EnvArgTypeCheck(theEnv,"instance-name-to-symbol",1,INSTANCE_NAME,&result) == FALSE) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); return((SYMBOL_HN *) result.value); } /********************************************************************************* NAME : InstanceAddressCommand DESCRIPTION : Returns the address of an instance INPUTS : The address of the value buffer RETURNS : Nothing useful SIDE EFFECTS : Stores instance address in caller's buffer NOTES : H/L Syntax : (instance-address [] ) *********************************************************************************/ globle void InstanceAddressCommand( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; DATA_OBJECT temp; struct defmodule *theModule; unsigned searchImports; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvRtnArgCount(theEnv) > 1) { if (EnvArgTypeCheck(theEnv,"instance-address",1,SYMBOL,&temp) == FALSE) return; theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(temp)); if ((theModule == NULL) ? (strcmp(DOToString(temp),"*") != 0) : FALSE) { ExpectedTypeError1(theEnv,"instance-address",1,"module name"); SetEvaluationError(theEnv,TRUE); return; } if (theModule == NULL) { searchImports = TRUE; theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } else searchImports = FALSE; if (EnvArgTypeCheck(theEnv,"instance-address",2,INSTANCE_NAME,&temp) == FALSE) return; ins = FindInstanceInModule(theEnv,(SYMBOL_HN *) temp.value,theModule, ((struct defmodule *) EnvGetCurrentModule(theEnv)),searchImports); if (ins != NULL) { result->type = INSTANCE_ADDRESS; result->value = (void *) ins; } else NoInstanceError(theEnv,ValueToString(temp.value),"instance-address"); } else if (EnvArgTypeCheck(theEnv,"instance-address",1,INSTANCE_OR_INSTANCE_NAME,&temp)) { if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 0) { result->type = INSTANCE_ADDRESS; result->value = temp.value; } else { StaleInstanceAddress(theEnv,"instance-address",0); SetEvaluationError(theEnv,TRUE); } } else { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins != NULL) { result->type = INSTANCE_ADDRESS; result->value = (void *) ins; } else NoInstanceError(theEnv,ValueToString(temp.value),"instance-address"); } } } /*************************************************************** NAME : InstanceNameCommand DESCRIPTION : Gets the name of an INSTANCE INPUTS : The address of the value buffer RETURNS : The INSTANCE_NAME symbol SIDE EFFECTS : None NOTES : H/L Syntax : (instance-name ) ***************************************************************/ globle void InstanceNameCommand( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; DATA_OBJECT temp; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); if (EnvArgTypeCheck(theEnv,"instance-name",1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE) return; if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,"instance-name",0); SetEvaluationError(theEnv,TRUE); return; } } else { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins == NULL) { NoInstanceError(theEnv,ValueToString(temp.value),"instance-name"); return; } } result->type = INSTANCE_NAME; result->value = (void *) ins->name; } /************************************************************** NAME : InstanceAddressPCommand DESCRIPTION : Determines if a value is of type INSTANCE INPUTS : None RETURNS : TRUE if type INSTANCE_ADDRESS, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (instance-addressp ) **************************************************************/ globle intBool InstanceAddressPCommand( void *theEnv) { DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); return((GetType(temp) == INSTANCE_ADDRESS) ? TRUE : FALSE); } /************************************************************** NAME : InstanceNamePCommand DESCRIPTION : Determines if a value is of type INSTANCE_NAME INPUTS : None RETURNS : TRUE if type INSTANCE_NAME, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (instance-namep ) **************************************************************/ globle intBool InstanceNamePCommand( void *theEnv) { DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); return((GetType(temp) == INSTANCE_NAME) ? TRUE : FALSE); } /***************************************************************** NAME : InstancePCommand DESCRIPTION : Determines if a value is of type INSTANCE_ADDRESS or INSTANCE_NAME INPUTS : None RETURNS : TRUE if type INSTANCE_NAME or INSTANCE_ADDRESS, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (instancep ) *****************************************************************/ globle intBool InstancePCommand( void *theEnv) { DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if ((GetType(temp) == INSTANCE_NAME) || (GetType(temp) == INSTANCE_ADDRESS)) return(TRUE); return(FALSE); } /******************************************************** NAME : InstanceExistPCommand DESCRIPTION : Determines if an instance exists INPUTS : None RETURNS : TRUE if instance exists, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (instance-existp ) ********************************************************/ globle intBool InstanceExistPCommand( void *theEnv) { DATA_OBJECT temp; EvaluateExpression(theEnv,GetFirstArgument(),&temp); if (temp.type == INSTANCE_ADDRESS) return((((INSTANCE_TYPE *) temp.value)->garbage == 0) ? TRUE : FALSE); if ((temp.type == INSTANCE_NAME) || (temp.type == SYMBOL)) return((FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value) != NULL) ? TRUE : FALSE); ExpectedTypeError1(theEnv,"instance-existp",1,"instance name, instance address or symbol"); SetEvaluationError(theEnv,TRUE); return(FALSE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if DEBUGGING_FUNCTIONS /*************************************************** NAME : ListInstancesInModule DESCRIPTION : List instances of specified class(es) in a module INPUTS : 1) Traversal id to avoid multiple passes over same class 2) Logical name of output 3) The name of the class (NULL for all classes) 4) Flag indicating whether to include instances of subclasses 5) A flag indicating whether to indent because of module name RETURNS : The number of instances listed SIDE EFFECTS : Instances listed to logical output NOTES : Assumes defclass scope flags are up to date ***************************************************/ static long ListInstancesInModule( void *theEnv, int id, char *logicalName, char *className, intBool inheritFlag, intBool allModulesFlag) { void *theDefclass,*theInstance; long count = 0L; /* =================================== For the specified module, print out instances of all the classes =================================== */ if (className == NULL) { /* ============================================== If instances are being listed for all modules, only list the instances of classes in this module (to avoid listing instances twice) ============================================== */ if (allModulesFlag) { for (theDefclass = EnvGetNextDefclass(theEnv,NULL) ; theDefclass != NULL ; theDefclass = EnvGetNextDefclass(theEnv,theDefclass)) count += TabulateInstances(theEnv,id,logicalName, (DEFCLASS *) theDefclass,FALSE,allModulesFlag); } /* =================================================== If instances are only be listed for one module, list all instances visible to the module (including ones belonging to classes in other modules) =================================================== */ else { theInstance = GetNextInstanceInScope(theEnv,NULL); while (theInstance != NULL) { if (GetHaltExecution(theEnv) == TRUE) { return(count); } count++; PrintInstanceNameAndClass(theEnv,logicalName,(INSTANCE_TYPE *) theInstance,TRUE); theInstance = GetNextInstanceInScope(theEnv,theInstance); } } } /* =================================== For the specified module, print out instances of the specified class =================================== */ else { theDefclass = (void *) LookupDefclassAnywhere(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)),className); if (theDefclass != NULL) { count += TabulateInstances(theEnv,id,logicalName, (DEFCLASS *) theDefclass,inheritFlag,allModulesFlag); } else if (! allModulesFlag) ClassExistError(theEnv,"instances",className); } return(count); } /****************************************************** NAME : TabulateInstances DESCRIPTION : Displays all instances for a class INPUTS : 1) The traversal id for the classes 2) The logical name of the output 3) The class address 4) A flag indicating whether to print out instances of subclasses or not. 5) A flag indicating whether to indent because of module name RETURNS : The number of instances (including subclasses' instances) SIDE EFFECTS : None NOTES : None ******************************************************/ static long TabulateInstances( void *theEnv, int id, char *logicalName, DEFCLASS *cls, intBool inheritFlag, intBool allModulesFlag) { INSTANCE_TYPE *ins; register unsigned i; long count = 0; if (TestTraversalID(cls->traversalRecord,id)) return(0L); SetTraversalID(cls->traversalRecord,id); for (ins = cls->instanceList ; ins != NULL ; ins = ins->nxtClass) { if (EvaluationData(theEnv)->HaltExecution) return(count); if (allModulesFlag) EnvPrintRouter(theEnv,logicalName," "); PrintInstanceNameAndClass(theEnv,logicalName,ins,TRUE); count++; } if (inheritFlag) { for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { if (EvaluationData(theEnv)->HaltExecution) return(count); count += TabulateInstances(theEnv,id,logicalName, cls->directSubclasses.classArray[i],inheritFlag,allModulesFlag); } } return(count); } #endif /*************************************************** NAME : PrintInstance DESCRIPTION : Displays an instance's slots INPUTS : 1) Logical name for output 2) Instance address 3) String used to separate slot printouts RETURNS : Nothing useful SIDE EFFECTS : None NOTES : Assumes instance is valid ***************************************************/ static void PrintInstance( void *theEnv, char *logicalName, INSTANCE_TYPE *ins, char *separator) { register unsigned i; register INSTANCE_SLOT *sp; PrintInstanceNameAndClass(theEnv,logicalName,ins,FALSE); for (i = 0 ; i < ins->cls->instanceSlotCount ; i++) { EnvPrintRouter(theEnv,logicalName,separator); sp = ins->slotAddresses[i]; EnvPrintRouter(theEnv,logicalName,"("); EnvPrintRouter(theEnv,logicalName,ValueToString(sp->desc->slotName->name)); if (sp->type != MULTIFIELD) { EnvPrintRouter(theEnv,logicalName," "); PrintAtom(theEnv,logicalName,(int) sp->type,sp->value); } else if (GetInstanceSlotLength(sp) != 0) { EnvPrintRouter(theEnv,logicalName," "); PrintMultifield(theEnv,logicalName,(MULTIFIELD_PTR) sp->value,0, (long) (GetInstanceSlotLength(sp) - 1),FALSE); } EnvPrintRouter(theEnv,logicalName,")"); } } /*************************************************** NAME : FindISlotByName DESCRIPTION : Looks up an instance slot by instance name and slot name INPUTS : 1) Instance address 2) Instance name-string RETURNS : The instance slot address, NULL if does not exist SIDE EFFECTS : None NOTES : None ***************************************************/ static INSTANCE_SLOT *FindISlotByName( void *theEnv, INSTANCE_TYPE *ins, char *sname) { SYMBOL_HN *ssym; ssym = FindSymbolHN(theEnv,sname); if (ssym == NULL) return(NULL); return(FindInstanceSlot(theEnv,ins,ssym)); } #endif clips-6.24/clipssrc/._cstrncmp.c0000400000175000017500000000075410441602121014724 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco)~)~5TTFL(dFMPSRMWBBLclips-6.24/clipssrc/._generate.h0000400000175000017500000000012207422635012014671 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._pprint.c0000400000175000017500000000061410441163635014416 0ustar jfsjfsMac OS X  2 R:TEXT????22/B2MWBB clips-6.24/clipssrc/strngfun.c0000755000175000017500000010054010357047742014555 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.23 01/31/05 */ /* */ /* STRING FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several string functions */ /* including str-cat, sym-cat, str-length, str-compare, */ /* upcase, lowcase, sub-string, str-index, eval, and */ /* build. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Barry Cameron */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /*************************************************************/ #define _STRNGFUN_SOURCE_ #include "setup.h" #if STRING_FUNCTIONS #include #define _STDIO_INCLUDED_ #include #include #include "argacces.h" #include "constrct.h" #include "cstrcpsr.h" #include "engine.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "extnfunc.h" #include "memalloc.h" #include "prcdrpsr.h" #include "router.h" #include "strngrtr.h" #include "scanner.h" #if DEFRULE_CONSTRUCT #include "drive.h" #endif #include "strngfun.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void StrOrSymCatFunction(void *,DATA_OBJECT_PTR,unsigned short); /******************************************/ /* StringFunctionDefinitions: Initializes */ /* the string manipulation functions. */ /******************************************/ globle void StringFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"str-cat", 'k', PTIEF StrCatFunction, "StrCatFunction", "1*"); EnvDefineFunction2(theEnv,"sym-cat", 'k', PTIEF SymCatFunction, "SymCatFunction", "1*"); EnvDefineFunction2(theEnv,"str-length", 'l', PTIEF StrLengthFunction, "StrLengthFunction", "11j"); EnvDefineFunction2(theEnv,"str-compare", 'l', PTIEF StrCompareFunction, "StrCompareFunction", "23*jji"); EnvDefineFunction2(theEnv,"upcase", 'j', PTIEF UpcaseFunction, "UpcaseFunction", "11j"); EnvDefineFunction2(theEnv,"lowcase", 'j', PTIEF LowcaseFunction, "LowcaseFunction", "11j"); EnvDefineFunction2(theEnv,"sub-string", 's', PTIEF SubStringFunction, "SubStringFunction", "33*iij"); EnvDefineFunction2(theEnv,"str-index", 'u', PTIEF StrIndexFunction, "StrIndexFunction", "22j"); EnvDefineFunction2(theEnv,"eval", 'u', PTIEF EvalFunction, "EvalFunction", "11k"); EnvDefineFunction2(theEnv,"build", 'b', PTIEF BuildFunction, "BuildFunction", "11k"); EnvDefineFunction2(theEnv,"string-to-field", 'u', PTIEF StringToFieldFunction, "StringToFieldFunction", "11j"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /****************************************/ /* StrCatFunction: H/L access routine */ /* for the str-cat function. */ /****************************************/ globle void StrCatFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { StrOrSymCatFunction(theEnv,returnValue,STRING); } /****************************************/ /* SymCatFunction: H/L access routine */ /* for the sym-cat function. */ /****************************************/ globle void SymCatFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { StrOrSymCatFunction(theEnv,returnValue,SYMBOL); } /********************************************************/ /* StrOrSymCatFunction: Driver routine for implementing */ /* the str-cat and sym-cat functions. */ /********************************************************/ static void StrOrSymCatFunction( void *theEnv, DATA_OBJECT_PTR returnValue, unsigned short returnType) { DATA_OBJECT theArg; int numArgs, i, total, j; char *theString; SYMBOL_HN **arrayOfStrings; SYMBOL_HN *hashPtr; char *functionName; /*============================================*/ /* Determine the calling function name. */ /* Store the null string or the symbol nil as */ /* the return value in the event of an error. */ /*============================================*/ SetpType(returnValue,returnType); if (returnType == STRING) { functionName = "str-cat"; SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); } else { functionName = "sym-cat"; SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"nil")); } /*===============================================*/ /* Determine the number of arguments as create a */ /* string array which is large enough to store */ /* the string representation of each argument. */ /*===============================================*/ numArgs = EnvRtnArgCount(theEnv); arrayOfStrings = (SYMBOL_HN **) gm1(theEnv,(int) sizeof(SYMBOL_HN *) * numArgs); for (i = 0; i < numArgs; i++) { arrayOfStrings[i] = NULL; } /*=============================================*/ /* Evaluate each argument and store its string */ /* representation in the string array. */ /*=============================================*/ total = 1; for (i = 1 ; i <= numArgs ; i++) { EnvRtnUnknown(theEnv,i,&theArg); switch(GetType(theArg)) { case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif case SYMBOL: hashPtr = (SYMBOL_HN *) GetValue(theArg); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; case FLOAT: hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,FloatToString(theEnv,ValueToDouble(GetValue(theArg)))); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; case INTEGER: hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,LongIntegerToString(theEnv,ValueToLong(GetValue(theArg)))); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; default: ExpectedTypeError1(theEnv,functionName,i,"string, instance name, symbol, float, or integer"); SetEvaluationError(theEnv,TRUE); break; } if (EvaluationData(theEnv)->EvaluationError) { for (i = 0; i < numArgs; i++) { if (arrayOfStrings[i] != NULL) { DecrementSymbolCount(theEnv,arrayOfStrings[i]); } } rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs); return; } total += (int) strlen(ValueToString(arrayOfStrings[i - 1])); } /*=========================================================*/ /* Allocate the memory to store the concatenated string or */ /* symbol, then copy the values in the string array to the */ /* memory just allocated. */ /*=========================================================*/ theString = (char *) gm2(theEnv,(sizeof(char) * total)); j = 0; for (i = 0 ; i < numArgs ; i++) { sprintf(&theString[j],"%s",ValueToString(arrayOfStrings[i])); j += (int) strlen(ValueToString(arrayOfStrings[i])); } /*=========================================*/ /* Return the concatenated value and clean */ /* up the temporary memory used. */ /*=========================================*/ SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,theString)); rm(theEnv,theString,sizeof(char) * total); for (i = 0; i < numArgs; i++) { if (arrayOfStrings[i] != NULL) { DecrementSymbolCount(theEnv,arrayOfStrings[i]); } } rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs); } /*******************************************/ /* StrLengthFunction: H/L access routine */ /* for the str-length function. */ /*******************************************/ globle long int StrLengthFunction( void *theEnv) { DATA_OBJECT theArg; /*===================================================*/ /* Function str-length expects exactly one argument. */ /*===================================================*/ if (EnvArgCountCheck(theEnv,"str-length",EXACTLY,1) == -1) { return(-1L); } /*==================================================*/ /* The argument should be of type symbol or string. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"str-length",1,SYMBOL_OR_STRING,&theArg) == FALSE) { return(-1L); } /*============================================*/ /* Return the length of the string or symbol. */ /*============================================*/ return( (long) strlen(DOToString(theArg))); } /****************************************/ /* UpcaseFunction: H/L access routine */ /* for the upcase function. */ /****************************************/ globle void UpcaseFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theArg; unsigned i; size_t slen; char *osptr, *nsptr; /*===============================================*/ /* Function upcase expects exactly one argument. */ /*===============================================*/ if (EnvArgCountCheck(theEnv,"upcase",EXACTLY,1) == -1) { SetpType(returnValue,STRING); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); return; } /*==================================================*/ /* The argument should be of type symbol or string. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"upcase",1,SYMBOL_OR_STRING,&theArg) == FALSE) { SetpType(returnValue,STRING); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); return; } /*======================================================*/ /* Allocate temporary memory and then copy the original */ /* string or symbol to that memory, while uppercasing */ /* lower case alphabetic characters. */ /*======================================================*/ osptr = DOToString(theArg); slen = strlen(osptr) + 1; nsptr = (char *) gm2(theEnv,slen); for (i = 0 ; i < slen ; i++) { if (islower(osptr[i])) { nsptr[i] = (char) toupper(osptr[i]); } else { nsptr[i] = osptr[i]; } } /*========================================*/ /* Return the uppercased string and clean */ /* up the temporary memory used. */ /*========================================*/ SetpType(returnValue,GetType(theArg)); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,nsptr)); rm(theEnv,nsptr,slen); } /*****************************************/ /* LowcaseFunction: H/L access routine */ /* for the lowcase function. */ /*****************************************/ globle void LowcaseFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theArg; unsigned i; size_t slen; char *osptr, *nsptr; /*================================================*/ /* Function lowcase expects exactly one argument. */ /*================================================*/ if (EnvArgCountCheck(theEnv,"lowcase",EXACTLY,1) == -1) { SetpType(returnValue,STRING); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); return; } /*==================================================*/ /* The argument should be of type symbol or string. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"lowcase",1,SYMBOL_OR_STRING,&theArg) == FALSE) { SetpType(returnValue,STRING); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); return; } /*======================================================*/ /* Allocate temporary memory and then copy the original */ /* string or symbol to that memory, while lowercasing */ /* upper case alphabetic characters. */ /*======================================================*/ osptr = DOToString(theArg); slen = strlen(osptr) + 1; nsptr = (char *) gm2(theEnv,slen); for (i = 0 ; i < slen ; i++) { if (isupper(osptr[i])) { nsptr[i] = (char) tolower(osptr[i]); } else { nsptr[i] = osptr[i]; } } /*========================================*/ /* Return the lowercased string and clean */ /* up the temporary memory used. */ /*========================================*/ SetpType(returnValue,GetType(theArg)); SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,nsptr)); rm(theEnv,nsptr,slen); } /********************************************/ /* StrCompareFunction: H/L access routine */ /* for the str-compare function. */ /********************************************/ globle long int StrCompareFunction( void *theEnv) { int numArgs, length; DATA_OBJECT arg1, arg2, arg3; long returnValue; /*=======================================================*/ /* Function str-compare expects either 2 or 3 arguments. */ /*=======================================================*/ if ((numArgs = EnvArgRangeCheck(theEnv,"str-compare",2,3)) == -1) return(0L); /*=============================================================*/ /* The first two arguments should be of type symbol or string. */ /*=============================================================*/ if (EnvArgTypeCheck(theEnv,"str-compare",1,SYMBOL_OR_STRING,&arg1) == FALSE) { return(0L); } if (EnvArgTypeCheck(theEnv,"str-compare",2,SYMBOL_OR_STRING,&arg2) == FALSE) { return(0L); } /*===================================================*/ /* Compare the strings. Use the 3rd argument for the */ /* maximum length of comparison, if it is provided. */ /*===================================================*/ if (numArgs == 3) { if (EnvArgTypeCheck(theEnv,"str-compare",3,INTEGER,&arg3) == FALSE) { return(0L); } length = CoerceToInteger(GetType(arg3),GetValue(arg3)); returnValue = strncmp(DOToString(arg1),DOToString(arg2), (STD_SIZE) length); } else { returnValue = strcmp(DOToString(arg1),DOToString(arg2)); } /*========================================================*/ /* Return Values are as follows: */ /* -1 is returned if is less than . */ /* 1 is return if is greater than . */ /* 0 is returned if is equal to . */ /*========================================================*/ if (returnValue < 0) returnValue = -1; else if (returnValue > 0) returnValue = 1; return(returnValue); } /*******************************************/ /* SubStringFunction: H/L access routine */ /* for the sub-string function. */ /*******************************************/ globle void *SubStringFunction( void *theEnv) { DATA_OBJECT theArgument; char *tempString, *returnString; int start, end, i, j; void *returnValue; /*===================================*/ /* Check and retrieve the arguments. */ /*===================================*/ if (EnvArgCountCheck(theEnv,"sub-string",EXACTLY,3) == -1) { return((void *) EnvAddSymbol(theEnv,"")); } if (EnvArgTypeCheck(theEnv,"sub-string",1,INTEGER,&theArgument) == FALSE) { return((void *) EnvAddSymbol(theEnv,"")); } start = CoerceToInteger(theArgument.type,theArgument.value) - 1; if (EnvArgTypeCheck(theEnv,"sub-string",2,INTEGER,&theArgument) == FALSE) { return((void *) EnvAddSymbol(theEnv,"")); } end = CoerceToInteger(theArgument.type,theArgument.value) - 1; if (EnvArgTypeCheck(theEnv,"sub-string",3,SYMBOL_OR_STRING,&theArgument) == FALSE) { return((void *) EnvAddSymbol(theEnv,"")); } /*================================================*/ /* If parameters are out of range return an error */ /*================================================*/ if (start < 0) start = 0; if (end > (int) strlen(DOToString(theArgument))) { end = (int) strlen(DOToString(theArgument)); } /*==================================*/ /* If the start is greater than the */ /* end, return a null string. */ /*==================================*/ if (start > end) { return((void *) EnvAddSymbol(theEnv,"")); } /*=============================================*/ /* Otherwise, allocate the string and copy the */ /* designated portion of the old string to the */ /* new string. */ /*=============================================*/ else { returnString = (char *) gm2(theEnv,(unsigned) (end - start + 2)); /* (end - start) inclusive + EOS */ tempString = DOToString(theArgument); for(j=0, i=start;i <= end; i++, j++) { *(returnString+j) = *(tempString+i); } *(returnString+j) = '\0'; } /*========================*/ /* Return the new string. */ /*========================*/ returnValue = (void *) EnvAddSymbol(theEnv,returnString); rm(theEnv,returnString,(unsigned) (end - start + 2)); return(returnValue); } /******************************************/ /* StrIndexFunction: H/L access routine */ /* for the sub-index function. */ /******************************************/ globle void StrIndexFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT theArgument1, theArgument2; char *strg1, *strg2; int i, j; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); /*===================================*/ /* Check and retrieve the arguments. */ /*===================================*/ if (EnvArgCountCheck(theEnv,"str-index",EXACTLY,2) == -1) return; if (EnvArgTypeCheck(theEnv,"str-index",1,SYMBOL_OR_STRING,&theArgument1) == FALSE) return; if (EnvArgTypeCheck(theEnv,"str-index",2,SYMBOL_OR_STRING,&theArgument2) == FALSE) return; strg1 = DOToString(theArgument1); strg2 = DOToString(theArgument2); /*=================================*/ /* Find the position in string2 of */ /* string1 (counting from 1). */ /*=================================*/ if (strlen(strg1) == 0) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,(long) strlen(strg2) + 1L); return; } for (i=1; *strg2; i++, strg2++) { for (j=0; *(strg1+j) && *(strg1+j) == *(strg2+j); j++) { /* Do Nothing */ } if (*(strg1+j) == '\0') { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,(long) i); return; } } return; } /********************************************/ /* StringToFieldFunction: H/L access routine */ /* for the string-to-field function. */ /********************************************/ globle void StringToFieldFunction( void *theEnv, DATA_OBJECT *returnValue) { DATA_OBJECT theArg; /*========================================================*/ /* Function string-to-field expects exactly one argument. */ /*========================================================*/ if (EnvArgCountCheck(theEnv,"string-to-field",EXACTLY,1) == -1) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***"); return; } /*==================================================*/ /* The argument should be of type symbol or string. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"string-to-field",1,SYMBOL_OR_STRING,&theArg) == FALSE) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***"); return; } /*================================*/ /* Convert the string to an atom. */ /*================================*/ StringToField(theEnv,DOToString(theArg),returnValue); } /*************************************************************/ /* StringToField: Converts a string to an atomic data value. */ /*************************************************************/ globle void StringToField( void *theEnv, char *theString, DATA_OBJECT *returnValue) { struct token theToken; /*====================================*/ /* Open the string as an input source */ /* and retrieve the first value. */ /*====================================*/ OpenStringSource(theEnv,"string-to-field-str",theString,0); GetToken(theEnv,"string-to-field-str",&theToken); CloseStringSource(theEnv,"string-to-field-str"); /*====================================================*/ /* Copy the token to the return value data structure. */ /*====================================================*/ returnValue->type = theToken.type; if ((theToken.type == FLOAT) || (theToken.type == STRING) || #if OBJECT_SYSTEM (theToken.type == INSTANCE_NAME) || #endif (theToken.type == SYMBOL) || (theToken.type == INTEGER)) { returnValue->value = theToken.value; } else if (theToken.type == STOP) { returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF"); } else if (theToken.type == UNKNOWN_VALUE) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***"); } else { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,theToken.printForm); } } #if (! RUN_TIME) && (! BLOAD_ONLY) /**************************************/ /* EvalFunction: H/L access routine */ /* for the eval function. */ /**************************************/ globle void EvalFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theArg; /*=============================================*/ /* Function eval expects exactly one argument. */ /*=============================================*/ if (EnvArgCountCheck(theEnv,"eval",EXACTLY,1) == -1) { SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); return; } /*==================================================*/ /* The argument should be of type SYMBOL or STRING. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"eval",1,SYMBOL_OR_STRING,&theArg) == FALSE) { SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); return; } /*======================*/ /* Evaluate the string. */ /*======================*/ EnvEval(theEnv,DOToString(theArg),returnValue); } /*****************************/ /* EnvEval: C access routine */ /* for the eval function. */ /*****************************/ globle int EnvEval( void *theEnv, char *theString, DATA_OBJECT_PTR returnValue) { struct expr *top; int ov; static int depth = 0; char logicalNameBuffer[20]; struct BindInfo *oldBinds; /*======================================================*/ /* Evaluate the string. Create a different logical name */ /* for use each time the eval function is called. */ /*======================================================*/ depth++; sprintf(logicalNameBuffer,"Eval-%d",depth); if (OpenStringSource(theEnv,logicalNameBuffer,theString,0) == 0) { SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); depth--; return(FALSE); } /*================================================*/ /* Save the current parsing state before routines */ /* are called to parse the eval string. */ /*================================================*/ ov = GetPPBufferStatus(theEnv); SetPPBufferStatus(theEnv,FALSE); oldBinds = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); /*========================================================*/ /* Parse the string argument passed to the eval function. */ /*========================================================*/ top = ParseAtomOrExpression(theEnv,logicalNameBuffer,NULL); /*============================*/ /* Restore the parsing state. */ /*============================*/ SetPPBufferStatus(theEnv,ov); ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBinds); /*===========================================*/ /* Return if an error occured while parsing. */ /*===========================================*/ if (top == NULL) { SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); depth--; return(FALSE); } /*==============================================*/ /* The sequence expansion operator must be used */ /* within the argument list of a function call. */ /*==============================================*/ if ((top->type == MF_GBL_VARIABLE) || (top->type == MF_VARIABLE)) { PrintErrorID(theEnv,"MISCFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n"); SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); ReturnExpression(theEnv,top); depth--; return(FALSE); } /*=======================================*/ /* The expression to be evaluated cannot */ /* contain any local variables. */ /*=======================================*/ if (ExpressionContainsVariables(top,FALSE)) { PrintErrorID(theEnv,"STRNGFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Some variables could not be accessed by the eval function.\n"); SetEvaluationError(theEnv,TRUE); CloseStringSource(theEnv,logicalNameBuffer); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); ReturnExpression(theEnv,top); depth--; return(FALSE); } /*====================================*/ /* Evaluate the expression and return */ /* the memory used to parse it. */ /*====================================*/ ExpressionInstall(theEnv,top); EvaluateExpression(theEnv,top,returnValue); ExpressionDeinstall(theEnv,top); depth--; ReturnExpression(theEnv,top); CloseStringSource(theEnv,logicalNameBuffer); if (GetEvaluationError(theEnv)) return(FALSE); return(TRUE); } #else /*************************************************/ /* EvalFunction: This is the non-functional stub */ /* provided for use with a run-time version. */ /*************************************************/ globle void EvalFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { PrintErrorID(theEnv,"STRNGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function eval does not work in run time modules.\n"); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); } /*****************************************************/ /* EnvEval: This is the non-functional stub provided */ /* for use with a run-time version. */ /*****************************************************/ globle int EnvEval( void *theEnv, char *theString, DATA_OBJECT_PTR returnValue) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theString) #endif PrintErrorID(theEnv,"STRNGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function eval does not work in run time modules.\n"); SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); return(FALSE); } #endif #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************/ /* BuildFunction: H/L access routine */ /* for the build function. */ /***************************************/ globle int BuildFunction( void *theEnv) { DATA_OBJECT theArg; /*==============================================*/ /* Function build expects exactly one argument. */ /*==============================================*/ if (EnvArgCountCheck(theEnv,"build",EXACTLY,1) == -1) return(FALSE); /*==================================================*/ /* The argument should be of type SYMBOL or STRING. */ /*==================================================*/ if (EnvArgTypeCheck(theEnv,"build",1,SYMBOL_OR_STRING,&theArg) == FALSE) { return(FALSE); } /*======================*/ /* Build the construct. */ /*======================*/ return(EnvBuild(theEnv,DOToString(theArg))); } /******************************/ /* EnvBuild: C access routine */ /* for the build function. */ /******************************/ globle int EnvBuild( void *theEnv, char *theString) { char *constructType; struct token theToken; int errorFlag; /*====================================================*/ /* No additions during defrule join network activity. */ /*====================================================*/ #if DEFRULE_CONSTRUCT if (EngineData(theEnv)->JoinOperationInProgress) return(FALSE); #endif /*===========================================*/ /* Create a string source router so that the */ /* string can be used as an input source. */ /*===========================================*/ if (OpenStringSource(theEnv,"build",theString,0) == 0) { return(FALSE); } /*================================*/ /* The first token of a construct */ /* must be a left parenthesis. */ /*================================*/ GetToken(theEnv,"build",&theToken); if (theToken.type != LPAREN) { CloseStringSource(theEnv,"build"); return(FALSE); } /*==============================================*/ /* The next token should be the construct type. */ /*==============================================*/ GetToken(theEnv,"build",&theToken); if (theToken.type != SYMBOL) { CloseStringSource(theEnv,"build"); return(FALSE); } constructType = ValueToString(theToken.value); /*======================*/ /* Parse the construct. */ /*======================*/ errorFlag = ParseConstruct(theEnv,constructType,"build"); /*=================================*/ /* Close the string source router. */ /*=================================*/ CloseStringSource(theEnv,"build"); /*=========================================*/ /* If an error occured while parsing the */ /* construct, then print an error message. */ /*=========================================*/ if (errorFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); } DestroyPPBuffer(theEnv); /*===============================================*/ /* Return TRUE if the construct was successfully */ /* parsed, otherwise return FALSE. */ /*===============================================*/ if (errorFlag == 0) return(TRUE); return(FALSE); } #else /**************************************************/ /* BuildFunction: This is the non-functional stub */ /* provided for use with a run-time version. */ /**************************************************/ globle int BuildFunction( void *theEnv) { PrintErrorID(theEnv,"STRNGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function build does not work in run time modules.\n"); return(FALSE); } /******************************************************/ /* EnvBuild: This is the non-functional stub provided */ /* for use with a run-time version. */ /******************************************************/ globle int EnvBuild( void *theEnv, char *theString) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theString) #endif PrintErrorID(theEnv,"STRNGFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function build does not work in run time modules.\n"); return(FALSE); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* STRING_FUNCTIONS */ clips-6.24/clipssrc/._defins.h0000400000175000017500000000075410441131552014355 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0z,,TTFS aFMWBBMPSRclips-6.24/clipssrc/._objbin.c0000400000175000017500000000075410441073050014341 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0zxTTFS$FMPSRMWBBLclips-6.24/clipssrc/iofun.h0000755000175000017500000000461410441602236014026 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* I/O FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Added the get-char function. */ /* */ /* Moved IllegalLogicalNameMessage function to */ /* argacces.c. */ /* */ /*************************************************************/ #ifndef _H_iofun #define _H_iofun #ifdef LOCALE #undef LOCALE #endif #ifdef _IOFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void IOFunctionDefinitions(void *); #if BASIC_IO LOCALE void PrintoutFunction(void *); LOCALE void ReadFunction(void *,DATA_OBJECT_PTR); LOCALE int OpenFunction(void *); LOCALE int CloseFunction(void *); LOCALE int GetCharFunction(void *); #endif #if EXT_IO LOCALE void ReadlineFunction(void *,DATA_OBJECT_PTR); LOCALE void *FormatFunction(void *); LOCALE int RemoveFunction(void *); LOCALE int RenameFunction(void *); LOCALE void SetLocaleFunction(void *,DATA_OBJECT_PTR); LOCALE void ReadNumberFunction(void *,DATA_OBJECT_PTR); #endif #endif clips-6.24/clipssrc/._modulcmp.c0000400000175000017500000000075410441121235014715 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z TTFS FMWBBMPSRclips-6.24/clipssrc/._parsefun.c0000400000175000017500000000075410441602266014730 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z$K++)TTFL,FMPSRMWBBLclips-6.24/clipssrc/._factgen.h0000400000175000017500000000075407422634625014532 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco@@ݸpbTTFB$(FMWBBMPSRclips-6.24/clipssrc/._rulebin.h0000400000175000017500000000012207422634661014550 0ustar jfsjfsMac OS X  2 RTEXT???? clips-6.24/clipssrc/._textpro.h0000400000175000017500000000061410441126763014615 0ustar jfsjfsMac OS X  2 R:TEXT????22S2MWBB clips-6.24/clipssrc/extnfunc.c0000755000175000017500000005425710441602202014534 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/02/06 */ /* */ /* EXTERNAL FUNCTION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for adding new user or system defined */ /* functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Corrected code to remove run-time program */ /* compiler warning. */ /* */ /*************************************************************/ #define _EXTNFUNC_SOURCE_ #include "setup.h" #include #include #include "constant.h" #include "envrnmnt.h" #include "router.h" #include "memalloc.h" #include "evaluatn.h" #include "extnfunc.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void AddHashFunction(void *,struct FunctionDefinition *); static void InitializeFunctionHashTable(void *); static void DeallocateExternalFunctionData(void *); #if (! RUN_TIME) static int RemoveHashFunction(void *,struct FunctionDefinition *); #endif /*********************************************************/ /* InitializeExternalFunctionData: Allocates environment */ /* data for external functions. */ /*********************************************************/ globle void InitializeExternalFunctionData( void *theEnv) { AllocateEnvironmentData(theEnv,EXTERNAL_FUNCTION_DATA,sizeof(struct externalFunctionData),DeallocateExternalFunctionData); } /***********************************************************/ /* DeallocateExternalFunctionData: Deallocates environment */ /* data for external functions. */ /***********************************************************/ static void DeallocateExternalFunctionData( void *theEnv) { struct FunctionHash *fhPtr, *nextFHPtr; int i; #if ! RUN_TIME struct FunctionDefinition *tmpPtr, *nextPtr; tmpPtr = ExternalFunctionData(theEnv)->ListOfFunctions; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,FunctionDefinition,tmpPtr); tmpPtr = nextPtr; } #endif if (ExternalFunctionData(theEnv)->FunctionHashtable == NULL) { return; } for (i = 0; i < SIZE_FUNCTION_HASH; i++) { fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[i]; while (fhPtr != NULL) { nextFHPtr = fhPtr->next; rtn_struct(theEnv,FunctionHash,fhPtr); fhPtr = nextFHPtr; } } genfree(theEnv,ExternalFunctionData(theEnv)->FunctionHashtable, (int) sizeof (struct FunctionHash *) * SIZE_FUNCTION_HASH); } #if (! RUN_TIME) /************************************************************/ /* DefineFunction: Used to define a system or user external */ /* function so that the KB can access it. */ /************************************************************/ #if (! ENVIRONMENT_API_ONLY) && ALLOW_ENVIRONMENT_GLOBALS globle int DefineFunction( char *name, int returnType, int (*pointer)(void), char *actualName) { void *theEnv; theEnv = GetCurrentEnvironment(); return(DefineFunction3(theEnv,name,returnType, (int (*)(void *)) pointer, actualName,NULL,FALSE)); } #endif /***************************************************************/ /* EnvDefineFunction: Used to define a system or user external */ /* function so that the KB can access it. */ /***************************************************************/ globle int EnvDefineFunction( void *theEnv, char *name, int returnType, int (*pointer)(void *), char *actualName) { return(DefineFunction3(theEnv,name,returnType,pointer,actualName,NULL,TRUE)); } /*************************************************************/ /* DefineFunction2: Used to define a system or user external */ /* function so that the KB can access it. */ /*************************************************************/ #if (! ENVIRONMENT_API_ONLY) && ALLOW_ENVIRONMENT_GLOBALS globle int DefineFunction2( char *name, int returnType, int (*pointer)(void), char *actualName, char *restrictions) { void *theEnv; theEnv = GetCurrentEnvironment(); return(DefineFunction3(theEnv,name,returnType, (int (*)(void *)) pointer, actualName,restrictions,FALSE)); } #endif /*************************************************************/ /* EnvDefineFunction2: Used to define a system or user external */ /* function so that the KB can access it. */ /*************************************************************/ globle int EnvDefineFunction2( void *theEnv, char *name, int returnType, int (*pointer)(void *), char *actualName, char *restrictions) { return(DefineFunction3(theEnv,name,returnType,pointer,actualName,restrictions,TRUE)); } /*************************************************************/ /* DefineFunction3: Used to define a system or user external */ /* function so that the KB can access it. Allows argument */ /* restrictions to be attached to the function. */ /* Return types are: */ /* a - external address */ /* b - boolean integer (converted to symbol) */ /* c - character (converted to symbol) */ /* d - double precision float */ /* f - single precision float (converted to double) */ /* i - integer (converted to long integer) */ /* j - unknown (symbol, string, */ /* or instance name by convention) */ /* k - unknown (symbol or string by convention) */ /* l - long integer */ /* m - unknown (multifield by convention) */ /* n - unknown (integer or float by convention) */ /* o - instance name */ /* s - string */ /* u - unknown */ /* v - void */ /* w - symbol */ /* x - instance address */ /*************************************************************/ globle int DefineFunction3( void *theEnv, char *name, int returnType, int (*pointer)(void *), char *actualName, char *restrictions, intBool environmentAware) { struct FunctionDefinition *newFunction; if ( (returnType != 'a') && (returnType != 'b') && (returnType != 'c') && (returnType != 'd') && (returnType != 'f') && (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; return(1); } /***********************************************/ /* UndefineFunction: Used to remove a function */ /* definition from the list of functions. */ /***********************************************/ globle int UndefineFunction( void *theEnv, char *functionName) { SYMBOL_HN *findValue; struct FunctionDefinition *fPtr, *lastPtr = NULL; findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,functionName); for (fPtr = ExternalFunctionData(theEnv)->ListOfFunctions; fPtr != NULL; fPtr = fPtr->next) { if (fPtr->callFunctionName == findValue) { DecrementSymbolCount(theEnv,fPtr->callFunctionName); RemoveHashFunction(theEnv,fPtr); if (lastPtr == NULL) { ExternalFunctionData(theEnv)->ListOfFunctions = fPtr->next; } else { lastPtr->next = fPtr->next; } ClearUserDataList(theEnv,fPtr->usrData); rtn_struct(theEnv,FunctionDefinition,fPtr); return(TRUE); } lastPtr = fPtr; } return(FALSE); } /******************************************/ /* RemoveHashFunction: Removes a function */ /* from the function hash table. */ /******************************************/ static int RemoveHashFunction( void *theEnv, struct FunctionDefinition *fdPtr) { struct FunctionHash *fhPtr, *lastPtr = NULL; unsigned hashValue; hashValue = HashSymbol(ValueToString(fdPtr->callFunctionName),SIZE_FUNCTION_HASH); for (fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[hashValue]; fhPtr != NULL; fhPtr = fhPtr->next) { if (fhPtr->fdPtr == fdPtr) { if (lastPtr == NULL) { ExternalFunctionData(theEnv)->FunctionHashtable[hashValue] = fhPtr->next; } else { lastPtr->next = fhPtr->next; } rtn_struct(theEnv,FunctionHash,fhPtr); return(TRUE); } lastPtr = fhPtr; } return(FALSE); } /***************************************************************************/ /* AddFunctionParser: Associates a specialized expression parsing function */ /* with the function entry for a function which was defined using */ /* DefineFunction. When this function is parsed, the specialized parsing */ /* function will be called to parse the arguments of the function. Only */ /* user and system defined functions can have specialized parsing */ /* routines. Generic functions and deffunctions can not have specialized */ /* parsing routines. */ /***************************************************************************/ globle int AddFunctionParser( void *theEnv, char *functionName, struct expr *(*fpPtr)(void *,struct expr *,char *)) { struct FunctionDefinition *fdPtr; fdPtr = FindFunction(theEnv,functionName); if (fdPtr == NULL) { EnvPrintRouter(theEnv,WERROR,"Function parsers can only be added for existing functions.\n"); return(0); } fdPtr->restrictions = NULL; fdPtr->parser = fpPtr; fdPtr->overloadable = FALSE; return(1); } /*********************************************************************/ /* RemoveFunctionParser: Removes a specialized expression parsing */ /* function (if it exists) from the function entry for a function. */ /*********************************************************************/ globle int RemoveFunctionParser( void *theEnv, char *functionName) { struct FunctionDefinition *fdPtr; fdPtr = FindFunction(theEnv,functionName); if (fdPtr == NULL) { EnvPrintRouter(theEnv,WERROR,"Function parsers can only be removed from existing functions.\n"); return(0); } fdPtr->parser = NULL; return(1); } /*****************************************************************/ /* FuncSeqOvlFlags: Makes a system function overloadable or not, */ /* i.e. can the function be a method for a generic function. */ /*****************************************************************/ globle int FuncSeqOvlFlags( void *theEnv, char *functionName, int seqp, int ovlp) { struct FunctionDefinition *fdPtr; fdPtr = FindFunction(theEnv,functionName); if (fdPtr == NULL) { EnvPrintRouter(theEnv,WERROR,"Only existing functions can be marked as using sequence expansion arguments/overloadable or not.\n"); return(FALSE); } fdPtr->sequenceuseok = (short) (seqp ? TRUE : FALSE); fdPtr->overloadable = (short) (ovlp ? TRUE : FALSE); return(TRUE); } #endif /*********************************************************/ /* GetArgumentTypeName: Returns a descriptive string for */ /* a function argument type (used by DefineFunction2). */ /*********************************************************/ globle char *GetArgumentTypeName( int theRestriction) { switch ((char) theRestriction) { case 'a': return("external address"); case 'e': return("instance address, instance name, or symbol"); case 'd': case 'f': return("float"); case 'g': return("integer, float, or symbol"); case 'h': return("instance address, instance name, fact address, integer, or symbol"); case 'j': return("symbol, string, or instance name"); case 'k': return("symbol or string"); case 'i': case 'l': return("integer"); case 'm': return("multifield"); case 'n': return("integer or float"); case 'o': return("instance name"); case 'p': return("instance name or symbol"); case 'q': return("multifield, symbol, or string"); case 's': return("string"); case 'w': return("symbol"); case 'x': return("instance address"); case 'y': return("fact-address"); case 'z': return("fact-address, integer, or symbol"); case 'u': return("non-void return value"); } return("unknown argument type"); } /***************************************************/ /* GetNthRestriction: Returns the restriction type */ /* for the nth parameter of a function. */ /***************************************************/ globle int GetNthRestriction( struct FunctionDefinition *theFunction, int position) { int defaultRestriction = (int) 'u'; size_t theLength; int i = 2; /*===========================================================*/ /* If no restrictions at all are specified for the function, */ /* then return 'u' to indicate that any value is suitable as */ /* an argument to the function. */ /*===========================================================*/ if (theFunction == NULL) return(defaultRestriction); if (theFunction->restrictions == NULL) return(defaultRestriction); /*===========================================================*/ /* If no type restrictions are specified for the function, */ /* then return 'u' to indicate that any value is suitable as */ /* an argument to the function. */ /*===========================================================*/ theLength = strlen(theFunction->restrictions); if (theLength < 3) return(defaultRestriction); /*==============================================*/ /* Determine the functions default restriction. */ /*==============================================*/ defaultRestriction = (int) theFunction->restrictions[i]; if (defaultRestriction == '*') defaultRestriction = (int) 'u'; /*=======================================================*/ /* If the requested position does not have a restriction */ /* specified, then return the default restriction. */ /*=======================================================*/ if (theLength < (size_t) (position + 3)) return(defaultRestriction); /*=========================================================*/ /* Return the restriction specified for the nth parameter. */ /*=========================================================*/ return((int) theFunction->restrictions[position + 2]); } /*************************************************/ /* GetFunctionList: Returns the ListOfFunctions. */ /*************************************************/ globle struct FunctionDefinition *GetFunctionList( void *theEnv) { return(ExternalFunctionData(theEnv)->ListOfFunctions); } /**************************************************************/ /* InstallFunctionList: Sets the ListOfFunctions and adds all */ /* the function entries to the FunctionHashTable. */ /**************************************************************/ globle void InstallFunctionList( void *theEnv, struct FunctionDefinition *value) { int i; struct FunctionHash *fhPtr, *nextPtr; if (ExternalFunctionData(theEnv)->FunctionHashtable != NULL) { for (i = 0; i < SIZE_FUNCTION_HASH; i++) { fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[i]; while (fhPtr != NULL) { nextPtr = fhPtr->next; rtn_struct(theEnv,FunctionHash,fhPtr); fhPtr = nextPtr; } ExternalFunctionData(theEnv)->FunctionHashtable[i] = NULL; } } ExternalFunctionData(theEnv)->ListOfFunctions = value; while (value != NULL) { AddHashFunction(theEnv,value); value = value->next; } } /********************************************************/ /* FindFunction: Returns a pointer to the corresponding */ /* FunctionDefinition structure if a function name is */ /* in the function list, otherwise returns NULL. */ /********************************************************/ globle struct FunctionDefinition *FindFunction( void *theEnv, char *functionName) { struct FunctionHash *fhPtr; unsigned hashValue; SYMBOL_HN *findValue; if (ExternalFunctionData(theEnv)->FunctionHashtable == NULL) return(NULL); hashValue = HashSymbol(functionName,SIZE_FUNCTION_HASH); findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,functionName); for (fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[hashValue]; fhPtr != NULL; fhPtr = fhPtr->next) { if (fhPtr->fdPtr->callFunctionName == findValue) { return(fhPtr->fdPtr); } } return(NULL); } /*********************************************************/ /* InitializeFunctionHashTable: Purpose is to initialize */ /* the function hash table to NULL. */ /*********************************************************/ static void InitializeFunctionHashTable( void *theEnv) { int i; ExternalFunctionData(theEnv)->FunctionHashtable = (struct FunctionHash **) gm2(theEnv,(int) sizeof (struct FunctionHash *) * SIZE_FUNCTION_HASH); for (i = 0; i < SIZE_FUNCTION_HASH; i++) ExternalFunctionData(theEnv)->FunctionHashtable[i] = NULL; } /****************************************************************/ /* AddHashFunction: Adds a function to the function hash table. */ /****************************************************************/ static void AddHashFunction( void *theEnv, struct FunctionDefinition *fdPtr) { struct FunctionHash *newhash, *temp; unsigned hashValue; if (ExternalFunctionData(theEnv)->FunctionHashtable == NULL) InitializeFunctionHashTable(theEnv); newhash = get_struct(theEnv,FunctionHash); newhash->fdPtr = fdPtr; hashValue = HashSymbol(fdPtr->callFunctionName->contents,SIZE_FUNCTION_HASH); temp = ExternalFunctionData(theEnv)->FunctionHashtable[hashValue]; ExternalFunctionData(theEnv)->FunctionHashtable[hashValue] = newhash; newhash->next = temp; } /*************************************************/ /* GetMinimumArgs: Returns the minimum number of */ /* arguments expected by an external function. */ /*************************************************/ globle int GetMinimumArgs( struct FunctionDefinition *theFunction) { char theChar[2], *restrictions; restrictions = theFunction->restrictions; if (restrictions == NULL) return(-1); theChar[0] = restrictions[0]; theChar[1] = '\0'; if (isdigit(theChar[0])) { return atoi(theChar); } else if (theChar[0] == '*') { return(-1); } return(-1); } /*************************************************/ /* GetMaximumArgs: Returns the maximum number of */ /* arguments expected by an external function. */ /*************************************************/ globle int GetMaximumArgs( struct FunctionDefinition *theFunction) { char theChar[2], *restrictions; restrictions = theFunction->restrictions; if (restrictions == NULL) return(-1); if (restrictions[0] == '\0') return(-1); theChar[0] = restrictions[1]; theChar[1] = '\0'; if (isdigit(theChar[0])) { return atoi(theChar); } else if (theChar[0] == '*') { return(-1); } return(-1); } clips-6.24/clipssrc/._strngfun.c0000400000175000017500000000075410357047742014763 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH MonacoP;P;NTTF|ADFMPSRMWBBLclips-6.24/clipssrc/genrcfun.h0000755000175000017500000001074710441143554014524 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_genrcfun #define _H_genrcfun typedef struct defgenericModule DEFGENERIC_MODULE; typedef struct restriction RESTRICTION; typedef struct method DEFMETHOD; typedef struct defgeneric DEFGENERIC; #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #if OBJECT_SYSTEM #ifndef _H_object #include "object.h" #endif #endif struct defgenericModule { struct defmoduleItemHeader header; }; struct restriction { void **types; EXPRESSION *query; unsigned tcnt; }; struct method { unsigned index,busy; int restrictionCount, minRestrictions,maxRestrictions, localVarCount; unsigned system : 1; unsigned trace : 1; RESTRICTION *restrictions; EXPRESSION *actions; char *ppForm; struct userData *usrData; }; struct defgeneric { struct constructHeader header; unsigned busy,trace; DEFMETHOD *methods; unsigned mcnt,new_index; }; #define DEFGENERIC_DATA 27 struct defgenericData { struct construct *DefgenericConstruct; int DefgenericModuleIndex; ENTITY_RECORD GenericEntityRecord; #if DEBUGGING_FUNCTIONS unsigned WatchGenerics; unsigned WatchMethods; #endif DEFGENERIC *CurrentGeneric; DEFMETHOD *CurrentMethod; DATA_OBJECT *GenericCurrentArgument; #if (! RUN_TIME) && (! BLOAD_ONLY) unsigned OldGenericBusySave; #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *DefgenericCodeItem; #endif #if (! BLOAD_ONLY) && (! RUN_TIME) struct token GenericInputToken; #endif }; #define DefgenericData(theEnv) ((struct defgenericData *) GetEnvironmentData(theEnv,DEFGENERIC_DATA)) #define SaveBusyCount(gfunc) (DefgenericData(theEnv)->OldGenericBusySave = gfunc->busy) #define RestoreBusyCount(gfunc) (gfunc->busy = DefgenericData(theEnv)->OldGenericBusySave) #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ! RUN_TIME LOCALE intBool ClearDefgenericsReady(void *); LOCALE void *AllocateDefgenericModule(void *); LOCALE void FreeDefgenericModule(void *,void *); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int ClearDefmethods(void *); LOCALE int RemoveAllExplicitMethods(void *,DEFGENERIC *); LOCALE void RemoveDefgeneric(void *,void *); LOCALE int ClearDefgenerics(void *); LOCALE void MethodAlterError(void *,DEFGENERIC *); LOCALE void DeleteMethodInfo(void *,DEFGENERIC *,DEFMETHOD *); LOCALE void DestroyMethodInfo(void *,DEFGENERIC *,DEFMETHOD *); LOCALE int MethodsExecuting(DEFGENERIC *); #endif #if ! OBJECT_SYSTEM LOCALE intBool SubsumeType(int,int); #endif LOCALE int FindMethodByIndex(DEFGENERIC *,unsigned); #if DEBUGGING_FUNCTIONS LOCALE void PreviewGeneric(void *); LOCALE void PrintMethod(void *,char *,int,DEFMETHOD *); #endif LOCALE DEFGENERIC *CheckGenericExists(void *,char *,char *); LOCALE int CheckMethodExists(void *,char *,DEFGENERIC *,int); #if ! OBJECT_SYSTEM LOCALE char *TypeName(void *,int); #endif LOCALE void PrintGenericName(void *,char *,DEFGENERIC *); #endif clips-6.24/clipssrc/._constrnt.h0000400000175000017500000000075410441131400014747 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monacogd%xgd%x099TTFS MFMWBBMPSRclips-6.24/clipssrc/pprint.c0000755000175000017500000002566610441163635014234 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* PRETTY PRINT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for processing the pretty print */ /* representation of constructs. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Chris Culbert */ /* Brian Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Corrected code generating compilation */ /* warnings. */ /* */ /*************************************************************/ #define _PPRINT_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "utility.h" #include "pprint.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DeallocatePrettyPrintData(void *); /****************************************************/ /* InitializePrettyPrintData: Allocates environment */ /* data for pretty print routines. */ /****************************************************/ globle void InitializePrettyPrintData( void *theEnv) { AllocateEnvironmentData(theEnv,PRETTY_PRINT_DATA,sizeof(struct prettyPrintData),DeallocatePrettyPrintData); PrettyPrintData(theEnv)->PPBufferEnabled = TRUE; } /******************************************************/ /* DeallocatePrettyPrintData: Deallocates environment */ /* data for the pretty print routines. */ /******************************************************/ static void DeallocatePrettyPrintData( void *theEnv) { if (PrettyPrintData(theEnv)->PrettyPrintBuffer != NULL) { rm(theEnv,PrettyPrintData(theEnv)->PrettyPrintBuffer,PrettyPrintData(theEnv)->PPBufferMax); } } /*******************************************************/ /* FlushPPBuffer: Resets the pretty print save buffer. */ /*******************************************************/ globle void FlushPPBuffer( void *theEnv) { if (PrettyPrintData(theEnv)->PrettyPrintBuffer == NULL) return; PrettyPrintData(theEnv)->PPBackupOnce = 0; PrettyPrintData(theEnv)->PPBackupTwice = 0; PrettyPrintData(theEnv)->PPBufferPos = 0; PrettyPrintData(theEnv)->PrettyPrintBuffer[0] = EOS; return; } /*********************************************************************/ /* DestroyPPBuffer: Resets and removes the pretty print save buffer. */ /*********************************************************************/ globle void DestroyPPBuffer(void *theEnv) { PrettyPrintData(theEnv)->PPBackupOnce = 0; PrettyPrintData(theEnv)->PPBackupTwice = 0; PrettyPrintData(theEnv)->PPBufferPos = 0; if (PrettyPrintData(theEnv)->PrettyPrintBuffer != NULL) rm(theEnv,PrettyPrintData(theEnv)->PrettyPrintBuffer,PrettyPrintData(theEnv)->PPBufferMax); PrettyPrintData(theEnv)->PrettyPrintBuffer = NULL; PrettyPrintData(theEnv)->PPBufferMax = 0; } /*********************************************/ /* SavePPBuffer: Appends a string to the end */ /* of the pretty print save buffer. */ /*********************************************/ globle void SavePPBuffer( void *theEnv, char *str) { long int longSize; int normalSize; int increment; /*==========================================*/ /* If the pretty print buffer isn't needed, */ /* then don't bother writing to it. */ /*==========================================*/ if ((PrettyPrintData(theEnv)->PPBufferStatus == OFF) || (! PrettyPrintData(theEnv)->PPBufferEnabled)) { return; } /*===============================*/ /* Determine the increment size. */ /*===============================*/ increment = 512; if (PrettyPrintData(theEnv)->PPBufferPos > increment) { increment = PrettyPrintData(theEnv)->PPBufferPos * 3; if (increment < 0) { increment = 512; } } /*==================================================*/ /* The pretty print buffer is limited in size to */ /* the maximum size of a signed int. Any characters */ /* beyond that number are discarded. */ /*==================================================*/ normalSize = (int) strlen(str); longSize = (long) normalSize; longSize += (long) PrettyPrintData(theEnv)->PPBufferPos + ((long) increment) + 1L; normalSize += PrettyPrintData(theEnv)->PPBufferPos + increment + 1; if (normalSize != longSize) return; /*================================================*/ /* If the pretty print buffer isn't big enough to */ /* contain the string, then increase its size. */ /*================================================*/ if ((int) strlen(str) + PrettyPrintData(theEnv)->PPBufferPos + 1 >= (int) PrettyPrintData(theEnv)->PPBufferMax) { PrettyPrintData(theEnv)->PrettyPrintBuffer = (char *) genrealloc(theEnv,PrettyPrintData(theEnv)->PrettyPrintBuffer,(unsigned) PrettyPrintData(theEnv)->PPBufferMax, (unsigned) PrettyPrintData(theEnv)->PPBufferMax + increment); PrettyPrintData(theEnv)->PPBufferMax += (unsigned int) increment; } /*==================================================*/ /* Remember the previous tokens saved to the pretty */ /* print buffer in case it is necessary to back up. */ /*==================================================*/ PrettyPrintData(theEnv)->PPBackupTwice = PrettyPrintData(theEnv)->PPBackupOnce; PrettyPrintData(theEnv)->PPBackupOnce = PrettyPrintData(theEnv)->PPBufferPos; /*=============================================*/ /* Save the string to the pretty print buffer. */ /*=============================================*/ PrettyPrintData(theEnv)->PrettyPrintBuffer = AppendToString(theEnv,str,PrettyPrintData(theEnv)->PrettyPrintBuffer,&PrettyPrintData(theEnv)->PPBufferPos,&PrettyPrintData(theEnv)->PPBufferMax); } /***************************************************/ /* PPBackup: Removes the last string added to the */ /* pretty print save buffer. Only capable of */ /* backing up for the two most recent additions. */ /***************************************************/ globle void PPBackup( void *theEnv) { if ((PrettyPrintData(theEnv)->PPBufferStatus == OFF) || (PrettyPrintData(theEnv)->PrettyPrintBuffer == NULL) || (! PrettyPrintData(theEnv)->PPBufferEnabled)) { return; } PrettyPrintData(theEnv)->PPBufferPos = PrettyPrintData(theEnv)->PPBackupOnce; PrettyPrintData(theEnv)->PPBackupOnce = PrettyPrintData(theEnv)->PPBackupTwice; PrettyPrintData(theEnv)->PrettyPrintBuffer[PrettyPrintData(theEnv)->PPBufferPos] = EOS; } /**************************************************/ /* CopyPPBuffer: Makes a copy of the pretty print */ /* save buffer. */ /**************************************************/ globle char *CopyPPBuffer( void *theEnv) { unsigned length; char *newString; length = (1 + strlen(PrettyPrintData(theEnv)->PrettyPrintBuffer)) * (int) sizeof (char); newString = (char *) gm2(theEnv,length); strcpy(newString,PrettyPrintData(theEnv)->PrettyPrintBuffer); return(newString); } /************************************************************/ /* GetPPBuffer: Returns a pointer to the PrettyPrintBuffer. */ /************************************************************/ globle char *GetPPBuffer( void *theEnv) { return(PrettyPrintData(theEnv)->PrettyPrintBuffer); } /*******************************************/ /* PPCRAndIndent: Prints white spaces into */ /* the pretty print buffer. */ /*******************************************/ globle void PPCRAndIndent( void *theEnv) { int i; char buffer[120]; if ((PrettyPrintData(theEnv)->PPBufferStatus == OFF) || (! PrettyPrintData(theEnv)->PPBufferEnabled)) { return; } buffer[0] = '\n'; for (i = 1 ; i <= PrettyPrintData(theEnv)->IndentationDepth ; i++) { buffer[i] = ' '; } buffer[i] = EOS; SavePPBuffer(theEnv,buffer); } /************************************************/ /* IncrementIndentDepth: Increments indentation */ /* depth for pretty printing. */ /************************************************/ globle void IncrementIndentDepth( void *theEnv, int value) { PrettyPrintData(theEnv)->IndentationDepth += value; } /************************************************/ /* DecrementIndentDepth: Decrements indentation */ /* depth for pretty printing. */ /************************************************/ globle void DecrementIndentDepth( void *theEnv, int value) { PrettyPrintData(theEnv)->IndentationDepth -= value; } /************************************/ /* SetIndentDepth: Sets indentation */ /* depth for pretty printing. */ /************************************/ globle void SetIndentDepth( void *theEnv, int value) { PrettyPrintData(theEnv)->IndentationDepth = value; } /******************************************/ /* SetPPBufferStatus: Sets PPBufferStatus */ /* flag to boolean value of ON or OFF. */ /******************************************/ globle void SetPPBufferStatus( void *theEnv, int value) { PrettyPrintData(theEnv)->PPBufferStatus = value; } /************************************/ /* GetPPBufferStatus: Returns value */ /* of the PPBufferStatus flag. */ /************************************/ globle int GetPPBufferStatus( void *theEnv) { return(PrettyPrintData(theEnv)->PPBufferStatus); } /******************************************/ /* SetPPBufferEnabled: */ /******************************************/ globle int SetPPBufferEnabled( void *theEnv, int value) { int oldValue; oldValue = PrettyPrintData(theEnv)->PPBufferEnabled; PrettyPrintData(theEnv)->PPBufferEnabled = value; return(oldValue); } /************************************/ /* GetPPBufferEnabled: */ /************************************/ globle int GetPPBufferEnabled( void *theEnv) { return(PrettyPrintData(theEnv)->PPBufferEnabled); } clips-6.24/clipssrc/dffctpsr.c0000755000175000017500000001273410056701050014512 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* DEFFACTS PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses a deffacts construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _DFFCTPSR_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "cstrcpsr.h" #include "factrhs.h" #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #include "dffctdef.h" #include "dffctbsc.h" #include "dffctpsr.h" /************************************************************/ /* ParseDeffacts: Coordinates all actions necessary for the */ /* addition of a deffacts construct into the current */ /* environment. Called when parsing a construct after the */ /* deffacts keyword has been found. */ /************************************************************/ globle int ParseDeffacts( void *theEnv, char *readSource) { #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,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(theEnv,ON); 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", EnvFindDeffacts,EnvUndeffacts,"$",TRUE, TRUE,TRUE); 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); newDeffacts->header.name = deffactsName; IncrementSymbolCount(deffactsName); newDeffacts->assertList = PackExpression(theEnv,temp); newDeffacts->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"deffacts")->moduleIndex); newDeffacts->header.next = NULL; newDeffacts->header.usrData = NULL; ReturnExpression(theEnv,temp); /*=======================================================*/ /* Save the pretty print representation of the deffacts. */ /*=======================================================*/ if (EnvGetConserveMemory(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); } #endif /* DEFFACTS_CONSTRUCT */ clips-6.24/clipssrc/._bload.h0000400000175000017500000000075410441127731014172 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monaco0z0zTTFSFMWBBMPSRclips-6.24/clipssrc/reteutil.c0000755000175000017500000004663510441162421014544 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* RETE UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides a set of utility functions useful to */ /* other modules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /*************************************************************/ #define _RETEUTIL_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFRULE_CONSTRUCT #include "drive.h" #include "engine.h" #include "envrnmnt.h" #include "incrrset.h" #include "match.h" #include "memalloc.h" #include "moduldef.h" #include "pattern.h" #include "retract.h" #include "router.h" #include "reteutil.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void TraceErrorToRuleDriver(void *,struct joinNode *,char *); /***********************************************************/ /* PrintPartialMatch: Prints out the list of fact indices */ /* and/or instance names associated with a partial match */ /* or rule instantiation. */ /***********************************************************/ globle void PrintPartialMatch( void *theEnv, char *logicalName, struct partialMatch *list) { struct patternEntity *matchingItem; short int i; for (i = 0; i < (int) list->bcount;) { if (get_nth_pm_match(list,i)->matchingItem != NULL) { matchingItem = get_nth_pm_match(list,i)->matchingItem; if (matchingItem != NULL) (*matchingItem->theInfo->base.shortPrintFunction)(theEnv,logicalName,matchingItem); } i++; if (i < (int) list->bcount) EnvPrintRouter(theEnv,logicalName,","); } } /**********************************************/ /* CopyPartialMatch: Copies a partial match. */ /**********************************************/ globle struct partialMatch *CopyPartialMatch( void *theEnv, struct partialMatch *list, int addActivationSlot, int addDependencySlot) { struct partialMatch *linker; short int i; linker = get_var_struct(theEnv,partialMatch,sizeof(struct genericMatch) * (list->bcount + addActivationSlot + addDependencySlot - 1)); linker->next = NULL; linker->betaMemory = TRUE; linker->busy = FALSE; linker->activationf = addActivationSlot; linker->dependentsf = addDependencySlot; linker->notOriginf = FALSE; linker->counterf = FALSE; linker->bcount = list->bcount; for (i = 0; i < (int) linker->bcount; i++) linker->binds[i] = list->binds[i]; if (addActivationSlot) linker->binds[i++].gm.theValue = NULL; if (addDependencySlot) linker->binds[i].gm.theValue = NULL; return(linker); } /****************************************************/ /* MergePartialMatches: Merges two partial matches. */ /****************************************************/ globle struct partialMatch *MergePartialMatches( void *theEnv, struct partialMatch *list1, struct partialMatch *list2, int addActivationSlot, int addDependencySlot) { struct partialMatch *linker; short int i, j; linker = get_var_struct(theEnv,partialMatch, sizeof(struct genericMatch) * (list1->bcount + list2->bcount + addActivationSlot + addDependencySlot - 1)); linker->next = NULL; linker->betaMemory = TRUE; linker->busy = FALSE; linker->activationf = addActivationSlot; linker->dependentsf = addDependencySlot; linker->notOriginf = FALSE; linker->counterf = FALSE; linker->bcount = list1->bcount + list2->bcount; for (i = 0; i < (int) list1->bcount; i++) { linker->binds[i] = list1->binds[i]; } for (i = (short) list1->bcount, j = 0; i < (short) linker->bcount; i++, j++) { linker->binds[i] = list2->binds[j]; } if (addActivationSlot) linker->binds[i++].gm.theValue = NULL; if (addDependencySlot) linker->binds[i].gm.theValue = NULL; return(linker); } /*******************************************************************/ /* InitializePatternHeader: Initializes a pattern header structure */ /* (used by the fact and instance pattern matchers). */ /*******************************************************************/ globle void InitializePatternHeader( void *theEnv, struct patternNodeHeader *theHeader) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif theHeader->entryJoin = NULL; theHeader->alphaMemory = NULL; theHeader->endOfQueue = NULL; theHeader->singlefieldNode = FALSE; theHeader->multifieldNode = FALSE; theHeader->stopNode = FALSE; #if (! RUN_TIME) theHeader->initialize = EnvGetIncrementalReset(theEnv); #else theHeader->initialize = FALSE; #endif theHeader->marked = FALSE; theHeader->beginSlot = FALSE; theHeader->endSlot = FALSE; } /******************************************************************/ /* CreateAlphaMatch: Given a pointer to an entity (such as a fact */ /* or instance) which matched a pattern, this function creates */ /* a partial match suitable for storing in the alpha memory of */ /* the pattern network. Note that the multifield markers which */ /* are passed as a calling argument are copied (thus the caller */ /* is still responsible for freeing these data structures). */ /******************************************************************/ globle struct partialMatch *CreateAlphaMatch( void *theEnv, void *theEntity, struct multifieldMarker *markers, struct patternNodeHeader *theHeader) { struct partialMatch *theMatch; struct alphaMatch *afbtemp; /*==================================================*/ /* Create the alpha match and intialize its values. */ /*==================================================*/ theMatch = get_struct(theEnv,partialMatch); theMatch->next = NULL; theMatch->betaMemory = FALSE; theMatch->busy = FALSE; theMatch->activationf = FALSE; theMatch->dependentsf = FALSE; theMatch->notOriginf = FALSE; theMatch->counterf = FALSE; theMatch->bcount = 1; afbtemp = get_struct(theEnv,alphaMatch); afbtemp->next = NULL; afbtemp->matchingItem = (struct patternEntity *) theEntity; if (markers != NULL) { afbtemp->markers = CopyMultifieldMarkers(theEnv,markers); } else { afbtemp->markers = NULL; } theMatch->binds[0].gm.theMatch = afbtemp; /*====================================*/ /* Store the alpha match in the alpha */ /* memory of the pattern node. */ /*====================================*/ if (theHeader->endOfQueue == NULL) { theHeader->alphaMemory = theMatch; theHeader->endOfQueue = theMatch; } else { theHeader->endOfQueue->next = theMatch; theHeader->endOfQueue = theMatch; } /*===================================================*/ /* Return a pointer to the newly create alpha match. */ /*===================================================*/ return(theMatch); } /*********************************************************/ /* AddSingleMatch: Combines an alpha match and a partial */ /* match into a new partial match. */ /*********************************************************/ globle struct partialMatch *AddSingleMatch( void *theEnv, struct partialMatch *list, struct alphaMatch *afb, int addActivationSlot, int addDependencySlot) { struct partialMatch *linker; short int i; linker = get_var_struct(theEnv,partialMatch,sizeof(struct genericMatch) * (list->bcount + addActivationSlot + addDependencySlot)); linker->next = NULL; linker->betaMemory = TRUE; linker->busy = FALSE; linker->activationf = addActivationSlot; linker->dependentsf = addDependencySlot; linker->notOriginf = FALSE; linker->counterf = FALSE; linker->bcount = list->bcount + 1; for (i = 0; i < (int) list->bcount; i++) { linker->binds[i] = list->binds[i]; } set_nth_pm_match(linker,i++,afb); if (addActivationSlot) linker->binds[i++].gm.theValue = NULL; if (addDependencySlot) linker->binds[i].gm.theValue = NULL; return(linker); } /*******************************************/ /* CopyMultifieldMarkers: Copies a list of */ /* multifieldMarker data structures. */ /*******************************************/ struct multifieldMarker *CopyMultifieldMarkers( void *theEnv, struct multifieldMarker *theMarkers) { struct multifieldMarker *head = NULL, *lastMark = NULL, *newMark; while (theMarkers != NULL) { newMark = get_struct(theEnv,multifieldMarker); newMark->next = NULL; newMark->whichField = theMarkers->whichField; newMark->where = theMarkers->where; newMark->startPosition = theMarkers->startPosition; newMark->endPosition = theMarkers->endPosition; if (lastMark == NULL) { head = newMark; } else { lastMark->next = newMark; } lastMark = newMark; theMarkers = theMarkers->next; } return(head); } /***************************************************************/ /* NewPseudoFactPartialMatch: Creates a partial structure that */ /* indicates the "pseudo" fact to which a not pattern CE has */ /* been bound. Since a non-existant fact has no fact index, */ /* the partial match structure is given a pseudo fact index */ /* (a unique negative integer). Note that a "pseudo" fact */ /* can also be used as a "pseudo" instance. */ /***************************************************************/ globle struct partialMatch *NewPseudoFactPartialMatch( void *theEnv) { struct partialMatch *linker; struct alphaMatch *tempAlpha; linker = get_struct(theEnv,partialMatch); linker->next = NULL; linker->betaMemory = TRUE; linker->busy = FALSE; linker->activationf = FALSE; linker->dependentsf = FALSE; linker->notOriginf = TRUE; linker->counterf = FALSE; linker->bcount = 0; tempAlpha = get_struct(theEnv,alphaMatch); tempAlpha->next = NULL; tempAlpha->matchingItem = NULL; tempAlpha->markers = NULL; linker->binds[0].gm.theMatch = tempAlpha; return(linker); } /******************************************************************/ /* FlushAlphaBetaMemory: Returns all partial matches in a list of */ /* partial matches either directly to the pool of free memory */ /* or to the list of GarbagePartialMatches. Partial matches */ /* stored in alpha memories and partial matches which store the */ /* information for pseudo facts (for not CEs) may be referred */ /* to by other data structures and thus must be placed on the */ /* list of GarbagePartialMatches. */ /******************************************************************/ globle void FlushAlphaBetaMemory( void *theEnv, struct partialMatch *pfl) { struct partialMatch *pfltemp; while (pfl != NULL) { pfltemp = pfl->next; if (((pfl->notOriginf) && (pfl->counterf == FALSE)) || (pfl->betaMemory == FALSE)) { pfl->next = EngineData(theEnv)->GarbagePartialMatches; EngineData(theEnv)->GarbagePartialMatches = pfl; } else { ReturnPartialMatch(theEnv,pfl); } pfl = pfltemp; } } /*****************************************************************/ /* DestroyAlphaBetaMemory: Returns all partial matches in a list */ /* of partial matches directly to the pool of free memory. */ /*****************************************************************/ globle void DestroyAlphaBetaMemory( void *theEnv, struct partialMatch *pfl) { struct partialMatch *pfltemp; while (pfl != NULL) { pfltemp = pfl->next; DestroyPartialMatch(theEnv,pfl); pfl = pfltemp; } } /******************************************************/ /* FindEntityInPartialMatch: Searches for a specified */ /* data entity in a partial match. */ /******************************************************/ globle int FindEntityInPartialMatch( struct patternEntity *theEntity, struct partialMatch *thePartialMatch) { short int i; for (i = 0 ; i < (int) thePartialMatch->bcount; i++) { if (thePartialMatch->binds[i].gm.theMatch->matchingItem == theEntity) { return(TRUE); } } return(FALSE); } /***********************************************************************/ /* GetPatternNumberFromJoin: Given a pointer to a join associated with */ /* a pattern CE, returns an integer representing the position of the */ /* pattern CE in the rule (e.g. first, second, third). */ /***********************************************************************/ globle int GetPatternNumberFromJoin( struct joinNode *joinPtr) { int whichOne = 0; while (joinPtr != NULL) { if (joinPtr->joinFromTheRight) { joinPtr = (struct joinNode *) joinPtr->rightSideEntryStructure; } else { whichOne++; joinPtr = joinPtr->lastLevel; } } return(whichOne); } /************************************************************************/ /* TraceErrorToRule: Prints an error message when a error occurs as the */ /* result of evaluating an expression in the pattern network. Used to */ /* indicate which rule caused the problem. */ /************************************************************************/ globle void TraceErrorToRule( void *theEnv, struct joinNode *joinPtr, char *indentSpaces) { MarkRuleNetwork(theEnv,0); TraceErrorToRuleDriver(theEnv,joinPtr,indentSpaces); } /**************************************************************/ /* TraceErrorToRuleDriver: Driver code for printing out which */ /* rule caused a pattern or join network error. */ /**************************************************************/ static void TraceErrorToRuleDriver( void *theEnv, struct joinNode *joinPtr, char *indentSpaces) { char *name; while (joinPtr != NULL) { if (joinPtr->marked) { /* Do Nothing */ } else if (joinPtr->ruleToActivate != NULL) { joinPtr->marked = 1; name = EnvGetDefruleName(theEnv,joinPtr->ruleToActivate); EnvPrintRouter(theEnv,WERROR,indentSpaces); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR,"\n"); } else { joinPtr->marked = 1; TraceErrorToRuleDriver(theEnv,joinPtr->nextLevel,indentSpaces); } joinPtr = joinPtr->rightDriveNode; } } /********************************************************/ /* MarkRuleNetwork: Sets the marked flag in each of the */ /* joins in the join network to the specified value. */ /********************************************************/ globle void MarkRuleNetwork( void *theEnv, int value) { struct defrule *rulePtr; struct joinNode *joinPtr; struct defmodule *modulePtr; /*===========================*/ /* Loop through each module. */ /*===========================*/ SaveCurrentModule(theEnv); for (modulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); modulePtr != NULL; modulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,modulePtr)) { EnvSetCurrentModule(theEnv,(void *) modulePtr); /*=========================*/ /* Loop through each rule. */ /*=========================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (rulePtr != NULL) { /*=============================*/ /* Mark each join for the rule */ /* with the specified value. */ /*=============================*/ joinPtr = rulePtr->lastJoin; while (joinPtr != NULL) { joinPtr->marked = value; joinPtr = GetPreviousJoin(joinPtr); } /*=================================*/ /* Move on to the next rule or the */ /* next disjunct for this rule. */ /*=================================*/ if (rulePtr->disjunct != NULL) rulePtr = rulePtr->disjunct; else rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,rulePtr); } } RestoreCurrentModule(theEnv); } #if (CONSTRUCT_COMPILER || BLOAD_AND_BSAVE) && (! RUN_TIME) /*************************************************************/ /* TagRuleNetwork: Assigns each join in the join network and */ /* each defrule data structure with a unique integer ID. */ /* Also counts the number of defrule and joinNode data */ /* structures currently in use. */ /*************************************************************/ globle void TagRuleNetwork( void *theEnv, long int *moduleCount, long int *ruleCount, long int *joinCount) { struct defmodule *modulePtr; struct defrule *rulePtr; struct joinNode *joinPtr; *moduleCount = 0; *ruleCount = 0; *joinCount = 0; MarkRuleNetwork(theEnv,0); /*===========================*/ /* Loop through each module. */ /*===========================*/ for (modulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); modulePtr != NULL; modulePtr = (struct defmodule *) EnvGetNextDefmodule(theEnv,modulePtr)) { (*moduleCount)++; EnvSetCurrentModule(theEnv,(void *) modulePtr); /*=========================*/ /* Loop through each rule. */ /*=========================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (rulePtr != NULL) { rulePtr->header.bsaveID = *ruleCount; (*ruleCount)++; /*=========================*/ /* Loop through each join. */ /*=========================*/ for (joinPtr = rulePtr->lastJoin; joinPtr != NULL; joinPtr = GetPreviousJoin(joinPtr)) { if (joinPtr->marked == 0) { joinPtr->marked = 1; joinPtr->bsaveID = *joinCount; (*joinCount)++; } } if (rulePtr->disjunct != NULL) rulePtr = rulePtr->disjunct; else rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,rulePtr); } } } #endif /* (CONSTRUCT_COMPILER || BLOAD_AND_BSAVE) && (! RUN_TIME) */ #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._bmathfun.h0000400000175000017500000000075410441127760014717 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z zTTFSFMWBBMPSRclips-6.24/clipssrc/._memalloc.h0000400000175000017500000000075410441147760014706 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z: TTFS FMWBBMPSRclips-6.24/clipssrc/._globlcmp.h0000400000175000017500000000012207422634705014706 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._insmngr.c0000400000175000017500000000452210441147544014562 0ustar jfsjfsMac OS X  2 R TEXTR*ch n insmngr.ctrol PanelTCmr.txt.docTEXTR*ch@ p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco9VVSCnHnGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/._modulutl.h0000400000175000017500000000012207422634655014760 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._iofun.c0000400000175000017500000000075410441602233014217 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH MonacoFUFUb.V` TTFL,JFMPSRMWBBLclips-6.24/clipssrc/bload.c0000755000175000017500000006417510441127716013777 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides core routines for loading constructs */ /* from a binary file. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _BLOAD_SOURCE_ #include "setup.h" #include "argacces.h" #include "bsave.h" #include "constrct.h" #include "cstrnbin.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "router.h" #include "utility.h" #include "bload.h" #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct FunctionDefinition **ReadNeededFunctions(void *,long *,int *); static struct FunctionDefinition *FastFindFunction(void *,char *,struct FunctionDefinition *); static int ClearBload(void *); static void AbortBload(void *); static int BloadOutOfMemoryFunction(void *,unsigned long); static void DeallocateBloadData(void *); /**********************************************/ /* InitializeBloadData: Allocates environment */ /* data for the bload command. */ /**********************************************/ globle void InitializeBloadData( void *theEnv) { AllocateEnvironmentData(theEnv,BLOAD_DATA,sizeof(struct bloadData),NULL); AddEnvironmentCleanupFunction(theEnv,"bload",DeallocateBloadData,-1500); BloadData(theEnv)->BinaryPrefixID = "\1\2\3\4CLIPS"; BloadData(theEnv)->BinaryVersionID = "V6.20"; } /************************************************/ /* DeallocateBloadData: Deallocates environment */ /* data for the bload command. */ /************************************************/ static void DeallocateBloadData( void *theEnv) { DeallocateCallList(theEnv,BloadData(theEnv)->BeforeBloadFunctions); DeallocateCallList(theEnv,BloadData(theEnv)->AfterBloadFunctions); DeallocateCallList(theEnv,BloadData(theEnv)->ClearBloadReadyFunctions); DeallocateCallList(theEnv,BloadData(theEnv)->AbortBloadFunctions); } /******************************/ /* EnvBload: C access routine */ /* for the bload command. */ /******************************/ globle int EnvBload( void *theEnv, char *fileName) { long numberOfFunctions; unsigned long space; int error; char IDbuffer[20]; char constructBuffer[CONSTRUCT_HEADER_SIZE]; struct BinaryItem *biPtr; struct callFunctionItem *bfPtr; /*================*/ /* Open the file. */ /*================*/ if (GenOpenReadBinary(theEnv,"bload",fileName) == 0) return(FALSE); /*=====================================*/ /* Determine if this is a binary file. */ /*=====================================*/ GenReadBinary(theEnv,IDbuffer,(unsigned long) strlen(BloadData(theEnv)->BinaryPrefixID) + 1); if (strcmp(IDbuffer,BloadData(theEnv)->BinaryPrefixID) != 0) { PrintErrorID(theEnv,"BLOAD",2,FALSE); EnvPrintRouter(theEnv,WERROR,"File "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR," is not a binary construct file.\n"); GenCloseBinary(theEnv); return(FALSE); } /*=======================================*/ /* Determine if it's a binary file using */ /* a format from a different version. */ /*=======================================*/ GenReadBinary(theEnv,IDbuffer,(unsigned long) strlen(BloadData(theEnv)->BinaryVersionID) + 1); if (strcmp(IDbuffer,BloadData(theEnv)->BinaryVersionID) != 0) { PrintErrorID(theEnv,"BLOAD",3,FALSE); EnvPrintRouter(theEnv,WERROR,"File "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR," is an incompatible binary construct file.\n"); GenCloseBinary(theEnv); return(FALSE); } /*====================*/ /* Clear environment. */ /*====================*/ if (BloadData(theEnv)->BloadActive) { if (ClearBload(theEnv) == FALSE) { GenCloseBinary(theEnv); return(FALSE); } } /*=================================*/ /* Determine if the KB environment */ /* was successfully cleared. */ /*=================================*/ if (ClearReady(theEnv) == FALSE) { GenCloseBinary(theEnv); EnvPrintRouter(theEnv,WERROR,"The "); EnvPrintRouter(theEnv,WERROR,APPLICATION_NAME); EnvPrintRouter(theEnv,WERROR," environment could not be cleared.\n"); EnvPrintRouter(theEnv,WERROR,"Binary load cannot continue.\n"); return(FALSE); } /*==================================*/ /* Call the list of functions to be */ /* executed before a bload occurs. */ /*==================================*/ for (bfPtr = BloadData(theEnv)->BeforeBloadFunctions; bfPtr != NULL; bfPtr = bfPtr->next) { if (bfPtr->environmentAware) { (*bfPtr->func)(theEnv); } else { (* (void (*)(void)) bfPtr->func)(); } } /*====================================================*/ /* Read in the functions needed by this binary image. */ /*====================================================*/ BloadData(theEnv)->FunctionArray = ReadNeededFunctions(theEnv,&numberOfFunctions,&error); if (error) { GenCloseBinary(theEnv); AbortBload(theEnv); return(FALSE); } /*================================================*/ /* Read in the atoms needed by this binary image. */ /*================================================*/ ReadNeededAtomicValues(theEnv); /*===========================================*/ /* Determine the number of expressions to be */ /* read and allocate the appropriate space */ /*===========================================*/ AllocateExpressions(theEnv); /*==========================================================*/ /* Read in the memory requirements of the constructs stored */ /* in this binary image and allocate the necessary space */ /*==========================================================*/ for (GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE); strncmp(constructBuffer,BloadData(theEnv)->BinaryPrefixID,CONSTRUCT_HEADER_SIZE) != 0; GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE)) { intBool found; /*================================================*/ /* Search for the construct type in the list of */ /* binary items. If found, allocate the storage */ /* needed by the construct for this binary image. */ /*================================================*/ found = FALSE; for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (strncmp(biPtr->name,constructBuffer,CONSTRUCT_HEADER_SIZE) == 0) { if (biPtr->bloadStorageFunction != NULL) { (*biPtr->bloadStorageFunction)(theEnv); found = TRUE; } break; } } /*==========================================*/ /* If the construct type wasn't found, skip */ /* the storage binary load information for */ /* this construct. */ /*==========================================*/ if (! found) { GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long)); GetSeekCurBinary(theEnv,(long) space); if (space != 0) { EnvPrintRouter(theEnv,WDIALOG,"\nSkipping "); EnvPrintRouter(theEnv,WDIALOG,constructBuffer); EnvPrintRouter(theEnv,WDIALOG," constructs because of unavailibility\n"); } } } /*======================================*/ /* Refresh the pointers in expressions. */ /*======================================*/ RefreshExpressions(theEnv); /*==========================*/ /* Read in the constraints. */ /*==========================*/ ReadNeededConstraints(theEnv); /*======================================================*/ /* Read in the constructs stored in this binary image. */ /*======================================================*/ for (GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE); strncmp(constructBuffer,BloadData(theEnv)->BinaryPrefixID,CONSTRUCT_HEADER_SIZE) != 0; GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE)) { intBool found; /*==================================================*/ /* Search for the function to load the construct */ /* into the previously allocated storage. If found, */ /* call the function to load the construct. */ /*==================================================*/ found = FALSE; for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (strncmp(biPtr->name,constructBuffer,CONSTRUCT_HEADER_SIZE) == 0) { if (biPtr->bloadFunction != NULL) { (*biPtr->bloadFunction)(theEnv); found = TRUE; } break; } } /*==========================================*/ /* If the construct type wasn't found, skip */ /* the binary data for this construct. */ /*==========================================*/ if (! found) { GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long)); GetSeekCurBinary(theEnv,(long) space); } } /*=================*/ /* Close the file. */ /*=================*/ GenCloseBinary(theEnv); /*========================================*/ /* Free up temporary storage used for the */ /* function and atomic value information. */ /*========================================*/ if (BloadData(theEnv)->FunctionArray != NULL) { genlongfree(theEnv,(void *) BloadData(theEnv)->FunctionArray, (unsigned long) sizeof(struct FunctionDefinition *) * numberOfFunctions); } FreeAtomicValueStorage(theEnv); /*==================================*/ /* Call the list of functions to be */ /* executed after a bload occurs. */ /*==================================*/ for (bfPtr = BloadData(theEnv)->AfterBloadFunctions; bfPtr != NULL; bfPtr = bfPtr->next) { if (bfPtr->environmentAware) { (*bfPtr->func)(theEnv); } else { (* (void (*)(void)) bfPtr->func)(); } } /*=======================================*/ /* Add a clear function to remove binary */ /* load when a clear command is issued. */ /*=======================================*/ BloadData(theEnv)->BloadActive = TRUE; EnvAddClearFunction(theEnv,"bload",(void (*)(void *)) ClearBload,10000); /*=============================*/ /* Return TRUE to indicate the */ /* binary load was successful. */ /*=============================*/ return(TRUE); } /************************************************************ NAME : BloadandRefresh DESCRIPTION : Loads and refreshes objects - will bload all objects at once, if possible, but will aslo work in increments if memory is restricted INPUTS : 1) the number of objects to bload and update 2) the size of one object 3) An update function which takes a bloaded object buffer and the index of the object to refresh as arguments RETURNS : Nothing useful SIDE EFFECTS : Objects bloaded and updated NOTES : Assumes binary file pointer is positioned for bloads of the objects ************************************************************/ globle void BloadandRefresh( void *theEnv, long objcnt, unsigned objsz, void (*objupdate)(void *,void *,long)) { register long i,bi; char *buf; long objsmaxread,objsread; unsigned long space; int (*oldOutOfMemoryFunction)(void *,unsigned long); if (objcnt == 0L) return; oldOutOfMemoryFunction = EnvSetOutOfMemoryFunction(theEnv,BloadOutOfMemoryFunction); objsmaxread = objcnt; do { space = objsmaxread * objsz; buf = (char *) genlongalloc(theEnv,space); if (buf == NULL) { if ((objsmaxread / 2) == 0) { if ((*oldOutOfMemoryFunction)(theEnv,space) == TRUE) { EnvSetOutOfMemoryFunction(theEnv,oldOutOfMemoryFunction); return; } } else objsmaxread /= 2; } } while (buf == NULL); EnvSetOutOfMemoryFunction(theEnv,oldOutOfMemoryFunction); i = 0L; do { objsread = (objsmaxread > (objcnt - i)) ? (objcnt - i) : objsmaxread; GenReadBinary(theEnv,(void *) buf,objsread * objsz); for (bi = 0L ; bi < objsread ; bi++ , i++) (*objupdate)(theEnv,buf + objsz * bi,i); } while (i < objcnt); genlongfree(theEnv,(void *) buf,space); } /**********************************************/ /* ReadNeededFunctions: Reads in the names of */ /* functions needed by the binary image. */ /**********************************************/ static struct FunctionDefinition **ReadNeededFunctions( void *theEnv, long int *numberOfFunctions, int *error) { char *functionNames, *namePtr; unsigned long int space,temp; long i; struct FunctionDefinition **newFunctionArray, *functionPtr; int functionsNotFound = 0; /*===================================================*/ /* Determine the number of function names to be read */ /* and the space required for them. */ /*===================================================*/ GenReadBinary(theEnv,numberOfFunctions,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); if (*numberOfFunctions == 0) { *error = FALSE; return(NULL); } /*=======================================*/ /* Allocate area for strings to be read. */ /*=======================================*/ functionNames = (char *) genlongalloc(theEnv,space); GenReadBinary(theEnv,(void *) functionNames,space); /*====================================================*/ /* Store the function pointers in the function array. */ /*====================================================*/ temp = (unsigned long) sizeof(struct FunctionDefinition *) * *numberOfFunctions; newFunctionArray = (struct FunctionDefinition **) genlongalloc(theEnv,temp); namePtr = functionNames; functionPtr = NULL; for (i = 0; i < *numberOfFunctions; i++) { if ((functionPtr = FastFindFunction(theEnv,namePtr,functionPtr)) == NULL) { if (! functionsNotFound) { PrintErrorID(theEnv,"BLOAD",6,FALSE); EnvPrintRouter(theEnv,WERROR,"The following undefined functions are "); EnvPrintRouter(theEnv,WERROR,"referenced by this binary image:\n"); } EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,namePtr); EnvPrintRouter(theEnv,WERROR,"\n"); functionsNotFound = 1; } newFunctionArray[i] = functionPtr; namePtr += strlen(namePtr) + 1; } /*==========================================*/ /* Free the memory used by the name buffer. */ /*==========================================*/ genlongfree(theEnv,(void *) functionNames,space); /*==================================================*/ /* If any of the required functions were not found, */ /* then free the memory used by the function array. */ /*==================================================*/ if (functionsNotFound) { genlongfree(theEnv,(void *) newFunctionArray,temp); newFunctionArray = NULL; } /*===================================*/ /* Set globals to appropriate values */ /* and return the function array. */ /*===================================*/ *error = functionsNotFound; return(newFunctionArray); } /*****************************************/ /* FastFindFunction: Search the function */ /* list for a specific function. */ /*****************************************/ static struct FunctionDefinition *FastFindFunction( void *theEnv, char *functionName, struct FunctionDefinition *lastFunction) { struct FunctionDefinition *theList, *theFunction; /*========================*/ /* Get the function list. */ /*========================*/ theList = GetFunctionList(theEnv); if (theList == NULL) { return(NULL); } /*=======================================*/ /* If we completed a previous function */ /* search, start where we last left off. */ /*=======================================*/ if (lastFunction != NULL) { theFunction = lastFunction->next; } else { theFunction = theList; } /*======================================================*/ /* Traverse the rest of the function list searching for */ /* the named function wrapping around if necessary. */ /*======================================================*/ while (strcmp(functionName,ValueToString(theFunction->callFunctionName)) != 0) { theFunction = theFunction->next; if (theFunction == lastFunction) return(NULL); if (theFunction == NULL) theFunction = theList; } /*=======================*/ /* Return the pointer to */ /* the found function. */ /*=======================*/ return(theFunction); } /******************************************/ /* Bloaded: Returns TRUE if the current */ /* environment is the result of a bload */ /* command, otherwise returns FALSE. */ /******************************************/ globle intBool Bloaded( void *theEnv) { return(BloadData(theEnv)->BloadActive); } /*************************************/ /* ClearBload: Clears a binary image */ /* from the KB environment. */ /*************************************/ static int ClearBload( void *theEnv) { struct BinaryItem *biPtr; struct callFunctionItem *bfPtr; int ready,error; /*=================================================*/ /* Make sure it's safe to clear the bloaded image. */ /*=================================================*/ error = FALSE; for (bfPtr = BloadData(theEnv)->ClearBloadReadyFunctions; bfPtr != NULL; bfPtr = bfPtr->next) { if (bfPtr->environmentAware) { ready = (* ((int (*)(void *)) bfPtr->func))(theEnv); } else { ready = (* ((int (*)(void)) bfPtr->func))(); } if (ready == FALSE) { if (! error) { PrintErrorID(theEnv,"BLOAD",5,FALSE); EnvPrintRouter(theEnv,WERROR, "Some constructs are still in use by the current binary image:\n"); } EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,bfPtr->name); EnvPrintRouter(theEnv,WERROR,"\n"); error = TRUE; } } /*==================================================*/ /* If some constructs are still in use and can't be */ /* cleared, indicate the binary load can't continue */ /* and return FALSE to indicate this condition. */ /*==================================================*/ if (error == TRUE) { EnvPrintRouter(theEnv,WERROR,"Binary clear cannot continue.\n"); return(FALSE); } /*=============================*/ /* Call bload clear functions. */ /*=============================*/ for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->clearFunction != NULL) (*biPtr->clearFunction)(theEnv); } /*===========================*/ /* Free bloaded expressions. */ /*===========================*/ ClearBloadedExpressions(theEnv); /*===========================*/ /* Free bloaded constraints. */ /*===========================*/ ClearBloadedConstraints(theEnv); /*==================================*/ /* Remove the bload clear function. */ /*==================================*/ BloadData(theEnv)->BloadActive = FALSE; EnvRemoveClearFunction(theEnv,"bload"); /*====================================*/ /* Return TRUE to indicate the binary */ /* image was successfully cleared. */ /*====================================*/ return(TRUE); } /*************************************************/ /* AbortBload: Cleans up effects of before-bload */ /* functions in event of failure. */ /*************************************************/ static void AbortBload( void *theEnv) { struct callFunctionItem *bfPtr; for (bfPtr = BloadData(theEnv)->AbortBloadFunctions; bfPtr != NULL; bfPtr = bfPtr->next) { if (bfPtr->environmentAware) { (*bfPtr->func)(theEnv); } else { (* (void (*)(void)) bfPtr->func)(); } } } /********************************************/ /* AddBeforeBloadFunction: Adds a function */ /* to the list of functions called before */ /* a binary load occurs. */ /********************************************/ globle void AddBeforeBloadFunction( void *theEnv, char *name, void (*func)(void *), int priority) { BloadData(theEnv)->BeforeBloadFunctions = AddFunctionToCallList(theEnv,name,priority,func,BloadData(theEnv)->BeforeBloadFunctions,TRUE); } /*******************************************/ /* AddAfterBloadFunction: Adds a function */ /* to the list of functions called after */ /* a binary load occurs. */ /*******************************************/ globle void AddAfterBloadFunction( void *theEnv, char *name, void (*func)(void *), int priority) { BloadData(theEnv)->AfterBloadFunctions = AddFunctionToCallList(theEnv,name,priority,func,BloadData(theEnv)->AfterBloadFunctions,TRUE); } /**************************************************/ /* AddClearBloadReadyFunction: Adds a function to */ /* the list of functions called to determine if */ /* a binary image can be cleared. */ /**************************************************/ globle void AddClearBloadReadyFunction( void *theEnv, char *name, int (*func)(void *), int priority) { BloadData(theEnv)->ClearBloadReadyFunctions = AddFunctionToCallList(theEnv,name,priority, (void (*)(void *)) func, BloadData(theEnv)->ClearBloadReadyFunctions,TRUE); } /*********************************************/ /* AddAbortBloadFunction: Adds a function to */ /* the list of functions called if a bload */ /* has to be aborted. */ /*********************************************/ globle void AddAbortBloadFunction( void *theEnv, char *name, void (*func)(void *), int priority) { BloadData(theEnv)->AbortBloadFunctions = AddFunctionToCallList(theEnv,name,priority,func,BloadData(theEnv)->AbortBloadFunctions,TRUE); } /******************************************************* NAME : BloadOutOfMemoryFunction DESCRIPTION : Memory function used by bload to prevent exiting when out of memory - used by BloadandRefresh INPUTS : The memory request size (unused) RETURNS : TRUE (indicates a failure and for the memory functions to simply return a NULL pointer) SIDE EFFECTS : None NOTES : None *******************************************************/ #if IBM_TBC #pragma argsused #endif static int BloadOutOfMemoryFunction( void *theEnv, unsigned long size) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(size,theEnv) #endif return(TRUE); } /*****************************************************/ /* CannotLoadWithBloadMessage: Generic error message */ /* for indicating that a construct can't be loaded */ /* when a binary image is active. */ /*****************************************************/ globle void CannotLoadWithBloadMessage( void *theEnv, char *constructName) { PrintErrorID(theEnv,"BLOAD",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot load "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," construct with binary load in effect.\n"); } #endif /* (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) */ /**************************************/ /* BloadCommand: H/L access routine */ /* for the bload command. */ /**************************************/ globle int BloadCommand( void *theEnv) { #if (! RUN_TIME) && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) char *fileName; if (EnvArgCountCheck(theEnv,"bload",EXACTLY,1) == -1) return(FALSE); fileName = GetFileName(theEnv,"bload",1); if (fileName != NULL) return(EnvBload(theEnv,fileName)); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif return(FALSE); } clips-6.24/clipssrc/._objrtbin.c0000400000175000017500000000075410441602261014711 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monacos}s}lJMM*H;TTFL,FMPSRMWBBLclips-6.24/clipssrc/._factcom.h0000400000175000017500000000075410357050014014520 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoAuAux/ m mlTTF{HFMPSRMWBBLclips-6.24/clipssrc/symblcmp.h0000755000175000017500000000374107422634616014550 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* SYMBOL CONSTRUCT COMPILER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for */ /* atomic data values: symbols, integers, floats, and */ /* bit maps. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_symblcmp #define _H_symblcmp #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _SYMBLCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void PrintSymbolReference(void *,FILE *,SYMBOL_HN *); LOCALE void PrintFloatReference(void *,FILE *,FLOAT_HN *); LOCALE void PrintIntegerReference(void *,FILE *,INTEGER_HN *); LOCALE void PrintBitMapReference(void *,FILE *,BITMAP_HN *); LOCALE void AtomicValuesToCode(void *,char *); #endif clips-6.24/clipssrc/._factrete.c0000400000175000017500000000075410441143445014701 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoKK1UTTFS FMWBBMPSRclips-6.24/clipssrc/._dffnxcmp.h0000400000175000017500000000012207422634652014715 0ustar jfsjfsMac OS X  2 RTEXT????`aclips-6.24/clipssrc/strngrtr.c0000755000175000017500000002436010177533457014604 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* STRING I/O ROUTER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: I/O Router routines which allow strings to be */ /* used as input and output sources. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _STRNGRTR_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "strngrtr.h" #define READ_STRING 0 #define WRITE_STRING 1 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int FindString(void *,char *); static int PrintString(void *,char *,char *); static int GetcString(void *,char *); static int UngetcString(void *,int,char *); static struct stringRouter *FindStringRouter(void *,char *); static int CreateReadStringSource(void *,char *,char *,int,unsigned); static void DeallocateStringRouterData(void *); /**********************************************************/ /* InitializeStringRouter: Initializes string I/O router. */ /**********************************************************/ globle void InitializeStringRouter( void *theEnv) { AllocateEnvironmentData(theEnv,STRING_ROUTER_DATA,sizeof(struct stringRouterData),DeallocateStringRouterData); EnvAddRouter(theEnv,"string",0,FindString,PrintString,GetcString,UngetcString,NULL); } /*******************************************/ /* DeallocateStringRouterData: Deallocates */ /* environment data for string routers. */ /*******************************************/ static void DeallocateStringRouterData( void *theEnv) { struct stringRouter *tmpPtr, *nextPtr; tmpPtr = StringRouterData(theEnv)->ListOfStringRouters; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rm(theEnv,tmpPtr->name,strlen(tmpPtr->name) + 1); rtn_struct(theEnv,stringRouter,tmpPtr); tmpPtr = nextPtr; } } /*************************************************************/ /* FindString: Find routine for string router logical names. */ /*************************************************************/ static int FindString( void *theEnv, char *fileid) { struct stringRouter *head; head = StringRouterData(theEnv)->ListOfStringRouters; while (head != NULL) { if (strcmp(head->name,fileid) == 0) { return(TRUE); } head = head->next; } return(FALSE); } /**************************************************/ /* PrintString: Print routine for string routers. */ /**************************************************/ static int PrintString( void *theEnv, char *logicalName, char *str) { struct stringRouter *head; head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,"ROUTER",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != WRITE_STRING) return(1); if (head->currentPosition >= (int) (head->maximumPosition - 1)) return(1); strncpy(&head->str[head->currentPosition], str,(STD_SIZE) (head->maximumPosition - head->currentPosition) - 1); head->currentPosition += (int) strlen(str); return(1); } /************************************************/ /* GetcString: Getc routine for string routers. */ /************************************************/ static int GetcString( void *theEnv, char *logicalName) { struct stringRouter *head; int rc; head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,"ROUTER",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != READ_STRING) return(EOF); if (head->currentPosition >= (int) head->maximumPosition) { head->currentPosition++; return(EOF); } rc = (unsigned char) head->str[head->currentPosition]; head->currentPosition++; return(rc); } /****************************************************/ /* UngetcString: Ungetc routine for string routers. */ /****************************************************/ #if IBM_TBC #pragma argsused #endif static int UngetcString( void *theEnv, int ch, char *logicalName) { struct stringRouter *head; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(ch) #endif head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,"ROUTER",2); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != READ_STRING) return(0); if (head->currentPosition > 0) { head->currentPosition--; } return(1); } /************************************************/ /* OpenStringSource: Opens a new string router. */ /************************************************/ globle int OpenStringSource( void *theEnv, char *name, char *str, int currentPosition) { unsigned maximumPosition; if (str == NULL) { currentPosition = 0; maximumPosition = 0; } else { maximumPosition = strlen(str); } return(CreateReadStringSource(theEnv,name,str,currentPosition,maximumPosition)); } /******************************************************/ /* OpenTextSource: Opens a new string router for text */ /* (which is not NULL terminated). */ /******************************************************/ globle int OpenTextSource( void *theEnv, char *name, char *str, int currentPosition, unsigned maximumPosition) { if (str == NULL) { currentPosition = 0; maximumPosition = 0; } return(CreateReadStringSource(theEnv,name,str,currentPosition,maximumPosition)); } /******************************************************************/ /* CreateReadStringSource: Creates a new string router for input. */ /******************************************************************/ static int CreateReadStringSource( void *theEnv, char *name, char *str, int currentPosition, unsigned maximumPosition) { struct stringRouter *newStringRouter; if (FindStringRouter(theEnv,name) != NULL) return(0); newStringRouter = get_struct(theEnv,stringRouter); newStringRouter->name = (char *) gm1(theEnv,(int) strlen(name) + 1); strcpy(newStringRouter->name,name); newStringRouter->str = str; newStringRouter->currentPosition = currentPosition; newStringRouter->readWriteType = READ_STRING; newStringRouter->maximumPosition = maximumPosition; newStringRouter->next = StringRouterData(theEnv)->ListOfStringRouters; StringRouterData(theEnv)->ListOfStringRouters = newStringRouter; return(1); } /**********************************************/ /* CloseStringSource: Closes a string router. */ /**********************************************/ globle int CloseStringSource( void *theEnv, char *name) { struct stringRouter *head, *last; last = NULL; head = StringRouterData(theEnv)->ListOfStringRouters; while (head != NULL) { if (strcmp(head->name,name) == 0) { if (last == NULL) { StringRouterData(theEnv)->ListOfStringRouters = head->next; rm(theEnv,head->name,strlen(head->name) + 1); rtn_struct(theEnv,stringRouter,head); return(1); } else { last->next = head->next; rm(theEnv,head->name,strlen(head->name) + 1); rtn_struct(theEnv,stringRouter,head); return(1); } } last = head; head = head->next; } return(0); } /******************************************************************/ /* OpenStringDestination: Opens a new string router for printing. */ /******************************************************************/ globle int OpenStringDestination( void *theEnv, char *name, char *str, unsigned maximumPosition) { struct stringRouter *newStringRouter; if (FindStringRouter(theEnv,name) != NULL) return(0); newStringRouter = get_struct(theEnv,stringRouter); newStringRouter->name = (char *) gm1(theEnv,(int) strlen(name) + 1); strcpy(newStringRouter->name,name); newStringRouter->str = str; newStringRouter->currentPosition = 0; newStringRouter->readWriteType = WRITE_STRING; newStringRouter->maximumPosition = maximumPosition; newStringRouter->next = StringRouterData(theEnv)->ListOfStringRouters; StringRouterData(theEnv)->ListOfStringRouters = newStringRouter; return(1); } /***************************************************/ /* CloseStringDestination: Closes a string router. */ /***************************************************/ globle int CloseStringDestination( void *theEnv, char *name) { return(CloseStringSource(theEnv,name)); } /*******************************************************************/ /* FindStringRouter: Returns a pointer to the named string router. */ /*******************************************************************/ static struct stringRouter *FindStringRouter( void *theEnv, char *name) { struct stringRouter *head; head = StringRouterData(theEnv)->ListOfStringRouters; while (head != NULL) { if (strcmp(head->name,name) == 0) { return(head); } head = head->next; } return(NULL); } clips-6.24/clipssrc/._rulecom.c0000400000175000017500000000075410441150752014551 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco++<TTF/BFMPSRMWBBLclips-6.24/clipssrc/._factlhs.c0000400000175000017500000000075410177533437014542 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z$?nTTFT#KFMWBBMPSRclips-6.24/clipssrc/classfun.h0000755000175000017500000001124310441130121014505 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_classfun #define _H_classfun #ifndef _H_object #include "object.h" #endif #define TestTraversalID(traversalRecord,id) TestBitMap(traversalRecord,id) #define SetTraversalID(traversalRecord,id) SetBitMap(traversalRecord,id) #define ClearTraversalID(traversalRecord,id) ClearBitMap(traversalRecord,id) #define CLASS_TABLE_HASH_SIZE 167 #define SLOT_NAME_TABLE_HASH_SIZE 167 #define INITIAL_OBJECT_CLASS_NAME "INITIAL-OBJECT" #define ISA_ID 0 #define NAME_ID 1 #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void IncrementDefclassBusyCount(void *,void *); LOCALE void DecrementDefclassBusyCount(void *,void *); LOCALE intBool InstancesPurge(void *theEnv); #if ! RUN_TIME LOCALE void InitializeClasses(void *); #endif LOCALE SLOT_DESC *FindClassSlot(DEFCLASS *,SYMBOL_HN *); LOCALE void ClassExistError(void *,char *,char *); LOCALE void DeleteClassLinks(void *,CLASS_LINK *); LOCALE void PrintClassName(void *,char *,DEFCLASS *,intBool); #if DEBUGGING_FUNCTIONS || ((! BLOAD_ONLY) && (! RUN_TIME)) LOCALE void PrintPackedClassLinks(void *,char *,char *,PACKED_CLASS_LINKS *); #endif #if ! RUN_TIME LOCALE void PutClassInTable(void *,DEFCLASS *); LOCALE void RemoveClassFromTable(void *,DEFCLASS *); LOCALE void AddClassLink(void *,PACKED_CLASS_LINKS *,DEFCLASS *,int); LOCALE void DeleteSubclassLink(void *,DEFCLASS *,DEFCLASS *); LOCALE DEFCLASS *NewClass(void *,SYMBOL_HN *); LOCALE void DeletePackedClassLinks(void *,PACKED_CLASS_LINKS *,int); LOCALE void AssignClassID(void *,DEFCLASS *); LOCALE SLOT_NAME *AddSlotName(void *,SYMBOL_HN *,unsigned,int); LOCALE void DeleteSlotName(void *,SLOT_NAME *); LOCALE void RemoveDefclass(void *,void *); LOCALE void InstallClass(void *,DEFCLASS *,int); #endif LOCALE void DestroyDefclass(void *,void *); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE int IsClassBeingUsed(DEFCLASS *); LOCALE int RemoveAllUserClasses(void *); LOCALE int DeleteClassUAG(void *,DEFCLASS *); LOCALE void MarkBitMapSubclasses(char *,DEFCLASS *,int); #endif LOCALE short FindSlotNameID(void *,SYMBOL_HN *); LOCALE SYMBOL_HN *FindIDSlotName(void *,unsigned); LOCALE SLOT_NAME *FindIDSlotNameHash(void *,unsigned); LOCALE int GetTraversalID(void *); LOCALE void ReleaseTraversalID(void *); LOCALE unsigned HashClass(SYMBOL_HN *); #ifndef _CLASSFUN_SOURCE_ #if DEFRULE_CONSTRUCT extern SYMBOL_HN *INITIAL_OBJECT_SYMBOL; #endif #if DEBUGGING_FUNCTIONS extern unsigned WatchInstances,WatchSlots; #endif #endif #define DEFCLASS_DATA 21 #define PRIMITIVE_CLASSES 9 struct defclassData { struct construct *DefclassConstruct; int DefclassModuleIndex; ENTITY_RECORD DefclassEntityRecord; DEFCLASS *PrimitiveClassMap[PRIMITIVE_CLASSES]; DEFCLASS **ClassIDMap; DEFCLASS **ClassTable; unsigned short MaxClassID; unsigned short AvailClassID; SLOT_NAME **SlotNameTable; SYMBOL_HN *ISA_SYMBOL; SYMBOL_HN *NAME_SYMBOL; #if DEFRULE_CONSTRUCT SYMBOL_HN *INITIAL_OBJECT_SYMBOL; #endif #if DEBUGGING_FUNCTIONS unsigned WatchInstances; unsigned WatchSlots; #endif unsigned short CTID; struct token ObjectParseToken; unsigned short ClassDefaultsMode; }; #define DefclassData(theEnv) ((struct defclassData *) GetEnvironmentData(theEnv,DEFCLASS_DATA)) #endif clips-6.24/clipssrc/._classcom.h0000400000175000017500000000075410441130017014704 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0k0k?,,TTFSFMWBBMPSRclips-6.24/clipssrc/tmpltrhs.c0000755000175000017500000004506510441167041014563 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFTEMPLATE RHS PARSING HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses deftemplate fact patterns used with the */ /* assert function. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added additional argument required for */ /* DeriveDefaultFromConstraints. */ /* */ /* Added additional argument required for */ /* InvalidDeftemplateSlotMessage. */ /* */ /*************************************************************/ #define _TMPLTRHS_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "prntutil.h" #include "router.h" #include "tmpltfun.h" #include "tmpltdef.h" #include "factrhs.h" #include "extnfunc.h" #include "modulutl.h" #include "default.h" #include "tmpltutl.h" #include "tmpltlhs.h" #include "tmpltrhs.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct expr *ParseAssertSlotValues(void *,char *,struct token *,struct templateSlot *,int *,int); static struct expr *ReorderAssertSlotValues(void *,struct templateSlot *,struct expr *,int *); static struct expr *GetSlotAssertValues(void *,struct templateSlot *,struct expr *,int *); static struct expr *FindAssertSlotItem(struct templateSlot *,struct expr *); static struct templateSlot *ParseSlotLabel(void *,char *,struct token *,struct deftemplate *,int *,int); /******************************************************************/ /* ParseAssertTemplate: Parses and builds the list of values that */ /* are used for an assert of a fact with a deftemplate. */ /******************************************************************/ globle struct expr *ParseAssertTemplate( void *theEnv, char *readSource, struct token *theToken, int *error, int endType, int constantsOnly, struct deftemplate *theDeftemplate) { struct expr *firstSlot, *lastSlot, *nextSlot; struct expr *firstArg, *tempSlot; struct templateSlot *slotPtr; firstSlot = NULL; lastSlot = NULL; /*==============================================*/ /* Parse each of the slot fields in the assert. */ /*==============================================*/ while ((slotPtr = ParseSlotLabel(theEnv,readSource,theToken,theDeftemplate,error,endType)) != NULL) { /*========================================================*/ /* Check to see that the slot hasn't already been parsed. */ /*========================================================*/ for (tempSlot = firstSlot; tempSlot != NULL; tempSlot = tempSlot->nextArg) { if (tempSlot->value == (void *) slotPtr->slotName) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(slotPtr->slotName)); *error = TRUE; ReturnExpression(theEnv,firstSlot); return(NULL); } } /*============================================*/ /* Parse the values to be stored in the slot. */ /*============================================*/ nextSlot = ParseAssertSlotValues(theEnv,readSource,theToken, slotPtr,error,constantsOnly); if (*error) { ReturnExpression(theEnv,firstSlot); return(NULL); } /*============================================*/ /* Check to see if the values to be stored in */ /* the slot violate the slot's constraints. */ /*============================================*/ if (CheckRHSSlotTypes(theEnv,nextSlot->argList,slotPtr,"assert") == 0) { *error = TRUE; ReturnExpression(theEnv,firstSlot); ReturnExpression(theEnv,nextSlot); return(NULL); } /*===================================================*/ /* Add the slot to the list of slots already parsed. */ /*===================================================*/ if (lastSlot == NULL) { firstSlot = nextSlot; } else { lastSlot->nextArg = nextSlot; } lastSlot = nextSlot; } /*=================================================*/ /* Return if an error occured parsing a slot name. */ /*=================================================*/ if (*error) { ReturnExpression(theEnv,firstSlot); return(NULL); } /*=============================================================*/ /* Reorder the arguments to the order used by the deftemplate. */ /*=============================================================*/ firstArg = ReorderAssertSlotValues(theEnv,theDeftemplate->slotList,firstSlot,error); ReturnExpression(theEnv,firstSlot); /*==============================*/ /* Return the assert arguments. */ /*==============================*/ return(firstArg); } /****************************************************************/ /* ParseSlotLabel: Parses the beginning of a slot definition. */ /* Checks for opening left parenthesis and a valid slot name. */ /****************************************************************/ static struct templateSlot *ParseSlotLabel( void *theEnv, char *inputSource, struct token *tempToken, struct deftemplate *theDeftemplate, int *error, int endType) { struct templateSlot *slotPtr; short position; /*========================*/ /* Initialize error flag. */ /*========================*/ *error = FALSE; /*============================================*/ /* If token is a right parenthesis, then fact */ /* template definition is complete. */ /*============================================*/ GetToken(theEnv,inputSource,tempToken); if (tempToken->type == endType) { return(NULL); } /*=======================================*/ /* Put a space between the template name */ /* and the first slot definition. */ /*=======================================*/ PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,tempToken->printForm); /*=======================================================*/ /* Slot definition begins with opening left parenthesis. */ /*=======================================================*/ if (tempToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"deftemplate pattern"); *error = TRUE; return(NULL); } /*=============================*/ /* Slot name must be a symbol. */ /*=============================*/ GetToken(theEnv,inputSource,tempToken); if (tempToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"deftemplate pattern"); *error = TRUE; return(NULL); } /*======================================================*/ /* Check that the slot name is valid for this template. */ /*======================================================*/ if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempToken->value,&position)) == NULL) { InvalidDeftemplateSlotMessage(theEnv,ValueToString(tempToken->value), ValueToString(theDeftemplate->header.name),TRUE); *error = TRUE; return(NULL); } /*====================================*/ /* Return a pointer to the slot name. */ /*====================================*/ return(slotPtr); } /**************************************************************************/ /* ParseAssertSlotValues: Gets a single assert slot value for a template. */ /**************************************************************************/ static struct expr *ParseAssertSlotValues( void *theEnv, char *inputSource, struct token *tempToken, struct templateSlot *slotPtr, int *error, int constantsOnly) { struct expr *nextSlot; struct expr *newField, *valueList, *lastValue; int printError; /*=============================*/ /* Handle a single field slot. */ /*=============================*/ if (slotPtr->multislot == FALSE) { /*=====================*/ /* Get the slot value. */ /*=====================*/ SavePPBuffer(theEnv," "); newField = GetAssertArgument(theEnv,inputSource,tempToken, error,RPAREN,constantsOnly,&printError); if (*error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); return(NULL); } /*=================================================*/ /* A single field slot value must contain a value. */ /* Only a multifield slot can be empty. */ /*=================================================*/ if (newField == NULL) { *error = TRUE; SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); return(NULL); } /*==============================================*/ /* A function returning a multifield value can */ /* not be called to get the value for the slot. */ /*==============================================*/ if ((newField->type == FCALL) ? (ExpressionFunctionType(newField) == 'm') : (newField->type == MF_VARIABLE)) { *error = TRUE; SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); ReturnExpression(theEnv,newField); return(NULL); } /*============================*/ /* Move on to the next token. */ /*============================*/ GetToken(theEnv,inputSource,tempToken); } /*========================================*/ /* Handle a multifield slot. Build a list */ /* of the values stored in the slot. */ /*========================================*/ else { SavePPBuffer(theEnv," "); valueList = GetAssertArgument(theEnv,inputSource,tempToken, error,RPAREN,constantsOnly,&printError); if (*error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); return(NULL); } if (valueList == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } lastValue = valueList; while (lastValue != NULL) /* (tempToken->type != RPAREN) */ { if (tempToken->type == RPAREN) { SavePPBuffer(theEnv," "); } else { /* PPBackup(theEnv); */ SavePPBuffer(theEnv," "); /* SavePPBuffer(theEnv,tempToken->printForm); */ } newField = GetAssertArgument(theEnv,inputSource,tempToken,error,RPAREN,constantsOnly,&printError); if (*error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); ReturnExpression(theEnv,valueList); return(NULL); } if (newField == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } lastValue->nextArg = newField; lastValue = newField; } newField = valueList; } /*==========================================================*/ /* Slot definition must be closed with a right parenthesis. */ /*==========================================================*/ if (tempToken->type != RPAREN) { SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents); *error = TRUE; ReturnExpression(theEnv,newField); return(NULL); } /*=========================================================*/ /* Build and return a structure describing the slot value. */ /*=========================================================*/ nextSlot = GenConstant(theEnv,SYMBOL,slotPtr->slotName); nextSlot->argList = newField; return(nextSlot); } /*************************************************************************/ /* ReorderAssertSlotValues: Rearranges the asserted values to correspond */ /* to the order of the values described by the deftemplate. */ /*************************************************************************/ static struct expr *ReorderAssertSlotValues( void *theEnv, struct templateSlot *slotPtr, struct expr *firstSlot, int *error) { struct expr *firstArg = NULL; struct expr *lastArg = NULL, *newArg; /*=============================================*/ /* Loop through each of the slots in the order */ /* they're found in the deftemplate. */ /*=============================================*/ for (; slotPtr != NULL; slotPtr = slotPtr->next) { /*==============================================*/ /* Get either the value specified in the assert */ /* command or the default value for the slot. */ /*==============================================*/ newArg = GetSlotAssertValues(theEnv,slotPtr,firstSlot,error); if (*error) { ReturnExpression(theEnv,firstArg); return(NULL); } /*=====================================*/ /* Add the value to the list of values */ /* for the assert command. */ /*=====================================*/ if (newArg != NULL) { if (lastArg == NULL) { firstArg = newArg; } else { lastArg->nextArg = newArg; } lastArg = newArg; } } /*==============================*/ /* Return the list of arguments */ /* for the assert command. */ /*==============================*/ return(firstArg); } /***************************************************************/ /* GetSlotAssertValues: Gets the assert value for a given slot */ /* of a deftemplate. If the value was supplied by the user, */ /* it will be used. If not the default value or default */ /* default value will be used. */ /***************************************************************/ static struct expr *GetSlotAssertValues( void *theEnv, struct templateSlot *slotPtr, struct expr *firstSlot, int *error) { struct expr *slotItem; struct expr *newArg, *tempArg; DATA_OBJECT theDefault; /*==================================================*/ /* Determine if the slot is assigned in the assert. */ /*==================================================*/ slotItem = FindAssertSlotItem(slotPtr,firstSlot); /*==========================================*/ /* If the slot is assigned, use that value. */ /*==========================================*/ if (slotItem != NULL) { newArg = slotItem->argList; slotItem->argList = NULL; } /*=================================*/ /* Otherwise, use a default value. */ /*=================================*/ else { /*================================================*/ /* If the (default ?NONE) attribute was specified */ /* for the slot, then a value must be supplied. */ /*================================================*/ if (slotPtr->noDefault) { PrintErrorID(theEnv,"TMPLTRHS",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Slot "); EnvPrintRouter(theEnv,WERROR,slotPtr->slotName->contents); EnvPrintRouter(theEnv,WERROR," requires a value because of its (default ?NONE) attribute.\n"); *error = TRUE; return(NULL); } /*===================================================*/ /* If the (default ?DERIVE) attribute was specified */ /* (the default), then derive the default value from */ /* the slot's constraints. */ /*===================================================*/ else if ((slotPtr->defaultPresent == FALSE) && (slotPtr->defaultDynamic == FALSE)) { DeriveDefaultFromConstraints(theEnv,slotPtr->constraints,&theDefault, (int) slotPtr->multislot,TRUE); newArg = ConvertValueToExpression(theEnv,&theDefault); } /*=========================================*/ /* Otherwise, use the expression contained */ /* in the default attribute. */ /*=========================================*/ else { newArg = CopyExpression(theEnv,slotPtr->defaultList); } } /*=======================================================*/ /* Since a multifield slot default can contain a list of */ /* values, the values need to have a store-multifield */ /* function called wrapped around it to group all of the */ /* values into a single multifield value. */ /*=======================================================*/ if (slotPtr->multislot) { tempArg = GenConstant(theEnv,FACT_STORE_MULTIFIELD,AddBitMap(theEnv,(void *) "\0",1)); tempArg->argList = newArg; newArg = tempArg; } /*==============================================*/ /* Return the value to be asserted in the slot. */ /*==============================================*/ return(newArg); } /*******************************************************************/ /* FindAssertSlotItem: Finds a particular slot in a list of slots. */ /*******************************************************************/ static struct expr *FindAssertSlotItem( struct templateSlot *slotPtr, struct expr *listOfSlots) { while (listOfSlots != NULL) { if (listOfSlots->value == (void *) slotPtr->slotName) return (listOfSlots); listOfSlots = listOfSlots->nextArg; } return(NULL); } #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/usrsetup.h0000755000175000017500000000000010200331140014543 0ustar jfsjfsclips-6.24/clipssrc/dffnxexe.c0000755000175000017500000001657210170037501014512 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.23 01/31/05 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Deffunction Execution Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #include "constrct.h" #include "envrnmnt.h" #include "prcdrfun.h" #include "prccode.h" #include "proflfun.h" #include "router.h" #include "utility.h" #include "watch.h" #define _DFFNXEXE_SOURCE_ #include "dffnxexe.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define BEGIN_TRACE ">> " #define END_TRACE "<< " /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void UnboundDeffunctionErr(void *); #if DEBUGGING_FUNCTIONS static void WatchDeffunction(void *,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,) ****************************************************/ globle void CallDeffunction( void *theEnv, DEFFUNCTION *dptr, EXPRESSION *args, DATA_OBJECT *result) { int oldce; DEFFUNCTION *previouslyExecutingDeffunction; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = FALSE; if (EvaluationData(theEnv)->HaltExecution) return; oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); previouslyExecutingDeffunction = DeffunctionData(theEnv)->ExecutingDeffunction; DeffunctionData(theEnv)->ExecutingDeffunction = dptr; EvaluationData(theEnv)->CurrentEvaluationDepth++; dptr->executing++; PushProcParameters(theEnv,args,CountArguments(args),EnvGetDeffunctionName(theEnv,(void *) dptr), "deffunction",UnboundDeffunctionErr); if (EvaluationData(theEnv)->EvaluationError) { dptr->executing--; DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction; EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); 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, result,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--; PropagateReturnValue(theEnv,result); PeriodicCleanup(theEnv,FALSE,TRUE); 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 WERROR NOTES : None *******************************************************/ static void UnboundDeffunctionErr( void *theEnv) { EnvPrintRouter(theEnv,WERROR,"deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) DeffunctionData(theEnv)->ExecutingDeffunction)); EnvPrintRouter(theEnv,WERROR,".\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( void *theEnv, char *tstring) { EnvPrintRouter(theEnv,WTRACE,"DFN "); EnvPrintRouter(theEnv,WTRACE,tstring); if (DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *) DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule)); EnvPrintRouter(theEnv,WTRACE,"::"); } EnvPrintRouter(theEnv,WTRACE,ValueToString(DeffunctionData(theEnv)->ExecutingDeffunction->header.name)); EnvPrintRouter(theEnv,WTRACE," ED:"); PrintLongInteger(theEnv,WTRACE,(long) EvaluationData(theEnv)->CurrentEvaluationDepth); PrintProcParamArray(theEnv,WTRACE); } #endif #endif clips-6.24/clipssrc/._objrtcmp.h0000400000175000017500000000061410441072155014723 0ustar jfsjfsMac OS X  2 R:TEXT????22S42MWBB clips-6.24/clipssrc/._watch.c0000400000175000017500000000075410443631620014211 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco`\`\mTTFH8.FMWBBMPSRclips-6.24/clipssrc/._genrccmp.c0000400000175000017500000000075410253662740014707 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoUlUl˾$[XtTTFS^FMPSRMWBBLclips-6.24/clipssrc/userfunctions.c0000644000175000017500000001013710443377372015616 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 04/21/06 */ /* */ /* USER FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Created file to seperate UserFunctions and */ /* EnvUserFunctions from main.c. */ /* */ /*************************************************************/ /***************************************************************************/ /* */ /* Permission is hereby granted, free of charge, to any person obtaining */ /* a copy of this software and associated documentation files (the */ /* "Software"), to deal in the Software without restriction, including */ /* without limitation the rights to use, copy, modify, merge, publish, */ /* distribute, and/or sell copies of the Software, and to permit persons */ /* to whom the Software is furnished to do so. */ /* */ /* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS */ /* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF */ /* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT */ /* OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY */ /* CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES */ /* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN */ /* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF */ /* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* */ /***************************************************************************/ #include "setup.h" #include "extnfunc.h" void UserFunctions(void); void EnvUserFunctions(void *); /*********************************************************/ /* UserFunctions: Informs the expert system environment */ /* of any user defined functions. In the default case, */ /* there are no user defined functions. To define */ /* functions, either this function must be replaced by */ /* a function with the same name within this file, or */ /* this function can be deleted from this file and */ /* included in another file. */ /*********************************************************/ void UserFunctions() { } /***********************************************************/ /* EnvUserFunctions: Informs the expert system environment */ /* of any user defined functions. In the default case, */ /* there are no user defined functions. To define */ /* functions, either this function must be replaced by */ /* a function with the same name within this file, or */ /* this function can be deleted from this file and */ /* included in another file. */ /***********************************************************/ #if IBM_TBC #pragma argsused #endif void EnvUserFunctions( void *theEnv) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif } clips-6.24/clipssrc/cstrnops.c0000755000175000017500000012330010441602124014542 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* CONSTRAINT OPERATIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functions for performing operations on */ /* constraint records including computing the intersection */ /* and union of constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added allowed-classes slot facet. */ /* */ /*************************************************************/ #define _CSTRNOPS_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #if (! RUN_TIME) #include "constant.h" #include "envrnmnt.h" #include "memalloc.h" #include "router.h" #include "extnfunc.h" #include "scanner.h" #include "multifld.h" #include "constrnt.h" #include "cstrnchk.h" #include "cstrnutl.h" #include "cstrnops.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void IntersectNumericExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *,int); static void IntersectAllowedValueExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static void IntersectAllowedClassExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static int FindItemInExpression(int,void *,int,struct expr *); static void UpdateRestrictionFlags(CONSTRAINT_RECORD *); #if (! BLOAD_ONLY) static void UnionRangeMinMaxValueWithList(void *, struct expr *, struct expr *, struct expr **, struct expr **); static void UnionNumericExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *,int); static struct expr *AddToUnionList(void *, struct expr *,struct expr *, CONSTRAINT_RECORD *); static void UnionAllowedValueExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static void UnionAllowedClassExpressions(void *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *, CONSTRAINT_RECORD *); static int RestrictionOnType(int,CONSTRAINT_RECORD *); #endif /**************************************************************/ /* IntersectConstraints: Creates a new constraint record that */ /* is the intersection of two other constraint records. */ /**************************************************************/ globle struct constraintRecord *IntersectConstraints( void *theEnv, CONSTRAINT_RECORD *c1, CONSTRAINT_RECORD *c2) { struct constraintRecord *rv; int c1Changed = FALSE, c2Changed = FALSE; /*=================================================*/ /* If both constraint records are NULL,then create */ /* a constraint record that allows any value. */ /*=================================================*/ if ((c1 == NULL) && (c2 == NULL)) { rv = GetConstraintRecord(theEnv); rv->multifieldsAllowed = TRUE; return(rv); } /*=================================================*/ /* If one of the constraint records is NULL, then */ /* the intersection is the other constraint record */ /* (a NULL value means no constraints). */ /*=================================================*/ if (c1 == NULL) return(CopyConstraintRecord(theEnv,c2)); if (c2 == NULL) return(CopyConstraintRecord(theEnv,c1)); /*=================================*/ /* Create a new constraint record. */ /*=================================*/ rv = GetConstraintRecord(theEnv); /*==============================*/ /* Intersect the allowed types. */ /*==============================*/ if ((c1->multifieldsAllowed != c2->multifieldsAllowed) && (c1->singlefieldsAllowed != c2->singlefieldsAllowed)) { rv->anyAllowed = FALSE; return(rv); } if (c1->multifieldsAllowed && c2->multifieldsAllowed) { rv->multifieldsAllowed = TRUE; } else { rv->multifieldsAllowed = FALSE; } if (c1->singlefieldsAllowed && c2->singlefieldsAllowed) { rv->singlefieldsAllowed = TRUE; } else { rv->singlefieldsAllowed = FALSE; } if (c1->anyAllowed && c2->anyAllowed) rv->anyAllowed = TRUE; else { if (c1->anyAllowed) { c1Changed = TRUE; SetAnyAllowedFlags(c1,FALSE); } else if (c2->anyAllowed) { c2Changed = TRUE; SetAnyAllowedFlags(c2,FALSE); } rv->anyAllowed = FALSE; rv->symbolsAllowed = (c1->symbolsAllowed && c2->symbolsAllowed); rv->stringsAllowed = (c1->stringsAllowed && c2->stringsAllowed); rv->floatsAllowed = (c1->floatsAllowed && c2->floatsAllowed); rv->integersAllowed = (c1->integersAllowed && c2->integersAllowed); rv->instanceNamesAllowed = (c1->instanceNamesAllowed && c2->instanceNamesAllowed); rv->instanceAddressesAllowed = (c1->instanceAddressesAllowed && c2->instanceAddressesAllowed); rv->externalAddressesAllowed = (c1->externalAddressesAllowed && c2->externalAddressesAllowed); rv->voidAllowed = (c1->voidAllowed && c2->voidAllowed); rv->multifieldsAllowed = (c1->multifieldsAllowed && c2->multifieldsAllowed); rv->factAddressesAllowed = (c1->factAddressesAllowed && c2->factAddressesAllowed); if (c1Changed) SetAnyAllowedFlags(c1,TRUE); if (c2Changed) SetAnyAllowedFlags(c2,TRUE); } /*=====================================*/ /* Intersect the allowed-values flags. */ /*=====================================*/ if (c1->anyRestriction || c2->anyRestriction) rv->anyRestriction = TRUE; else { rv->anyRestriction = FALSE; rv->symbolRestriction = (c1->symbolRestriction || c2->symbolRestriction); rv->stringRestriction = (c1->stringRestriction || c2->stringRestriction); rv->floatRestriction = (c1->floatRestriction || c2->floatRestriction); rv->integerRestriction = (c1->integerRestriction || c2->integerRestriction); rv->classRestriction = (c1->classRestriction || c2->classRestriction); rv->instanceNameRestriction = (c1->instanceNameRestriction || c2->instanceNameRestriction); } /*==================================================*/ /* Intersect the allowed values list, allowed class */ /* list, min and max values, and the range values. */ /*==================================================*/ IntersectAllowedValueExpressions(theEnv,c1,c2,rv); IntersectAllowedClassExpressions(theEnv,c1,c2,rv); IntersectNumericExpressions(theEnv,c1,c2,rv,TRUE); IntersectNumericExpressions(theEnv,c1,c2,rv,FALSE); /*==========================================*/ /* Update the allowed-values flags based on */ /* the previous intersection for allowed, */ /* min and max, and range values. */ /*==========================================*/ UpdateRestrictionFlags(rv); /*============================================*/ /* If multifields are allowed, then intersect */ /* the constraint record for them. */ /*============================================*/ if (rv->multifieldsAllowed) { rv->multifield = IntersectConstraints(theEnv,c1->multifield,c2->multifield); if (UnmatchableConstraint(rv->multifield)) { rv->multifieldsAllowed = FALSE; } } /*========================*/ /* Return the intersected */ /* constraint record. */ /*========================*/ return(rv); } /*************************************************/ /* IntersectAllowedValueExpressions: Creates the */ /* intersection of two allowed-values lists. */ /*************************************************/ static void IntersectAllowedValueExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint) { struct expr *theList1, *theList2; struct expr *theHead = NULL, *tmpExpr; /*===========================================*/ /* Loop through each value in allowed-values */ /* list of the first constraint record. Add */ /* each value to a list if it satisfies the */ /* restrictions for both constraint records. */ /*===========================================*/ for (theList1 = constraint1->restrictionList; theList1 != NULL; theList1 = theList1->nextArg) { if (CheckAllowedValuesConstraint(theList1->type,theList1->value,constraint1) && CheckAllowedValuesConstraint(theList1->type,theList1->value,constraint2)) { tmpExpr = GenConstant(theEnv,theList1->type,theList1->value); tmpExpr->nextArg = theHead; theHead = tmpExpr; } } /*===========================================*/ /* Loop through each value in allowed-values */ /* list of the second constraint record. Add */ /* each value to a list if it satisfies the */ /* restrictions for both constraint records. */ /*===========================================*/ for (theList2 = constraint2->restrictionList; theList2 != NULL; theList2 = theList2->nextArg) { if (FindItemInExpression(theList2->type,theList2->value,TRUE,theHead)) { /* The value is already in the list--Do nothing */ } else if (CheckAllowedValuesConstraint(theList2->type,theList2->value,constraint1) && CheckAllowedValuesConstraint(theList2->type,theList2->value,constraint2)) { tmpExpr = GenConstant(theEnv,theList2->type,theList2->value); tmpExpr->nextArg = theHead; theHead = tmpExpr; } } /*================================================*/ /* Set the allowed values list for the constraint */ /* record to the intersected values of the two */ /* other constraint records. */ /*================================================*/ newConstraint->restrictionList = theHead; } /*************************************************/ /* IntersectAllowedClassExpressions: Creates the */ /* intersection of two allowed-classes lists. */ /*************************************************/ static void IntersectAllowedClassExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint) { struct expr *theList1, *theList2; struct expr *theHead = NULL, *tmpExpr; /*============================================*/ /* Loop through each value in allowed-classes */ /* list of the first constraint record. Add */ /* each value to a list if it satisfies the */ /* restrictions for both constraint records. */ /*============================================*/ for (theList1 = constraint1->classList; theList1 != NULL; theList1 = theList1->nextArg) { if (CheckAllowedClassesConstraint(theEnv,theList1->type,theList1->value,constraint1) && CheckAllowedClassesConstraint(theEnv,theList1->type,theList1->value,constraint2)) { tmpExpr = GenConstant(theEnv,theList1->type,theList1->value); tmpExpr->nextArg = theHead; theHead = tmpExpr; } } /*============================================*/ /* Loop through each value in allowed-classes */ /* list of the second constraint record. Add */ /* each value to a list if it satisfies the */ /* restrictions for both constraint records. */ /*============================================*/ for (theList2 = constraint2->classList; theList2 != NULL; theList2 = theList2->nextArg) { if (FindItemInExpression(theList2->type,theList2->value,TRUE,theHead)) { /* The value is already in the list--Do nothing */ } else if (CheckAllowedClassesConstraint(theEnv,theList2->type,theList2->value,constraint1) && CheckAllowedClassesConstraint(theEnv,theList2->type,theList2->value,constraint2)) { tmpExpr = GenConstant(theEnv,theList2->type,theList2->value); tmpExpr->nextArg = theHead; theHead = tmpExpr; } } /*=================================================*/ /* Set the allowed classes list for the constraint */ /* record to the intersected values of the two */ /* other constraint records. */ /*=================================================*/ newConstraint->classList = theHead; } /*********************************************************/ /* IntersectNumericExpressions: Creates the intersection */ /* of two range or two min/max-fields constraints. */ /*********************************************************/ static void IntersectNumericExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint, int range) { struct expr *tmpmin1, *tmpmax1, *tmpmin2, *tmpmax2, *theMin, *theMax; struct expr *theMinList, *theMaxList, *lastMin = NULL, *lastMax = NULL; int cmaxmax, cminmin, cmaxmin, cminmax; /*==========================================*/ /* Initialize the new range/min/max values */ /* for the intersection of the constraints. */ /*==========================================*/ theMinList = NULL; theMaxList = NULL; /*=================================*/ /* Determine the min/max values of */ /* the first constraint record. */ /*=================================*/ if (range) { tmpmin1 = constraint1->minValue; tmpmax1 = constraint1->maxValue; } else { tmpmin1 = constraint1->minFields; tmpmax1 = constraint1->maxFields; } /*===========================================*/ /* Loop through each of range/min/max values */ /* from the first constraint record. */ /*===========================================*/ for (; tmpmin1 != NULL; tmpmin1 = tmpmin1->nextArg, tmpmax1 = tmpmax1->nextArg) { /*============================================*/ /* Get the appropriate values from the second */ /* constraint record for comparison. */ /*============================================*/ if (range) { tmpmin2 = constraint2->minValue; tmpmax2 = constraint2->maxValue; } else { tmpmin2 = constraint2->minFields; tmpmax2 = constraint2->maxFields; } /*================================================*/ /* Loop through each of range/min/max values from */ /* the second constraint record comparing it to */ /* the values from the first constraint record. */ /*================================================*/ for (; tmpmin2 != NULL; tmpmin2 = tmpmin2->nextArg, tmpmax2 = tmpmax2->nextArg) { /*==============================================*/ /* Determine the relationship between the four */ /* combinations of min/max values (>, <, or =). */ /*==============================================*/ cmaxmax = CompareNumbers(theEnv,tmpmax1->type,tmpmax1->value, tmpmax2->type,tmpmax2->value); cminmin = CompareNumbers(theEnv,tmpmin1->type,tmpmin1->value, tmpmin2->type,tmpmin2->value); cmaxmin = CompareNumbers(theEnv,tmpmax1->type,tmpmax1->value, tmpmin2->type,tmpmin2->value); cminmax = CompareNumbers(theEnv,tmpmin1->type,tmpmin1->value, tmpmax2->type,tmpmax2->value); /*============================================*/ /* If the range/min/max values don't overlap, */ /* then proceed to the next pair of numbers */ /* to see if they overlap. */ /*============================================*/ if ((cmaxmin == LESS_THAN) || (cminmax == GREATER_THAN)) { continue; } /*=======================================*/ /* Compute the new minimum value for the */ /* intersected range/min/max values. */ /*=======================================*/ if (cminmin == GREATER_THAN) { theMin = GenConstant(theEnv,tmpmin1->type,tmpmin1->value); } else { theMin = GenConstant(theEnv,tmpmin2->type,tmpmin2->value); } /*=======================================*/ /* Compute the new maximum value for the */ /* intersected range/min/max values. */ /*=======================================*/ if (cmaxmax == LESS_THAN) { theMax = GenConstant(theEnv,tmpmax1->type,tmpmax1->value); } else { theMax = GenConstant(theEnv,tmpmax2->type,tmpmax2->value); } /*==================================*/ /* Add the new range/min/max values */ /* to the intersection list. */ /*==================================*/ if (lastMin == NULL) { theMinList = theMin; theMaxList = theMax; } else { lastMin->nextArg = theMin; lastMax->nextArg = theMax; } lastMin = theMin; lastMax = theMax; } } /*============================================================*/ /* If the intersection produced a pair of valid range/min/max */ /* values, then replace the previous values of the constraint */ /* record to the new intersected values. */ /*============================================================*/ if (theMinList != NULL) { if (range) { ReturnExpression(theEnv,newConstraint->minValue); ReturnExpression(theEnv,newConstraint->maxValue); newConstraint->minValue = theMinList; newConstraint->maxValue = theMaxList; } else { ReturnExpression(theEnv,newConstraint->minFields); ReturnExpression(theEnv,newConstraint->maxFields); newConstraint->minFields = theMinList; newConstraint->maxFields = theMaxList; } } /*===============================================================*/ /* Otherwise, the intersection produced no valid range/min/max */ /* values. For the range attribute, this means that no numbers */ /* can satisfy the constraint. For the min/max fields attribute, */ /* it means that no value can satisfy the constraint. */ /*===============================================================*/ else { if (range) { if (newConstraint->anyAllowed) SetAnyAllowedFlags(newConstraint,FALSE); newConstraint->integersAllowed = FALSE; newConstraint->floatsAllowed = FALSE; } else { SetAnyAllowedFlags(newConstraint,TRUE); newConstraint->singlefieldsAllowed = FALSE; newConstraint->multifieldsAllowed = FALSE; newConstraint->anyAllowed = FALSE; } } } /************************************************************/ /* UpdateRestrictionFlags: Updates the types allowed flags */ /* based on the allowed values in a constraint record. */ /* Intended to be called after the allowed values list */ /* has been changed (for example after intersecting the */ /* allowed-values list there may no be any values of a */ /* particular type left even though the type is allowed). */ /************************************************************/ static void UpdateRestrictionFlags( CONSTRAINT_RECORD *rv) { if ((rv->anyRestriction) && (rv->restrictionList == NULL)) { SetAnyAllowedFlags(rv,TRUE); rv->anyAllowed = FALSE; } if ((rv->symbolRestriction) && (rv->symbolsAllowed)) { rv->symbolsAllowed = FindItemInExpression(SYMBOL,NULL,FALSE,rv->restrictionList); } if ((rv->stringRestriction) && (rv->stringsAllowed)) { rv->stringsAllowed = FindItemInExpression(STRING,NULL,FALSE,rv->restrictionList); } if ((rv->floatRestriction) && (rv->floatsAllowed)) { rv->floatsAllowed = FindItemInExpression(FLOAT,NULL,FALSE,rv->restrictionList); } if ((rv->integerRestriction) && (rv->integersAllowed)) { rv->integersAllowed = FindItemInExpression(INTEGER,NULL,FALSE,rv->restrictionList); } if ((rv->instanceNameRestriction) && (rv->instanceNamesAllowed)) { rv->instanceNamesAllowed = FindItemInExpression(INSTANCE_NAME,NULL,FALSE,rv->restrictionList); } } /*************************************************************/ /* FindItemInExpression: Determines if a particular constant */ /* (such as 27) or a class of constants (such as integers) */ /* can be found in a list of constants. Returns TRUE if */ /* such a constant can be found, otherwise FALSE. */ /*************************************************************/ static int FindItemInExpression( int theType, void *theValue, int useValue, struct expr *theList) { while (theList != NULL) { if (theList->type == theType) { if (! useValue) return(TRUE); else if (theList->value == theValue) return(TRUE); } theList = theList->nextArg; } return(FALSE); } #if (! BLOAD_ONLY) /**************************************************/ /* RestrictionOnType: Determines if a restriction */ /* is present for a specific type. Returns TRUE */ /* if there is, otherwise FALSE. */ /**************************************************/ static int RestrictionOnType( int theType, CONSTRAINT_RECORD *theConstraint) { if (theConstraint == NULL) return(FALSE); if ((theConstraint->anyRestriction) || (theConstraint->symbolRestriction && (theType == SYMBOL)) || (theConstraint->stringRestriction && (theType == STRING)) || (theConstraint->floatRestriction && (theType == FLOAT)) || (theConstraint->integerRestriction && (theType == INTEGER)) || (theConstraint->classRestriction && ((theType == INSTANCE_ADDRESS) || (theType == INSTANCE_NAME))) || (theConstraint->instanceNameRestriction && (theType == INSTANCE_NAME))) { return(TRUE); } return(FALSE); } /**********************************************************/ /* UnionConstraints: Creates a new constraint record that */ /* is the union of two other constraint records. */ /**********************************************************/ globle struct constraintRecord *UnionConstraints( void *theEnv, CONSTRAINT_RECORD *c1, CONSTRAINT_RECORD *c2) { struct constraintRecord *rv; int c1Changed = FALSE, c2Changed = FALSE; /*=================================================*/ /* If both constraint records are NULL,then create */ /* a constraint record that allows any value. */ /*=================================================*/ if ((c1 == NULL) && (c2 == NULL)) return(GetConstraintRecord(theEnv)); /*=====================================================*/ /* If one of the constraint records is NULL, then the */ /* union is the other constraint record. Note that */ /* this is different from the way that intersections */ /* were handled (a NULL constraint record implied that */ /* any value was legal which in turn would imply that */ /* the union would allow any value as well). */ /*=====================================================*/ if (c1 == NULL) return(CopyConstraintRecord(theEnv,c2)); if (c2 == NULL) return(CopyConstraintRecord(theEnv,c1)); /*=================================*/ /* Create a new constraint record. */ /*=================================*/ rv = GetConstraintRecord(theEnv); /*==========================*/ /* Union the allowed types. */ /*==========================*/ if (c1->multifieldsAllowed || c2->multifieldsAllowed) { rv->multifieldsAllowed = TRUE; } if (c1->singlefieldsAllowed || c2->singlefieldsAllowed) { rv->singlefieldsAllowed = TRUE; } if (c1->anyAllowed || c2->anyAllowed) rv->anyAllowed = TRUE; else { rv->anyAllowed = FALSE; rv->symbolsAllowed = (c1->symbolsAllowed || c2->symbolsAllowed); rv->stringsAllowed = (c1->stringsAllowed || c2->stringsAllowed); rv->floatsAllowed = (c1->floatsAllowed || c2->floatsAllowed); rv->integersAllowed = (c1->integersAllowed || c2->integersAllowed); rv->instanceNamesAllowed = (c1->instanceNamesAllowed || c2->instanceNamesAllowed); rv->instanceAddressesAllowed = (c1->instanceAddressesAllowed || c2->instanceAddressesAllowed); rv->externalAddressesAllowed = (c1->externalAddressesAllowed || c2->externalAddressesAllowed); rv->voidAllowed = (c1->voidAllowed || c2->voidAllowed); rv->factAddressesAllowed = (c1->factAddressesAllowed || c2->factAddressesAllowed); } /*=================================*/ /* Union the allowed-values flags. */ /*=================================*/ if (c1->anyRestriction && c2->anyRestriction) rv->anyRestriction = TRUE; else { if (c1->anyRestriction) { c1Changed = TRUE; SetAnyRestrictionFlags(c1,FALSE); } else if (c2->anyRestriction) { c2Changed = TRUE; SetAnyRestrictionFlags(c2,FALSE); } rv->anyRestriction = FALSE; rv->symbolRestriction = (c1->symbolRestriction && c2->symbolRestriction); rv->stringRestriction = (c1->stringRestriction && c2->stringRestriction); rv->floatRestriction = (c1->floatRestriction && c2->floatRestriction); rv->integerRestriction = (c1->integerRestriction && c2->integerRestriction); rv->classRestriction = (c1->classRestriction && c2->classRestriction); rv->instanceNameRestriction = (c1->instanceNameRestriction && c2->instanceNameRestriction); if (c1Changed) SetAnyRestrictionFlags(c1,FALSE); else if (c2Changed) SetAnyRestrictionFlags(c2,FALSE); } /*========================================*/ /* Union the allowed values list, the min */ /* and max values, and the range values. */ /*========================================*/ UnionAllowedValueExpressions(theEnv,c1,c2,rv); UnionAllowedClassExpressions(theEnv,c1,c2,rv); UnionNumericExpressions(theEnv,c1,c2,rv,TRUE); UnionNumericExpressions(theEnv,c1,c2,rv,FALSE); /*========================================*/ /* If multifields are allowed, then union */ /* the constraint record for them. */ /*========================================*/ if (rv->multifieldsAllowed) { rv->multifield = UnionConstraints(theEnv,c1->multifield,c2->multifield); } /*====================*/ /* Return the unioned */ /* constraint record. */ /*====================*/ return(rv); } /**************************************************/ /* UnionNumericExpressions: Creates the union of */ /* two range or two min/max-fields constraints. */ /**************************************************/ static void UnionNumericExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint, int range) { struct expr *tmpmin, *tmpmax; struct expr *theMinList, *theMaxList; /*=========================================*/ /* Initialize the new range/min/max values */ /* for the union of the constraints. */ /*=========================================*/ theMinList = NULL; theMaxList = NULL; /*=================================*/ /* Determine the min/max values of */ /* the first constraint record. */ /*=================================*/ if (range) { tmpmin = constraint1->minValue; tmpmax = constraint1->maxValue; } else { tmpmin = constraint1->minFields; tmpmax = constraint1->maxFields; } /*============================================*/ /* Add each range/min/max pair from the first */ /* constraint record to the union list. */ /*============================================*/ for (; tmpmin != NULL; tmpmin = tmpmin->nextArg,tmpmax = tmpmax->nextArg) { UnionRangeMinMaxValueWithList(theEnv,tmpmin,tmpmax,&theMinList,&theMaxList); } /*=================================*/ /* Determine the min/max values of */ /* the second constraint record. */ /*=================================*/ if (range) { tmpmin = constraint2->minValue; tmpmax = constraint2->maxValue; } else { tmpmin = constraint2->minFields; tmpmax = constraint2->maxFields; } /*=============================================*/ /* Add each range/min/max pair from the second */ /* constraint record to the union list. */ /*=============================================*/ for (; tmpmin != NULL; tmpmin = tmpmin->nextArg,tmpmax = tmpmax->nextArg) { UnionRangeMinMaxValueWithList(theEnv,tmpmin,tmpmax,&theMinList,&theMaxList); } /*=====================================================*/ /* If the union produced a pair of valid range/min/max */ /* values, then replace the previous values of the */ /* constraint record to the new unioned values. */ /*=====================================================*/ if (theMinList != NULL) { if (range) { ReturnExpression(theEnv,newConstraint->minValue); ReturnExpression(theEnv,newConstraint->maxValue); newConstraint->minValue = theMinList; newConstraint->maxValue = theMaxList; } else { ReturnExpression(theEnv,newConstraint->minFields); ReturnExpression(theEnv,newConstraint->maxFields); newConstraint->minFields = theMinList; newConstraint->maxFields = theMaxList; } } /*==============================================================*/ /* Otherwise, the union produced no valid range/min/max values. */ /* For the range attribute, this means that no numbers can */ /* satisfy the constraint. For the min/max fields attribute, it */ /* means that no value can satisfy the constraint. */ /*==============================================================*/ else { if (range) { if (newConstraint->anyAllowed) SetAnyAllowedFlags(newConstraint,FALSE); newConstraint->integersAllowed = FALSE; newConstraint->floatsAllowed = FALSE; } else { SetAnyAllowedFlags(newConstraint,TRUE); newConstraint->anyAllowed = TRUE; } } } /*********************************************************/ /* UnionRangeMinMaxValueWithList: Unions a range/min/max */ /* pair of values with a list of such values. */ /*********************************************************/ static void UnionRangeMinMaxValueWithList( void *theEnv, struct expr *addmin, struct expr *addmax, struct expr **theMinList, struct expr **theMaxList) { struct expr *tmpmin, *tmpmax, *lastmin, *lastmax; struct expr *themin, *themax, *nextmin, *nextmax; int cmaxmin, cmaxmax, cminmin, cminmax; /*=========================================================*/ /* If no values are on the lists, then use the new values. */ /*=========================================================*/ if (*theMinList == NULL) { *theMinList = GenConstant(theEnv,addmin->type,addmin->value); *theMaxList = GenConstant(theEnv,addmax->type,addmax->value); return; } lastmin = NULL; lastmax = NULL; tmpmin = (*theMinList); tmpmax = (*theMaxList); while (tmpmin != NULL) { cmaxmax = CompareNumbers(theEnv,addmax->type,addmax->value, tmpmax->type,tmpmax->value); cminmin = CompareNumbers(theEnv,addmin->type,addmin->value, tmpmin->type,tmpmin->value); cmaxmin = CompareNumbers(theEnv,addmax->type,addmax->value, tmpmin->type,tmpmin->value); cminmax = CompareNumbers(theEnv,addmin->type,addmin->value, tmpmax->type,tmpmax->value); /*=================================*/ /* Check to see if the range is */ /* contained within another range. */ /*=================================*/ if (((cmaxmax == LESS_THAN) || (cmaxmax == EQUAL)) && ((cminmin == GREATER_THAN) || (cminmin == EQUAL))) { return; } /*================================*/ /* Extend the greater than range. */ /*================================*/ if ((cmaxmax == GREATER_THAN) && ((cminmax == LESS_THAN) || (cminmax == EQUAL))) { tmpmax->type = addmax->type; tmpmax->value = addmax->value; } /*=============================*/ /* Extend the less than range. */ /*=============================*/ if ((cminmin == LESS_THAN) && ((cmaxmin == GREATER_THAN) || (cmaxmin == EQUAL))) { tmpmin->type = addmin->type; tmpmin->value = addmin->value; } /*====================*/ /* Handle insertions. */ /*====================*/ if (cmaxmin == LESS_THAN) { if (lastmax == NULL) { themin = GenConstant(theEnv,addmin->type,addmin->value); themax = GenConstant(theEnv,addmax->type,addmax->value); themin->nextArg = *theMinList; themax->nextArg = *theMaxList; *theMinList = themin; *theMaxList = themax; return; } if (CompareNumbers(theEnv,addmin->type,addmin->value, lastmax->type,lastmax->value) == GREATER_THAN) { themin = GenConstant(theEnv,addmin->type,addmin->value); themax = GenConstant(theEnv,addmax->type,addmax->value); themin->nextArg = lastmin->nextArg; themax->nextArg = lastmax->nextArg; lastmin->nextArg = themin; lastmax->nextArg = themax; return; } } /*==========================*/ /* Move on to the next one. */ /*==========================*/ tmpmin = tmpmin->nextArg; tmpmax = tmpmax->nextArg; } /*===========================*/ /* Merge overlapping ranges. */ /*===========================*/ tmpmin = (*theMinList); tmpmax = (*theMaxList); while (tmpmin != NULL) { nextmin = tmpmin->nextArg; nextmax = tmpmax->nextArg; if (nextmin != NULL) { cmaxmin = CompareNumbers(theEnv,tmpmax->type,tmpmax->value, nextmin->type,nextmin->value); if ((cmaxmin == GREATER_THAN) || (cmaxmin == EQUAL)) { tmpmax->type = nextmax->type; tmpmax->value = nextmax->value; tmpmax->nextArg = nextmax->nextArg; tmpmin->nextArg = nextmin->nextArg; rtn_struct(theEnv,expr,nextmin); rtn_struct(theEnv,expr,nextmax); } else { tmpmin = tmpmin->nextArg; tmpmax = tmpmax->nextArg; } } else { tmpmin = nextmin; tmpmax = nextmax; } } } /***************************************************/ /* UnionAllowedClassExpressions: Creates the union */ /* of two sets of allowed-classes expressions. */ /***************************************************/ static void UnionAllowedClassExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint) { struct expr *theHead = NULL; theHead = AddToUnionList(theEnv,constraint1->classList,theHead,newConstraint); theHead = AddToUnionList(theEnv,constraint2->classList,theHead,newConstraint); newConstraint->classList = theHead; } /***************************************************/ /* UnionAllowedValueExpressions: Creates the union */ /* of two sets of allowed value expressions. */ /***************************************************/ static void UnionAllowedValueExpressions( void *theEnv, CONSTRAINT_RECORD *constraint1, CONSTRAINT_RECORD *constraint2, CONSTRAINT_RECORD *newConstraint) { struct expr *theHead = NULL; theHead = AddToUnionList(theEnv,constraint1->restrictionList,theHead,newConstraint); theHead = AddToUnionList(theEnv,constraint2->restrictionList,theHead,newConstraint); newConstraint->restrictionList = theHead; } /************************************************************/ /* AddToUnionList: Adds a list of values to a unioned list */ /* making sure that duplicates are not added and that any */ /* value added satisfies the constraints for the list. */ /************************************************************/ static struct expr *AddToUnionList( void *theEnv, struct expr *theList1, struct expr *theHead, CONSTRAINT_RECORD *theConstraint) { struct expr *theList2; int flag; /*======================================*/ /* Loop through each value in the list */ /* being added to the unioned set. */ /*======================================*/ for (;theList1 != NULL; theList1 = theList1->nextArg) { /*===================================*/ /* Determine if the value is already */ /* in the unioned list. */ /*===================================*/ flag = TRUE; for (theList2 = theHead; theList2 != NULL; theList2 = theList2->nextArg) { if ((theList1->type == theList2->type) && (theList1->value == theList2->value)) { flag = FALSE; break; } } /*=====================================================*/ /* If the value wasn't in the unioned list and doesn't */ /* violate any of the unioned list's constraints, then */ /* add it to the list. */ /*=====================================================*/ if (flag) { if (RestrictionOnType(theList1->type,theConstraint)) { theList2 = GenConstant(theEnv,theList1->type,theList1->value); theList2->nextArg = theHead; theHead = theList2; } } } /*==============================*/ /* Return the new unioned list. */ /*==============================*/ return(theHead); } /****************************************************/ /* RemoveConstantFromConstraint: Removes a constant */ /* value (including any duplicates) from the */ /* restriction list of a constraint record. */ /****************************************************/ globle void RemoveConstantFromConstraint( void *theEnv, int theType, void *theValue, CONSTRAINT_RECORD *theConstraint) { struct expr *theList, *lastOne = NULL, *tmpList; if (theConstraint == NULL) return; theList = theConstraint->restrictionList; theConstraint->restrictionList = NULL; while (theList != NULL) { if ((theList->type != theType) || (theList->value != theValue)) { if (lastOne == NULL) { theConstraint->restrictionList = theList; } else { lastOne->nextArg = theList; } lastOne = theList; theList = theList->nextArg; lastOne->nextArg = NULL; } else { tmpList = theList; theList = theList->nextArg; tmpList->nextArg = NULL; ReturnExpression(theEnv,tmpList); } } UpdateRestrictionFlags(theConstraint); } #endif /* (! BLOAD_ONLY) */ #endif /* (! RUN_TIME) */ clips-6.24/clipssrc/._multifun.c0000400000175000017500000000075410441602253014744 0ustar jfsjfsMac OS X  2 RTEXTR*chaTTF multifun.crol PanelTCmr.txt.docTEXTR*ch p)΀" H Monaco0mc0mc:TTFL,FMPSRMWBBLclips-6.24/clipssrc/factbld.c0000755000175000017500000011423110441071737014303 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* FACT BUILD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Given a new fact pattern, adds the pattern to */ /* the pattern network of the associated deftemplate. Also */ /* contains routines for deleting a pattern from the fact */ /* pattern network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed INCREMENTAL_RESET compilation flag. */ /* */ /*************************************************************/ #define _FACTBLD_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "reteutil.h" #include "router.h" #include "reorder.h" #include "factcmp.h" #include "factmch.h" #include "factgen.h" #include "factmngr.h" #include "factlhs.h" #include "argacces.h" #include "modulutl.h" #include "tmpltdef.h" #include "envrnmnt.h" #include "factbld.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static struct factPatternNode *FindPatternNode(struct factPatternNode *,struct lhsParseNode *, struct factPatternNode **,unsigned); static struct factPatternNode *CreateNewPatternNode(void *,struct lhsParseNode *,struct factPatternNode *, struct factPatternNode *,unsigned); static void ClearPatternMatches(void *,struct factPatternNode *); static void DetachFactPattern(void *,struct patternNodeHeader *); static struct patternNodeHeader *PlaceFactPattern(void *,struct lhsParseNode *); static struct lhsParseNode *RemoveUnneededSlots(void *,struct lhsParseNode *); static void FindAndSetDeftemplatePatternNetwork(void *,struct factPatternNode *,struct factPatternNode *); #endif /*********************************************************/ /* InitializeFactPatterns: Adds fact patterns to the set */ /* of patterns recognized by the rule pattern parsing */ /* and pattern/join network integration routines. */ /*********************************************************/ 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 newPtr->markIRPatternFunction = MarkFactPatternForIncrementalReset; newPtr->incrementalResetFunction = FactsIncrementalReset; #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 } #if (! RUN_TIME) && (! BLOAD_ONLY) /******************************************************************************/ /* PlaceFactPattern: Integrates a fact pattern into the fact pattern network. */ /******************************************************************************/ static struct patternNodeHeader *PlaceFactPattern( void *theEnv, struct lhsParseNode *thePattern) { struct lhsParseNode *tempPattern = NULL; struct factPatternNode *currentLevel, *lastLevel; struct factPatternNode *nodeBeforeMatch, *newNode = NULL; unsigned endSlot; int count; char *deftemplateName; /*======================================================================*/ /* Get the name of the deftemplate associated with the pattern being */ /* added (recall that the first field of any pattern must be a symbol). */ /*======================================================================*/ deftemplateName = ValueToString(thePattern->right->bottom->value); /*=====================================================*/ /* Remove any slot tests that test only for existance. */ /*=====================================================*/ thePattern->right = RemoveUnneededSlots(theEnv,thePattern->right); /*========================================================*/ /* If the constant test for the relation name is the only */ /* pattern network test and there are no other network */ /* tests, then remove the test, but keep the node since */ /* there must be a link from the fact pattern network to */ /* the join network. Otherwise, remove the test for the */ /* relation name since this test has already been done */ /* before entering the pattern network (since each */ /* deftemplate has its own pattern network). */ /*========================================================*/ if (thePattern->right->right == NULL) { ReturnExpression(theEnv,thePattern->right->networkTest); thePattern->right->networkTest = NULL; } else { tempPattern = thePattern->right; thePattern->right = thePattern->right->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); tempPattern = NULL; } /*============================================================*/ /* Get a pointer to the deftemplate data structure associated */ /* with the pattern (use the deftemplate name extracted from */ /* the first field of the pattern). */ /*============================================================*/ FactData(theEnv)->CurrentDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL, deftemplateName,&count, TRUE,NULL); /*================================================*/ /* Initialize some pointers to indicate where the */ /* pattern is being added to the pattern network. */ /*================================================*/ currentLevel = FactData(theEnv)->CurrentDeftemplate->patternNetwork; lastLevel = NULL; thePattern = thePattern->right; /*===========================================*/ /* Loop until all fields in the pattern have */ /* been added to the pattern network. */ /*===========================================*/ while (thePattern != NULL) { /*===========================================================*/ /* If a multifield slot is being processed, then process the */ /* pattern nodes attached to the multifield pattern node. */ /*===========================================================*/ if (thePattern->multifieldSlot) { tempPattern = thePattern; thePattern = thePattern->bottom; } /*============================================*/ /* Determine if the last pattern field within */ /* a multifield slot is being processed. */ /*============================================*/ if ((thePattern->right == NULL) && (tempPattern != NULL)) { endSlot = TRUE; } else { endSlot = FALSE; } /*========================================*/ /* Is there a node in the pattern network */ /* that can be reused (shared)? */ /*========================================*/ newNode = FindPatternNode(currentLevel,thePattern,&nodeBeforeMatch,endSlot); /*================================================*/ /* If the pattern node cannot be shared, then add */ /* a new pattern node to the pattern network. */ /*================================================*/ if (newNode == NULL) { newNode = CreateNewPatternNode(theEnv,thePattern,nodeBeforeMatch,lastLevel,endSlot); } /*===========================================================*/ /* Move on to the next field in the new pattern to be added. */ /*===========================================================*/ if ((thePattern->right == NULL) && (tempPattern != NULL)) { thePattern = tempPattern; tempPattern = NULL; } thePattern = thePattern->right; /*==========================================================*/ /* If there are no more pattern nodes to be added to the */ /* pattern network, then mark the last pattern node added */ /* as a stop node (i.e. if you get to this node and the */ /* network test succeeds, then a pattern has been matched). */ /*==========================================================*/ if (thePattern == NULL) newNode->header.stopNode = TRUE; /*================================================*/ /* Update the pointers which indicate where we're */ /* trying to add the new pattern to the currently */ /* existing pattern network. */ /*================================================*/ lastLevel = newNode; currentLevel = newNode->nextLevel; } /*==================================================*/ /* Return the leaf node of the newly added pattern. */ /*==================================================*/ return((struct patternNodeHeader *) newNode); } /*************************************************************/ /* FindPatternNode: Looks for a pattern node at a specified */ /* level in the pattern network that can be reused (shared) */ /* with a pattern field being added to the pattern network. */ /*************************************************************/ static struct factPatternNode *FindPatternNode( struct factPatternNode *listOfNodes, struct lhsParseNode *thePattern, struct factPatternNode **nodeBeforeMatch, unsigned endSlot) { *nodeBeforeMatch = NULL; /*==========================================================*/ /* Loop through the nodes at the given level in the pattern */ /* network looking for a node that can be reused (shared)? */ /*==========================================================*/ while (listOfNodes != NULL) { /*==========================================================*/ /* If the type of the pattern node and the expression being */ /* tested by the pattern node are the same as the type and */ /* expression for the pattern field being added, then */ /* return the pattern node because it can be shared with */ /* the pattern field being added. */ /*==========================================================*/ if ((thePattern->type == SF_WILDCARD) || (thePattern->type == SF_VARIABLE)) { if ((listOfNodes->header.singlefieldNode) && (listOfNodes->header.endSlot == endSlot) && (listOfNodes->whichField == thePattern->index) && (listOfNodes->whichSlot == (thePattern->slotNumber - 1)) && IdenticalExpression(listOfNodes->networkTest,thePattern->networkTest)) { return(listOfNodes); } } else if ((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE)) { if ((listOfNodes->header.multifieldNode) && (listOfNodes->header.endSlot == endSlot) && (listOfNodes->leaveFields == thePattern->singleFieldsAfter) && (listOfNodes->whichField == thePattern->index) && (listOfNodes->whichSlot == (thePattern->slotNumber - 1)) && IdenticalExpression(listOfNodes->networkTest,thePattern->networkTest)) { return(listOfNodes); } } /*==================================*/ /* Move on to the next node at this */ /* level in the pattern network. */ /*==================================*/ *nodeBeforeMatch = listOfNodes; listOfNodes = listOfNodes->rightNode; } /*==============================================*/ /* A shareable pattern node could not be found. */ /*==============================================*/ return(NULL); } /*************************************************************/ /* RemoveUnneededSlots: Removes fact pattern nodes that have */ /* no effect on pattern matching. For example, given the */ /* following deftemplate and a pattern using it, */ /* */ /* (deftemplate foo (slot x) (slot y)) */ /* */ /* (foo (x ?x) (y ?y)) */ /* */ /* The x and y slot pattern nodes can be discarded since */ /* all foo facts will have these two slots in the fact */ /* data structure used to store them. */ /*************************************************************/ static struct lhsParseNode *RemoveUnneededSlots( void *theEnv, struct lhsParseNode *thePattern) { struct lhsParseNode *tempPattern = thePattern; struct lhsParseNode *lastPattern = NULL, *head = thePattern; struct expr *theTest; while (tempPattern != NULL) { /*=============================================================*/ /* A single field slot that has no pattern network expression */ /* associated with it can be removed (i.e. any value contained */ /* in this slot will satisfy the pattern being matched). */ /*=============================================================*/ if (((tempPattern->type == SF_WILDCARD) || (tempPattern->type == SF_VARIABLE)) && (tempPattern->networkTest == NULL)) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } /*=======================================================*/ /* A multifield variable or wildcard within a multifield */ /* slot can be removed if there are no other multifield */ /* variables or wildcards contained in the same slot */ /* (and the multifield has no expressions which must be */ /* evaluated in the fact pattern network). */ /*=======================================================*/ else if (((tempPattern->type == MF_WILDCARD) || (tempPattern->type == MF_VARIABLE)) && (tempPattern->multifieldSlot == FALSE) && (tempPattern->networkTest == NULL) && (tempPattern->multiFieldsBefore == 0) && (tempPattern->multiFieldsAfter == 0)) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } /*==================================================================*/ /* A multifield wildcard or variable contained in a multifield slot */ /* that contains no other multifield wildcards or variables, but */ /* does have an expression that must be evaluated, can be changed */ /* to a single field pattern node with the same expression. */ /*==================================================================*/ else if (((tempPattern->type == MF_WILDCARD) || (tempPattern->type == MF_VARIABLE)) && (tempPattern->multifieldSlot == FALSE) && (tempPattern->networkTest != NULL) && (tempPattern->multiFieldsBefore == 0) && (tempPattern->multiFieldsAfter == 0)) { tempPattern->type = SF_WILDCARD; lastPattern = tempPattern; tempPattern = tempPattern->right; } /*=========================================================*/ /* If we're dealing with a multifield slot with no slot */ /* restrictions, then treat the multfield slot as a single */ /* field slot, but attach a test which verifies that the */ /* slot contains a zero length multifield value. */ /*=========================================================*/ else if ((tempPattern->type == MF_WILDCARD) && (tempPattern->multifieldSlot == TRUE) && (tempPattern->bottom == NULL)) { tempPattern->type = SF_WILDCARD; tempPattern->networkTest = FactGenCheckZeroLength(theEnv,tempPattern->slotNumber); tempPattern->multifieldSlot = FALSE; lastPattern = tempPattern; tempPattern = tempPattern->right; } /*===================================================*/ /* Recursively call RemoveUnneededSlots for the slot */ /* restrictions contained within a multifield slot. */ /*===================================================*/ else if ((tempPattern->type == MF_WILDCARD) && (tempPattern->multifieldSlot == TRUE)) { /*=======================================================*/ /* Add an expression to the first pattern restriction in */ /* the multifield slot that determines whether or not */ /* the fact's slot value contains the minimum number of */ /* required fields to satisfy the pattern restrictions */ /* for this slot. The length check is place before any */ /* other tests, so that preceeding checks do not have to */ /* determine if there are enough fields in the slot to */ /* safely retrieve a value. */ /*=======================================================*/ theTest = FactGenCheckLength(theEnv,tempPattern->bottom); theTest = CombineExpressions(theEnv,theTest,tempPattern->bottom->networkTest); tempPattern->bottom->networkTest = theTest; /*=========================================================*/ /* Remove any unneeded pattern restrictions from the slot. */ /*=========================================================*/ tempPattern->bottom = RemoveUnneededSlots(theEnv,tempPattern->bottom); /*===========================================================*/ /* If the slot no longer contains any restrictions, then the */ /* multifield slot can be completely removed. In any case, */ /* move on to the next slot to be examined for removal. */ /*===========================================================*/ if (tempPattern->bottom == NULL) { if (lastPattern != NULL) lastPattern->right = tempPattern->right; else head = tempPattern->right; tempPattern->right = NULL; ReturnLHSParseNodes(theEnv,tempPattern); if (lastPattern != NULL) tempPattern = lastPattern->right; else tempPattern = head; } else { lastPattern = tempPattern; tempPattern = tempPattern->right; } } /*=======================================================*/ /* If none of the other tests for removing slots or slot */ /* restrictions apply, then move on to the next slot or */ /* slot restriction to be tested. */ /*=======================================================*/ else { lastPattern = tempPattern; tempPattern = tempPattern->right; } } /*======================================*/ /* Return the pattern with unused slots */ /* and slot restrictions removed. */ /*======================================*/ return(head); } /****************************************************/ /* CreateNewPatternNode: Creates a new pattern node */ /* and initializes all of its values. */ /****************************************************/ 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); } /*************************************************************/ /* DetachFactPattern: Removes a pattern node and all of its */ /* parent nodes from the pattern network. Nodes are only */ /* removed if they are no longer shared (i.e. a pattern */ /* node that has more than one child node is shared). A */ /* pattern from a rule is typically removed by removing */ /* the bottom most pattern node used by the pattern and */ /* then removing any parent nodes which are not shared by */ /* other patterns. */ /* */ /* Example: */ /* Patterns (a b c d) and (a b e f) would be represented */ /* by the pattern net shown on the left. If (a b c d) */ /* was detached, the resultant pattern net would be the */ /* one shown on the right. */ /* */ /* a a */ /* | | */ /* b b */ /* | | */ /* c--e e */ /* | | | */ /* d f f */ /* */ /*************************************************************/ static void DetachFactPattern( void *theEnv, struct patternNodeHeader *thePattern) { struct factPatternNode *patternPtr; struct factPatternNode *upperLevel; /*=====================================================*/ /* Get rid of any matches stored in the alpha memory. */ /*=====================================================*/ patternPtr = (struct factPatternNode *) thePattern; ClearPatternMatches(theEnv,patternPtr); /*=====================================================*/ /* If there are no joins entered from this pattern, then */ /* the pattern node is no longer a stop node. Also if */ /* the pattern has a next level pointer, then it can */ /* not be removed since other patterns make use of it. */ /*=====================================================*/ if (patternPtr->header.entryJoin == NULL) patternPtr->header.stopNode = FALSE; if (patternPtr->nextLevel != NULL) return; /*==============================================================*/ /* Loop until all appropriate pattern nodes have been detached. */ /*==============================================================*/ upperLevel = patternPtr; while (upperLevel != NULL) { if ((upperLevel->leftNode == NULL) && (upperLevel->rightNode == NULL)) { /*===============================================*/ /* Pattern node is the only node on this level. */ /* Remove it and continue detaching other nodes */ /* above this one, because no other patterns are */ /* dependent upon this node. */ /*===============================================*/ patternPtr = upperLevel; upperLevel = patternPtr->lastLevel; if (upperLevel == NULL) { FindAndSetDeftemplatePatternNetwork(theEnv,patternPtr,NULL); } else { upperLevel->nextLevel = NULL; if (upperLevel->header.stopNode) upperLevel = NULL; } RemoveHashedExpression(theEnv,patternPtr->networkTest); rtn_struct(theEnv,factPatternNode,patternPtr); } else if (upperLevel->leftNode != NULL) { /*====================================================*/ /* Pattern node has another pattern node which must */ /* be checked preceding it. Remove the pattern node, */ /* but do not detach any nodes above this one. */ /*====================================================*/ patternPtr = upperLevel; upperLevel->leftNode->rightNode = upperLevel->rightNode; if (upperLevel->rightNode != NULL) { upperLevel->rightNode->leftNode = upperLevel->leftNode; } RemoveHashedExpression(theEnv,patternPtr->networkTest); rtn_struct(theEnv,factPatternNode,patternPtr); upperLevel = NULL; } else { /*====================================================*/ /* Pattern node has no pattern node preceding it, but */ /* does have one succeeding it. Remove the pattern */ /* node, but do not detach any nodes above this one. */ /*====================================================*/ patternPtr = upperLevel; upperLevel = upperLevel->lastLevel; if (upperLevel == NULL) { FindAndSetDeftemplatePatternNetwork(theEnv,patternPtr,patternPtr->rightNode); } else { upperLevel->nextLevel = patternPtr->rightNode; } patternPtr->rightNode->leftNode = NULL; RemoveHashedExpression(theEnv,patternPtr->networkTest); rtn_struct(theEnv,factPatternNode,patternPtr); upperLevel = NULL; } } } #endif /**************************************************************/ /* DestroyFactPatternNetwork: Deallocates the data structures */ /* associated with a fact pattern network. */ /**************************************************************/ globle void DestroyFactPatternNetwork( void *theEnv, struct factPatternNode *thePattern) { struct factPatternNode *patternPtr; if (thePattern == NULL) return; while (thePattern != NULL) { patternPtr = thePattern->rightNode; DestroyFactPatternNetwork(theEnv,thePattern->nextLevel); DestroyAlphaBetaMemory(theEnv,thePattern->header.alphaMemory); #if (! BLOAD_ONLY) && (! RUN_TIME) rtn_struct(theEnv,factPatternNode,thePattern); #endif thePattern = patternPtr; } } #if (! RUN_TIME) && (! BLOAD_ONLY) /***********************************************************/ /* FindAndSetDeftemplatePatternNetwork: When a deftemplate */ /* pattern is detached from the fact pattern network, it */ /* is not possible to directly detach the link from the */ /* deftemplate to the pattern network (it is a one way */ /* link). Therefore if the top most pointer to a */ /* deftemplates pattern network must be changed, it is */ /* necessary to search the list of deftemplates to find */ /* the appropriate one to modify. */ /***********************************************************/ static void FindAndSetDeftemplatePatternNetwork( void *theEnv, struct factPatternNode *rootNode, struct factPatternNode *newRootNode) { struct deftemplate *theDeftemplate; struct defmodule *theModule; /*=======================================================*/ /* Save the current module since we will be changing it. */ /*=======================================================*/ SaveCurrentModule(theEnv); /*=======================================================*/ /* Loop through every module looking for the deftemplate */ /* associated with the specified root node. */ /*=======================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*======================================================*/ /* Set the current module to the module being examined. */ /*======================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*======================================================*/ /* Loop through every deftemplate in the current module */ /* searching for the deftemplate associated with the */ /* specified root node. */ /*======================================================*/ for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { /*===========================================================*/ /* When the associated deftemplate is found, change its root */ /* node from the current value to the new value. Restore the */ /* current module before leaving this routine. */ /*===========================================================*/ if (theDeftemplate->patternNetwork == rootNode) { RestoreCurrentModule(theEnv); theDeftemplate->patternNetwork = newRootNode; return; } } } /*========================================================*/ /* If the deftemplate wasn't found, then we're presumably */ /* we're in the the middle of a clear and the deftemplate */ /* has already been deleted so there's no need to update */ /* the links to the fact pattern network. */ /*========================================================*/ RestoreCurrentModule(theEnv); } /***************************************************************/ /* ClearPatternMatches: Clears the fact list of all pointers */ /* which point to a specific pattern. The pointers are used */ /* to remember which patterns were matched by a fact to */ /* make retraction easier. When a rule is excised, the */ /* pointers need to be removed. */ /***************************************************************/ static void ClearPatternMatches( void *theEnv, struct factPatternNode *patternPtr) { struct fact *theFact; struct patternMatch *lastMatch, *theMatch; /*===========================================*/ /* Loop through every fact in the fact list. */ /*===========================================*/ for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL); theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact)) { /*========================================*/ /* Loop through every match for the fact. */ /*========================================*/ lastMatch = NULL; theMatch = (struct patternMatch *) theFact->list; while (theMatch != NULL) { /*================================================*/ /* If the match is for the pattern being deleted, */ /* then remove the match. */ /*================================================*/ if (theMatch->matchingPattern == (struct patternNodeHeader *) patternPtr) { if (lastMatch == NULL) { /*=====================================*/ /* Remove the first match of the fact. */ /*=====================================*/ theFact->list = (void *) theMatch->next; rtn_struct(theEnv,patternMatch,theMatch); theMatch = (struct patternMatch *) theFact->list; } else { /*===================================*/ /* Remove a match for the fact which */ /* follows the first match. */ /*===================================*/ lastMatch->next = theMatch->next; rtn_struct(theEnv,patternMatch,theMatch); theMatch = lastMatch->next; } } /*====================================================*/ /* If the match is not for the pattern being deleted, */ /* then move on to the next match for the fact. */ /*====================================================*/ else { lastMatch = theMatch; theMatch = theMatch->next; } } } } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/factprt.h0000755000175000017500000000437507422634576014376 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT RETE PRINT FUNCTIONS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factprt #define _H_factprt #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTPRT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void PrintFactJNCompVars1(void *,char *,void *); LOCALE void PrintFactJNCompVars2(void *,char *,void *); LOCALE void PrintFactPNCompVars1(void *,char *,void *); LOCALE void PrintFactJNGetVar1(void *,char *,void *); LOCALE void PrintFactJNGetVar2(void *,char *,void *); LOCALE void PrintFactJNGetVar3(void *,char *,void *); LOCALE void PrintFactPNGetVar1(void *,char *,void *); LOCALE void PrintFactPNGetVar2(void *,char *,void *); LOCALE void PrintFactPNGetVar3(void *,char *,void *); LOCALE void PrintFactSlotLength(void *,char *,void *); LOCALE void PrintFactPNConstant1(void *,char *,void *); LOCALE void PrintFactPNConstant2(void *,char *,void *); #endif clips-6.24/clipssrc/clsltpsr.h0000755000175000017500000000343107422634764014570 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_clsltpsr #define _H_clsltpsr #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #define MATCH_RLN "pattern-match" #define REACTIVE_RLN "reactive" #define NONREACTIVE_RLN "non-reactive" #ifndef _H_object #include "object.h" #endif typedef struct tempSlotLink { SLOT_DESC *desc; struct tempSlotLink *nxt; } TEMP_SLOT_LINK; #ifdef LOCALE #undef LOCALE #endif #ifdef _CLSLTPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE TEMP_SLOT_LINK *ParseSlot(void *,char *,TEMP_SLOT_LINK *,PACKED_CLASS_LINKS *,int,int); LOCALE void DeleteSlots(void *,TEMP_SLOT_LINK *); #ifndef _CLSLTPSR_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/._classexm.h0000400000175000017500000000075410441130063014720 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco00cTTFSFMWBBMPSRclips-6.24/clipssrc/._globlbin.h0000400000175000017500000000012207422634736014703 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/._filertr.h0000400000175000017500000000075407422634710014565 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0y0yps|TTFD FMWBBMPSRclips-6.24/clipssrc/._prccode.c0000400000175000017500000000452210441602270014514 0ustar jfsjfsMac OS X  2 R TEXTR*ch`n prccode.coutl PanelTCmr.txt.docTEXTR*ch p) " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monacon}n};zKK1nL-nGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/._rulebin.c0000400000175000017500000000075410441073041014536 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zTTFSFMPSRMWBBLclips-6.24/clipssrc/._modulbin.c0000400000175000017500000000075407673515424014732 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zDTTFDDJFMWBBMPSRclips-6.24/clipssrc/argacces.h0000755000175000017500000001107610441602042014451 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* ARGUMENT ACCESS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides access routines for accessing arguments */ /* passed to user or system functions defined using the */ /* DefineFunction protocol. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added IllegalLogicalNameMessage function. */ /* */ /*************************************************************/ #ifndef _H_argacces #define _H_argacces #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _ARGACCES_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define RtnArgCount(theEnv) EnvRtnArgCount(theEnv) #define ArgCountCheck(theEnv,a,b,c) EnvArgCountCheck(theEnv,a,b,c) #define ArgRangeCheck(theEnv,a,b,c) EnvArgRangeCheck(theEnv,a,b,c) #define RtnLexeme(theEnv,a) EnvRtnLexeme(theEnv,a) #define RtnDouble(theEnv,a) EnvRtnDouble(theEnv,a) #define RtnLong(theEnv,a) EnvRtnLong(theEnv,a) #define RtnUnknown(theEnv,a,b) EnvRtnUnknown(theEnv,a,b) #define ArgTypeCheck(theEnv,a,b,c,d) EnvArgTypeCheck(theEnv,a,b,c,d) #else #define RtnArgCount() EnvRtnArgCount(GetCurrentEnvironment()) #define ArgCountCheck(a,b,c) EnvArgCountCheck(GetCurrentEnvironment(),a,b,c) #define ArgRangeCheck(a,b,c) EnvArgRangeCheck(GetCurrentEnvironment(),a,b,c) #define RtnLexeme(a) EnvRtnLexeme(GetCurrentEnvironment(),a) #define RtnDouble(a) EnvRtnDouble(GetCurrentEnvironment(),a) #define RtnLong(a) EnvRtnLong(GetCurrentEnvironment(),a) #define RtnUnknown(a,b) EnvRtnUnknown(GetCurrentEnvironment(),a,b) #define ArgTypeCheck(a,b,c,d) EnvArgTypeCheck(GetCurrentEnvironment(),a,b,c,d) #endif LOCALE int EnvRtnArgCount(void *); LOCALE int EnvArgCountCheck(void *,char *,int,int); LOCALE int EnvArgRangeCheck(void *,char *,int,int); LOCALE char *EnvRtnLexeme(void *,int); LOCALE double EnvRtnDouble(void *,int); LOCALE long EnvRtnLong(void *,int); LOCALE struct dataObject *EnvRtnUnknown(void *,int,struct dataObject *); LOCALE int EnvArgTypeCheck(void *,char *,int,int,struct dataObject *); LOCALE intBool GetNumericArgument(void *,struct expr *,char *,struct dataObject *,int,int); LOCALE char *GetLogicalName(void *,int,char *); LOCALE char *GetFileName(void *,char *,int); LOCALE char *GetConstructName(void *,char *,char *); LOCALE void ExpectedCountError(void *,char *,int,int); LOCALE void OpenErrorMessage(void *,char *,char *); LOCALE intBool CheckFunctionArgCount(void *,char *,char *,int); LOCALE void ExpectedReturnTypeError(char *,char *); LOCALE void ExpectedTypeError1(void *,char *,int,char *); LOCALE void ExpectedTypeError2(void *,char *,int); LOCALE struct defmodule *GetModuleName(void *,char *,int,int *); LOCALE void *GetFactOrInstanceArgument(void *,int,DATA_OBJECT *,char *); LOCALE void IllegalLogicalNameMessage(void *,char *); #endif clips-6.24/clipssrc/prntutil.c0000755000175000017500000004620110441602272014560 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* PRINT UTILITY MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Utility routines for printing various items */ /* and messages. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Link error occurs for the SlotExistError */ /* function when OBJECT_SYSTEM is set to 0 in */ /* setup.h. DR0865 */ /* */ /* Added DataObjectToString function. */ /* */ /* Added SlotExistError function. */ /* */ /*************************************************************/ #define _PRNTUTIL_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "constant.h" #include "envrnmnt.h" #include "symbol.h" #include "utility.h" #include "evaluatn.h" #include "argacces.h" #include "router.h" #include "multifun.h" #include "factmngr.h" #include "inscom.h" #include "insmngr.h" #include "memalloc.h" #include "prntutil.h" /*****************************************************/ /* InitializePrintUtilityData: Allocates environment */ /* data for print utility routines. */ /*****************************************************/ globle void InitializePrintUtilityData( void *theEnv) { AllocateEnvironmentData(theEnv,PRINT_UTILITY_DATA,sizeof(struct printUtilityData),NULL); } /***********************************************************/ /* PrintInChunks: Prints a string in chunks to accomodate */ /* systems which have a limit on the maximum size of a */ /* string which can be printed. */ /***********************************************************/ globle void PrintInChunks( void *theEnv, char *logicalName, char *bigString) { char tc, *subString; subString = bigString; if (subString == NULL) return; while (((int) strlen(subString)) > 500) { if (EvaluationData(theEnv)->HaltExecution) return; tc = subString[500]; subString[500] = EOS; EnvPrintRouter(theEnv,logicalName,subString); subString[500] = tc; subString += 500; } EnvPrintRouter(theEnv,logicalName,subString); } /************************************************************/ /* PrintFloat: Controls printout of floating point numbers. */ /************************************************************/ globle void PrintFloat( void *theEnv, char *fileid, double number) { char *theString; theString = FloatToString(theEnv,number); EnvPrintRouter(theEnv,fileid,theString); } /****************************************************/ /* PrintLongInteger: Controls printout of integers. */ /****************************************************/ globle void PrintLongInteger( void *theEnv, char *logicalName, long int number) { char printBuffer[32]; sprintf(printBuffer,"%ld",number); EnvPrintRouter(theEnv,logicalName,printBuffer); } /**************************************/ /* PrintAtom: Prints an atomic value. */ /**************************************/ globle void PrintAtom( void *theEnv, char *logicalName, int type, void *value) { char buffer[20]; switch (type) { case FLOAT: PrintFloat(theEnv,logicalName,ValueToDouble(value)); break; case INTEGER: PrintLongInteger(theEnv,logicalName,ValueToLong(value)); break; case SYMBOL: EnvPrintRouter(theEnv,logicalName,ValueToString(value)); break; case STRING: if (PrintUtilityData(theEnv)->PreserveEscapedCharacters) { EnvPrintRouter(theEnv,logicalName,StringPrintForm(theEnv,ValueToString(value))); } else { EnvPrintRouter(theEnv,logicalName,"\""); EnvPrintRouter(theEnv,logicalName,ValueToString(value)); EnvPrintRouter(theEnv,logicalName,"\""); } break; case EXTERNAL_ADDRESS: if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); EnvPrintRouter(theEnv,logicalName,""); if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); break; #if OBJECT_SYSTEM case INSTANCE_NAME: EnvPrintRouter(theEnv,logicalName,"["); EnvPrintRouter(theEnv,logicalName,ValueToString(value)); EnvPrintRouter(theEnv,logicalName,"]"); break; #endif case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction == NULL) { EnvPrintRouter(theEnv,logicalName,""); break; } (*EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction)(theEnv,logicalName,value); break; } } /**********************************************************/ /* PrintTally: Prints a tally count indicating the number */ /* of items that have been displayed. Used by functions */ /* such as list-defrules. */ /**********************************************************/ globle void PrintTally( void *theEnv, char *logicalName, long count, char *singular, char *plural) { if (count == 0) return; EnvPrintRouter(theEnv,logicalName,"For a total of "); PrintLongInteger(theEnv,logicalName,count); EnvPrintRouter(theEnv,logicalName," "); if (count == 1) EnvPrintRouter(theEnv,logicalName,singular); else EnvPrintRouter(theEnv,logicalName,plural); EnvPrintRouter(theEnv,logicalName,".\n"); } /********************************************/ /* PrintErrorID: Prints the module name and */ /* error ID for an error message. */ /********************************************/ globle void PrintErrorID( void *theEnv, char *module, int errorID, int printCR) { if (printCR) EnvPrintRouter(theEnv,WERROR,"\n"); EnvPrintRouter(theEnv,WERROR,"["); EnvPrintRouter(theEnv,WERROR,module); PrintLongInteger(theEnv,WERROR,(long int) errorID); EnvPrintRouter(theEnv,WERROR,"] "); } /**********************************************/ /* PrintWarningID: Prints the module name and */ /* warning ID for a warning message. */ /**********************************************/ globle void PrintWarningID( void *theEnv, char *module, int warningID, int printCR) { if (printCR) EnvPrintRouter(theEnv,WWARNING,"\n"); EnvPrintRouter(theEnv,WWARNING,"["); EnvPrintRouter(theEnv,WWARNING,module); PrintLongInteger(theEnv,WWARNING,(long int) warningID); EnvPrintRouter(theEnv,WWARNING,"] WARNING: "); } /***************************************************/ /* CantFindItemErrorMessage: Generic error message */ /* when an "item" can not be found. */ /***************************************************/ globle void CantFindItemErrorMessage( void *theEnv, char *itemType, char *itemName) { PrintErrorID(theEnv,"PRNTUTIL",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find "); EnvPrintRouter(theEnv,WERROR,itemType); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR,".\n"); } /*****************************************************/ /* CantFindItemInFunctionErrorMessage: Generic error */ /* message when an "item" can not be found. */ /*****************************************************/ globle void CantFindItemInFunctionErrorMessage( void *theEnv, char *itemType, char *itemName, char *func) { PrintErrorID(theEnv,"PRNTUTIL",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find "); EnvPrintRouter(theEnv,WERROR,itemType); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); } /*****************************************************/ /* CantDeleteItemErrorMessage: Generic error message */ /* when an "item" can not be deleted. */ /*****************************************************/ globle void CantDeleteItemErrorMessage( void *theEnv, char *itemType, char *itemName) { PrintErrorID(theEnv,"PRNTUTIL",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to delete "); EnvPrintRouter(theEnv,WERROR,itemType); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR,".\n"); } /****************************************************/ /* AlreadyParsedErrorMessage: Generic error message */ /* when an "item" has already been parsed. */ /****************************************************/ globle void AlreadyParsedErrorMessage( void *theEnv, char *itemType, char *itemName) { PrintErrorID(theEnv,"PRNTUTIL",5,TRUE); EnvPrintRouter(theEnv,WERROR,"The "); if (itemType != NULL) EnvPrintRouter(theEnv,WERROR,itemType); if (itemName != NULL) EnvPrintRouter(theEnv,WERROR,itemName); EnvPrintRouter(theEnv,WERROR," has already been parsed.\n"); } /*********************************************************/ /* SyntaxErrorMessage: Generalized syntax error message. */ /*********************************************************/ globle void SyntaxErrorMessage( void *theEnv, char *location) { PrintErrorID(theEnv,"PRNTUTIL",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Syntax Error"); if (location != NULL) { EnvPrintRouter(theEnv,WERROR,": Check appropriate syntax for "); EnvPrintRouter(theEnv,WERROR,location); } EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } /****************************************************/ /* LocalVariableErrorMessage: Generic error message */ /* when a local variable is accessed by an "item" */ /* which can not access local variables. */ /****************************************************/ globle void LocalVariableErrorMessage( void *theEnv, char *byWhat) { PrintErrorID(theEnv,"PRNTUTIL",6,TRUE); EnvPrintRouter(theEnv,WERROR,"Local variables can not be accessed by "); EnvPrintRouter(theEnv,WERROR,byWhat); EnvPrintRouter(theEnv,WERROR,".\n"); } /******************************************/ /* SystemError: Generalized error message */ /* for major internal errors. */ /******************************************/ globle void SystemError( void *theEnv, char *module, int errorID) { PrintErrorID(theEnv,"PRNTUTIL",3,TRUE); EnvPrintRouter(theEnv,WERROR,"\n*** "); EnvPrintRouter(theEnv,WERROR,APPLICATION_NAME); EnvPrintRouter(theEnv,WERROR," SYSTEM ERROR ***\n"); EnvPrintRouter(theEnv,WERROR,"ID = "); EnvPrintRouter(theEnv,WERROR,module); PrintLongInteger(theEnv,WERROR,(long int) errorID); EnvPrintRouter(theEnv,WERROR,"\n"); EnvPrintRouter(theEnv,WERROR,APPLICATION_NAME); EnvPrintRouter(theEnv,WERROR," data structures are in an inconsistent or corrupted state.\n"); EnvPrintRouter(theEnv,WERROR,"This error may have occurred from errors in user defined code.\n"); EnvPrintRouter(theEnv,WERROR,"**************************\n"); } /*******************************************************/ /* DivideByZeroErrorMessage: Generalized error message */ /* for when a function attempts to divide by zero. */ /*******************************************************/ globle void DivideByZeroErrorMessage( void *theEnv, char *functionName) { PrintErrorID(theEnv,"PRNTUTIL",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Attempt to divide by zero in "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); } /*******************************************************/ /* FloatToString: Converts number to KB string format. */ /*******************************************************/ globle char *FloatToString( void *theEnv, double number) { char floatString[40]; int i; char x; void *thePtr; sprintf(floatString,"%.15g",number); for (i = 0; (x = floatString[i]) != '\0'; i++) { if ((x == '.') || (x == 'e')) { thePtr = EnvAddSymbol(theEnv,floatString); return(ValueToString(thePtr)); } } strcat(floatString,".0"); thePtr = EnvAddSymbol(theEnv,floatString); return(ValueToString(thePtr)); } /*******************************************************************/ /* LongIntegerToString: Converts long integer to KB string format. */ /*******************************************************************/ globle char *LongIntegerToString( void *theEnv, long number) { char buffer[30]; void *thePtr; sprintf(buffer,"%ld",number); thePtr = EnvAddSymbol(theEnv,buffer); return(ValueToString(thePtr)); } /*******************************************************************/ /* DataObjectToString: Converts a DATA_OBJECT to KB string format. */ /*******************************************************************/ globle char *DataObjectToString( void *theEnv, DATA_OBJECT *theDO) { void *thePtr; char *theString, *newString; char *prefix, *postfix; unsigned int length; char buffer[30]; switch (GetpType(theDO)) { case MULTIFIELD: prefix = "("; theString = ValueToString(ImplodeMultifield(theEnv,theDO)); postfix = ")"; break; case STRING: prefix = "\""; theString = DOPToString(theDO); postfix = "\""; break; case INSTANCE_NAME: prefix = "["; theString = DOPToString(theDO); postfix = "]"; break; case SYMBOL: return(DOPToString(theDO)); case FLOAT: return(FloatToString(theEnv,DOPToDouble(theDO))); case INTEGER: return(LongIntegerToString(theEnv,DOPToLong(theDO))); case RVOID: return(""); #if OBJECT_SYSTEM case INSTANCE_ADDRESS: thePtr = DOPToPointer(theDO); if (thePtr == (void *) &InstanceData(theEnv)->DummyInstance) { return(""); } if (((struct instance *) thePtr)->garbage) { prefix = "name); postfix = ">"; } else { prefix = "",DOPToPointer(theDO)); thePtr = EnvAddSymbol(theEnv,buffer); return(ValueToString(thePtr)); #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS: if (DOPToPointer(theDO) == (void *) &FactData(theEnv)->DummyFact) { return(""); } thePtr = DOPToPointer(theDO); sprintf(buffer,"",((struct fact *) thePtr)->factIndex); thePtr = EnvAddSymbol(theEnv,buffer); return(ValueToString(thePtr)); #endif default: return("TBD"); } length = strlen(prefix) + strlen(theString) + strlen(postfix) + 1; newString = (char *) genalloc(theEnv,length); newString[0] = '\0'; strcat(newString,prefix); strcat(newString,theString); strcat(newString,postfix); thePtr = EnvAddSymbol(theEnv,newString); genfree(theEnv,newString,length); return(ValueToString(thePtr)); } /************************************************************/ /* SalienceInformationError: Error message for errors which */ /* occur during the evaluation of a salience value. */ /************************************************************/ globle void SalienceInformationError( void *theEnv, char *constructType, char *constructName) { PrintErrorID(theEnv,"PRNTUTIL",8,TRUE); EnvPrintRouter(theEnv,WERROR,"This error occurred while evaluating the salience"); if (constructName != NULL) { EnvPrintRouter(theEnv,WERROR," for "); EnvPrintRouter(theEnv,WERROR,constructType); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,constructName); } EnvPrintRouter(theEnv,WERROR,".\n"); } /**********************************************************/ /* SalienceRangeError: Error message that is printed when */ /* a salience value does not fall between the minimum */ /* and maximum salience values. */ /**********************************************************/ globle void SalienceRangeError( void *theEnv, int min, int max) { PrintErrorID(theEnv,"PRNTUTIL",9,TRUE); EnvPrintRouter(theEnv,WERROR,"Salience value out of range "); PrintLongInteger(theEnv,WERROR,(long int) min); EnvPrintRouter(theEnv,WERROR," to "); PrintLongInteger(theEnv,WERROR,(long int) max); EnvPrintRouter(theEnv,WERROR,".\n"); } /***************************************************************/ /* SalienceNonIntegerError: Error message that is printed when */ /* a rule's salience does not evaluate to an integer. */ /***************************************************************/ globle void SalienceNonIntegerError( void *theEnv) { PrintErrorID(theEnv,"PRNTUTIL",10,TRUE); EnvPrintRouter(theEnv,WERROR,"Salience value must be an integer value.\n"); } /***************************************************/ /* SlotExistError: Prints out an appropriate error */ /* message when a slot cannot be found for a */ /* function. Input to the function is the slot */ /* name and the function name. */ /***************************************************/ globle void SlotExistError( void *theEnv, char *sname, char *func) { PrintErrorID(theEnv,"INSFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"No such slot "); EnvPrintRouter(theEnv,WERROR,sname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); } clips-6.24/clipssrc/._prcdrpsr.h0000400000175000017500000000075410441150556014751 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0z;TTFS hFMWBBMPSRclips-6.24/clipssrc/miscfun.c0000755000175000017500000012473610441147776014372 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* MISCELLANEOUS FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* Changed name of variable exp to theExp */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES, */ /* DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* LOGICAL_DEPENDENCIES, IMPERATIVE_METHODS */ /* INSTANCE_PATTERN_MATCHING, */ /* IMPERATIVE_MESSAGE_HANDLERS, and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _MISCFUN_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #include "argacces.h" #include "envrnmnt.h" #include "exprnpsr.h" #include "memalloc.h" #include "multifld.h" #include "router.h" #include "sysdep.h" #include "utility.h" #if DEFFUNCTION_CONSTRUCT #include "dffnxfun.h" #endif #include "miscfun.h" #define MISCFUN_DATA 9 struct miscFunctionData { long int GensymNumber; }; #define MiscFunctionData(theEnv) ((struct miscFunctionData *) GetEnvironmentData(theEnv,MISCFUN_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void ExpandFuncMultifield(void *,DATA_OBJECT *,EXPRESSION *, EXPRESSION **,void *); /*****************************************************************/ /* MiscFunctionDefinitions: Initializes miscellaneous functions. */ /*****************************************************************/ globle void MiscFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,MISCFUN_DATA,sizeof(struct miscFunctionData),NULL); MiscFunctionData(theEnv)->GensymNumber = 1; #if ! RUN_TIME EnvDefineFunction2(theEnv,"gensym", 'w', PTIEF GensymFunction, "GensymFunction", "00"); EnvDefineFunction2(theEnv,"gensym*", 'w', PTIEF GensymStarFunction, "GensymStarFunction", "00"); EnvDefineFunction2(theEnv,"setgen", 'l', PTIEF SetgenFunction, "SetgenFunction", "11i"); EnvDefineFunction2(theEnv,"system", 'v', PTIEF gensystem, "gensystem", "1*k"); EnvDefineFunction2(theEnv,"length", 'l', PTIEF LengthFunction, "LengthFunction", "11q"); EnvDefineFunction2(theEnv,"length$", 'l', PTIEF LengthFunction, "LengthFunction", "11q"); EnvDefineFunction2(theEnv,"time", 'd', PTIEF TimeFunction, "TimeFunction", "00"); EnvDefineFunction2(theEnv,"random", 'l', PTIEF RandomFunction, "RandomFunction", "02i"); EnvDefineFunction2(theEnv,"seed", 'v', PTIEF SeedFunction, "SeedFunction", "11i"); EnvDefineFunction2(theEnv,"conserve-mem", 'v', PTIEF ConserveMemCommand, "ConserveMemCommand", "11w"); EnvDefineFunction2(theEnv,"release-mem", 'l', PTIEF ReleaseMemCommand, "ReleaseMemCommand", "00"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"mem-used", 'l', PTIEF MemUsedCommand, "MemUsedCommand", "00"); EnvDefineFunction2(theEnv,"mem-requests", 'l', PTIEF MemRequestsCommand, "MemRequestsCommand", "00"); #endif EnvDefineFunction2(theEnv,"options", 'v', PTIEF OptionsCommand, "OptionsCommand", "00"); EnvDefineFunction2(theEnv,"(expansion-call)", 'u', PTIEF ExpandFuncCall, "ExpandFuncCall",NULL); EnvDefineFunction2(theEnv,"expand$",'u', PTIEF DummyExpandFuncMultifield, "DummyExpandFuncMultifield","11m"); FuncSeqOvlFlags(theEnv,"expand$",FALSE,FALSE); EnvDefineFunction2(theEnv,"(set-evaluation-error)", 'w', PTIEF CauseEvaluationError,"CauseEvaluationError",NULL); EnvDefineFunction2(theEnv,"set-sequence-operator-recognition", 'b', PTIEF SetSORCommand,"SetSORCommand","11w"); EnvDefineFunction2(theEnv,"get-sequence-operator-recognition",'b', PTIEF EnvGetSequenceOperatorRecognition,"EnvGetSequenceOperatorRecognition","00"); EnvDefineFunction2(theEnv,"get-function-restrictions",'s', PTIEF GetFunctionRestrictions,"GetFunctionRestrictions","11w"); EnvDefineFunction2(theEnv,"create$", 'm', PTIEF CreateFunction, "CreateFunction", NULL); EnvDefineFunction2(theEnv,"mv-append", 'm', PTIEF CreateFunction, "CreateFunction", NULL); EnvDefineFunction2(theEnv,"apropos", 'v', PTIEF AproposCommand, "AproposCommand", "11w"); EnvDefineFunction2(theEnv,"get-function-list", 'm', PTIEF GetFunctionListFunction, "GetFunctionListFunction", "00"); EnvDefineFunction2(theEnv,"funcall",'u', PTIEF FuncallFunction,"FuncallFunction","1**k"); EnvDefineFunction2(theEnv,"timer",'d', PTIEF TimerFunction,"TimerFunction","**"); #endif } /******************************************************************/ /* CreateFunction: H/L access routine for the create$ function. */ /******************************************************************/ globle void CreateFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { StoreInMultifield(theEnv,returnValue,GetFirstArgument(),TRUE); } /*****************************************************************/ /* SetgenFunction: H/L access routine for the setgen function. */ /*****************************************************************/ globle long int SetgenFunction( void *theEnv) { long theLong; DATA_OBJECT theValue; /*==========================================================*/ /* Check to see that a single integer argument is provided. */ /*==========================================================*/ if (EnvArgCountCheck(theEnv,"setgen",EXACTLY,1) == -1) return(MiscFunctionData(theEnv)->GensymNumber); if (EnvArgTypeCheck(theEnv,"setgen",1,INTEGER,&theValue) == FALSE) return(MiscFunctionData(theEnv)->GensymNumber); /*========================================*/ /* The integer must be greater than zero. */ /*========================================*/ theLong = ValueToLong(theValue.value); if (theLong < 1L) { ExpectedTypeError1(theEnv,"setgen",1,"number (greater than or equal to 1)"); return(MiscFunctionData(theEnv)->GensymNumber); } /*====================================*/ /* Set the gensym index to the number */ /* provided and return this value. */ /*====================================*/ MiscFunctionData(theEnv)->GensymNumber = theLong; return(theLong); } /****************************************/ /* GensymFunction: H/L access routine */ /* for the gensym function. */ /****************************************/ globle void *GensymFunction( void *theEnv) { char genstring[15]; /*===========================================*/ /* The gensym function accepts no arguments. */ /*===========================================*/ EnvArgCountCheck(theEnv,"gensym",EXACTLY,0); /*================================================*/ /* Create a symbol using the current gensym index */ /* as the postfix. */ /*================================================*/ sprintf(genstring,"gen%ld",MiscFunctionData(theEnv)->GensymNumber); MiscFunctionData(theEnv)->GensymNumber++; /*====================*/ /* Return the symbol. */ /*====================*/ return(EnvAddSymbol(theEnv,genstring)); } /************************************************/ /* GensymStarFunction: H/L access routine for */ /* the gensym* function. */ /************************************************/ globle void *GensymStarFunction( void *theEnv) { /*============================================*/ /* The gensym* function accepts no arguments. */ /*============================================*/ EnvArgCountCheck(theEnv,"gensym*",EXACTLY,0); /*====================*/ /* Return the symbol. */ /*====================*/ return(GensymStar(theEnv)); } /************************************/ /* GensymStar: C access routine for */ /* the gensym* function. */ /************************************/ globle void *GensymStar( void *theEnv) { char genstring[15]; /*=======================================================*/ /* Create a symbol using the current gensym index as the */ /* postfix. If the symbol is already present in the */ /* symbol table, then continue generating symbols until */ /* a unique symbol is found. */ /*=======================================================*/ do { sprintf(genstring,"gen%ld",MiscFunctionData(theEnv)->GensymNumber); MiscFunctionData(theEnv)->GensymNumber++; } while (FindSymbolHN(theEnv,genstring) != NULL); /*====================*/ /* Return the symbol. */ /*====================*/ return(EnvAddSymbol(theEnv,genstring)); } /********************************************/ /* RandomFunction: H/L access routine for */ /* the random function. */ /********************************************/ globle long RandomFunction( void *theEnv) { int argCount; long rv; DATA_OBJECT theValue; long begin, end; /*====================================*/ /* The random function accepts either */ /* zero or two arguments. */ /*====================================*/ argCount = EnvRtnArgCount(theEnv); if ((argCount != 0) && (argCount != 2)) { PrintErrorID(theEnv,"MISCFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Function random expected either 0 or 2 arguments\n"); } /*========================================*/ /* Return the randomly generated integer. */ /*========================================*/ rv = genrand(); if (argCount == 2) { if (EnvArgTypeCheck(theEnv,"random",1,INTEGER,&theValue) == FALSE) return(rv); begin = DOToLong(theValue); if (EnvArgTypeCheck(theEnv,"random",2,INTEGER,&theValue) == FALSE) return(rv); end = DOToLong(theValue); if (end < begin) { PrintErrorID(theEnv,"MISCFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Function random expected argument #1 to be less than argument #2\n"); return(rv); } rv = begin + (rv % ((end - begin) + 1)); } return(rv); } /******************************************/ /* SeedFunction: H/L access routine for */ /* the seed function. */ /******************************************/ globle void SeedFunction( void *theEnv) { DATA_OBJECT theValue; /*==========================================================*/ /* Check to see that a single integer argument is provided. */ /*==========================================================*/ if (EnvArgCountCheck(theEnv,"seed",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"seed",1,INTEGER,&theValue) == FALSE) return; /*=============================================================*/ /* Seed the random number generator with the provided integer. */ /*=============================================================*/ genseed((int) DOToLong(theValue)); } /********************************************/ /* LengthFunction: H/L access routine for */ /* the length$ function. */ /********************************************/ globle long int LengthFunction( void *theEnv) { DATA_OBJECT item; /*====================================================*/ /* The length$ function expects exactly one argument. */ /*====================================================*/ if (EnvArgCountCheck(theEnv,"length$",EXACTLY,1) == -1) return(-1L); EnvRtnUnknown(theEnv,1,&item); /*====================================================*/ /* If the argument is a string or symbol, then return */ /* the number of characters in the argument. */ /*====================================================*/ if ((GetType(item) == STRING) || (GetType(item) == SYMBOL)) { return( (long) strlen(DOToString(item))); } /*====================================================*/ /* If the argument is a multifield value, then return */ /* the number of fields in the argument. */ /*====================================================*/ if (GetType(item) == MULTIFIELD) { return ( (long) GetDOLength(item)); } /*=============================================*/ /* If the argument wasn't a string, symbol, or */ /* multifield value, then generate an error. */ /*=============================================*/ SetEvaluationError(theEnv,TRUE); ExpectedTypeError2(theEnv,"length$",1); return(-1L); } /*******************************************/ /* ReleaseMemCommand: H/L access routine */ /* for the release-mem function. */ /*******************************************/ globle long ReleaseMemCommand( void *theEnv) { /*================================================*/ /* The release-mem function accepts no arguments. */ /*================================================*/ if (EnvArgCountCheck(theEnv,"release-mem",EXACTLY,0) == -1) return(0); /*========================================*/ /* Release memory to the operating system */ /* and return the amount of memory freed. */ /*========================================*/ return(EnvReleaseMem(theEnv,-1L,FALSE)); } /******************************************/ /* ConserveMemCommand: H/L access routine */ /* for the conserve-mem command. */ /******************************************/ globle void ConserveMemCommand( void *theEnv) { char *argument; DATA_OBJECT theValue; /*===================================*/ /* The conserve-mem function expects */ /* a single symbol argument. */ /*===================================*/ if (EnvArgCountCheck(theEnv,"conserve-mem",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"conserve-mem",1,SYMBOL,&theValue) == FALSE) return; argument = DOToString(theValue); /*====================================================*/ /* If the argument is the symbol "on", then store the */ /* pretty print representation of a construct when it */ /* is defined. */ /*====================================================*/ if (strcmp(argument,"on") == 0) { EnvSetConserveMemory(theEnv,TRUE); } /*======================================================*/ /* Otherwise, if the argument is the symbol "off", then */ /* don't store the pretty print representation of a */ /* construct when it is defined. */ /*======================================================*/ else if (strcmp(argument,"off") == 0) { EnvSetConserveMemory(theEnv,FALSE); } /*=====================================================*/ /* Otherwise, generate an error since the only allowed */ /* arguments are "on" or "off." */ /*=====================================================*/ else { ExpectedTypeError1(theEnv,"conserve-mem",1,"symbol with value on or off"); return; } return; } #if DEBUGGING_FUNCTIONS /****************************************/ /* MemUsedCommand: H/L access routine */ /* for the mem-used command. */ /****************************************/ globle long int MemUsedCommand( void *theEnv) { /*=============================================*/ /* The mem-used function accepts no arguments. */ /*=============================================*/ if (EnvArgCountCheck(theEnv,"mem-used",EXACTLY,0) == -1) return(0); /*============================================*/ /* Return the amount of memory currently held */ /* (both for current use and for later use). */ /*============================================*/ return(EnvMemUsed(theEnv)); } /********************************************/ /* MemRequestsCommand: H/L access routine */ /* for the mem-requests command. */ /********************************************/ globle long int MemRequestsCommand( void *theEnv) { /*=================================================*/ /* The mem-requests function accepts no arguments. */ /*=================================================*/ if (EnvArgCountCheck(theEnv,"mem-requests",EXACTLY,0) == -1) return(0); /*==================================*/ /* Return the number of outstanding */ /* memory requests. */ /*==================================*/ return(EnvMemRequests(theEnv)); } #endif /****************************************/ /* AproposCommand: H/L access routine */ /* for the apropos command. */ /****************************************/ globle void AproposCommand( void *theEnv) { char *argument; DATA_OBJECT argPtr; struct symbolHashNode *hashPtr = NULL; size_t theLength; /*=======================================================*/ /* The apropos command expects a single symbol argument. */ /*=======================================================*/ if (EnvArgCountCheck(theEnv,"apropos",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"apropos",1,SYMBOL,&argPtr) == FALSE) return; /*=======================================*/ /* Determine the length of the argument. */ /*=======================================*/ argument = DOToString(argPtr); theLength = strlen(argument); /*====================================================================*/ /* Print each entry in the symbol table that contains the argument as */ /* a substring. When using a non-ANSI compiler, only those strings */ /* that contain the substring starting at the beginning of the string */ /* are printed. */ /*====================================================================*/ while ((hashPtr = GetNextSymbolMatch(theEnv,argument,theLength,hashPtr,TRUE,NULL)) != NULL) { EnvPrintRouter(theEnv,WDISPLAY,ValueToString(hashPtr)); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } /****************************************/ /* OptionsCommand: H/L access routine */ /* for the options command. */ /****************************************/ globle void OptionsCommand( void *theEnv) { /*===========================================*/ /* The options command accepts no arguments. */ /*===========================================*/ if (EnvArgCountCheck(theEnv,"options",EXACTLY,0) == -1) return; /*=================================*/ /* Print the state of the compiler */ /* flags for this executable. */ /*=================================*/ EnvPrintRouter(theEnv,WDISPLAY,"Machine type: "); #if GENERIC EnvPrintRouter(theEnv,WDISPLAY,"Generic "); #endif #if VAX_VMS EnvPrintRouter(theEnv,WDISPLAY,"VAX VMS "); #endif #if UNIX_V EnvPrintRouter(theEnv,WDISPLAY,"UNIX System V or 4.2BSD "); #endif #if UNIX_7 EnvPrintRouter(theEnv,WDISPLAY,"UNIX System III Version 7 or Sun Unix "); #endif #if MAC_MCW EnvPrintRouter(theEnv,WDISPLAY,"Apple Macintosh with CodeWarrior"); #endif #if MAC_XCD EnvPrintRouter(theEnv,WDISPLAY,"Apple Macintosh with Xcode"); #endif #if IBM_MSC EnvPrintRouter(theEnv,WDISPLAY,"IBM PC with Microsoft C"); #endif #if IBM_ZTC EnvPrintRouter(theEnv,WDISPLAY,"IBM PC with Zortech C"); #endif #if IBM_SC EnvPrintRouter(theEnv,WDISPLAY,"IBM PC with Symantec C++"); #endif #if IBM_ICB EnvPrintRouter(theEnv,WDISPLAY,"IBM PC with Intel C Code Builder"); #endif #if IBM_TBC EnvPrintRouter(theEnv,WDISPLAY,"IBM PC with Turbo C"); #endif #if IBM_MCW EnvPrintRouter(theEnv,WDISPLAY,"IBM PC with Metrowerks CodeWarrior"); #endif EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"Defrule construct is "); #if DEFRULE_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Defmodule construct is "); #if DEFMODULE_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Deftemplate construct is "); #if DEFTEMPLATE_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY," Fact-set queries are "); #if FACT_SET_QUERIES EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif #if DEFTEMPLATE_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY," Deffacts construct is "); #if DEFFACTS_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif #endif EnvPrintRouter(theEnv,WDISPLAY,"Defglobal construct is "); #if DEFGLOBAL_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Deffunction construct is "); #if DEFFUNCTION_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Defgeneric/Defmethod constructs are "); #if DEFGENERIC_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Object System is "); #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif #if OBJECT_SYSTEM EnvPrintRouter(theEnv,WDISPLAY," Definstances construct is "); #if DEFINSTANCES_CONSTRUCT EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY," Instance-set queries are "); #if INSTANCE_SET_QUERIES EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY," Binary loading of instances is "); #if BLOAD_INSTANCES EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY," Binary saving of instances is "); #if BSAVE_INSTANCES EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif #endif EnvPrintRouter(theEnv,WDISPLAY,"Extended math package is "); #if EX_MATH EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Text processing package is "); #if TEXTPRO_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Help system is "); #if HELP_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Bload capability is "); #if BLOAD_ONLY EnvPrintRouter(theEnv,WDISPLAY,"BLOAD ONLY"); #endif #if BLOAD EnvPrintRouter(theEnv,WDISPLAY,"BLOAD"); #endif #if BLOAD_AND_BSAVE EnvPrintRouter(theEnv,WDISPLAY,"BLOAD AND BSAVE"); #endif #if (! BLOAD_ONLY) && (! BLOAD) && (! BLOAD_AND_BSAVE) EnvPrintRouter(theEnv,WDISPLAY,"OFF "); #endif EnvPrintRouter(theEnv,WDISPLAY,"\n"); EnvPrintRouter(theEnv,WDISPLAY,"EMACS Editor is "); #if EMACS_EDITOR EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Construct compiler is "); #if CONSTRUCT_COMPILER EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Basic I/O is "); #if BASIC_IO EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Extended I/O is "); #if EXT_IO EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"String function package is "); #if STRING_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Multifield function package is "); #if MULTIFIELD_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Debugging functions are "); #if DEBUGGING_FUNCTIONS EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Block memory is "); #if BLOCK_MEMORY EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Window Interface flag is "); #if WINDOW_INTERFACE EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Developer flag is "); #if DEVELOPER EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif EnvPrintRouter(theEnv,WDISPLAY,"Run time module is "); #if RUN_TIME EnvPrintRouter(theEnv,WDISPLAY,"ON\n"); #else EnvPrintRouter(theEnv,WDISPLAY,"OFF\n"); #endif } /******************************************************************** NAME : ExpandFuncCall DESCRIPTION : This function is a wrap-around for a normal function call. It preexamines the argument expression list and expands any references to the sequence operator. It builds a copy of the function call expression with these new arguments inserted and evaluates the function call. INPUTS : A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Expressions alloctaed/deallocated Function called and arguments evaluated EvaluationError set on errors NOTES : None *******************************************************************/ globle void ExpandFuncCall( void *theEnv, DATA_OBJECT *result) { EXPRESSION *newargexp,*fcallexp; struct FunctionDefinition *func; /* ====================================================================== Copy the original function call's argument expression list. Look for expand$ function callsexpressions and replace those with the equivalent expressions of the expansions of evaluations of the arguments. ====================================================================== */ newargexp = CopyExpression(theEnv,GetFirstArgument()->argList); ExpandFuncMultifield(theEnv,result,newargexp,&newargexp, (void *) FindFunction(theEnv,"expand$")); /* =================================================================== Build the new function call expression with the expanded arguments. Check the number of arguments, if necessary, and call the thing. =================================================================== */ fcallexp = get_struct(theEnv,expr); fcallexp->type = GetFirstArgument()->type; fcallexp->value = GetFirstArgument()->value; fcallexp->nextArg = NULL; fcallexp->argList = newargexp; if (fcallexp->type == FCALL) { func = (struct FunctionDefinition *) fcallexp->value; if (CheckFunctionArgCount(theEnv,ValueToString(func->callFunctionName), func->restrictions,CountArguments(newargexp)) == FALSE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ReturnExpression(theEnv,fcallexp); return; } } #if DEFFUNCTION_CONSTRUCT else if (fcallexp->type == PCALL) { if (CheckDeffunctionCall(theEnv,fcallexp->value, CountArguments(fcallexp->argList)) == FALSE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ReturnExpression(theEnv,fcallexp); SetEvaluationError(theEnv,TRUE); return; } } #endif EvaluateExpression(theEnv,fcallexp,result); ReturnExpression(theEnv,fcallexp); } /*********************************************************************** NAME : DummyExpandFuncMultifield DESCRIPTION : The expansion of multifield arguments is valid only when done for a function call. All these expansions are handled by the H/L wrap-around function (expansion-call) - see ExpandFuncCall. If the H/L function, epand-multifield is ever called directly, it is an error. INPUTS : Data object buffer RETURNS : Nothing useful SIDE EFFECTS : EvaluationError set NOTES : None **********************************************************************/ globle void DummyExpandFuncMultifield( void *theEnv, DATA_OBJECT *result) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"MISCFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n"); } /*********************************************************************** NAME : ExpandFuncMultifield DESCRIPTION : Recursively examines an expression and replaces PROC_EXPAND_MULTIFIELD expressions with the expanded evaluation expression of its argument INPUTS : 1) A data object result buffer 2) The expression to modify 3) The address of the expression, in case it is deleted entirely 4) The address of the H/L function expand$ RETURNS : Nothing useful SIDE EFFECTS : Expressions allocated/deallocated as necessary Evaluations performed On errors, argument expression set to call a function which causes an evaluation error when evaluated a second time by actual caller. NOTES : THIS ROUTINE MODIFIES EXPRESSIONS AT RUNTIME!! MAKE SURE THAT THE EXPRESSION PASSED IS SAFE TO CHANGE!! **********************************************************************/ static void ExpandFuncMultifield( void *theEnv, DATA_OBJECT *result, EXPRESSION *theExp, EXPRESSION **sto, void *expmult) { EXPRESSION *newexp,*top,*bot; register long i; /* 6.04 Bug Fix */ while (theExp != NULL) { if (theExp->value == expmult) { EvaluateExpression(theEnv,theExp->argList,result); ReturnExpression(theEnv,theExp->argList); if ((EvaluationData(theEnv)->EvaluationError) || (result->type != MULTIFIELD)) { theExp->argList = NULL; if ((EvaluationData(theEnv)->EvaluationError == FALSE) && (result->type != MULTIFIELD)) ExpectedTypeError2(theEnv,"expand$",1); theExp->value = (void *) FindFunction(theEnv,"(set-evaluation-error)"); EvaluationData(theEnv)->EvaluationError = FALSE; EvaluationData(theEnv)->HaltExecution = FALSE; return; } top = bot = NULL; for (i = GetpDOBegin(result) ; i <= GetpDOEnd(result) ; i++) { newexp = get_struct(theEnv,expr); newexp->type = GetMFType(result->value,i); newexp->value = GetMFValue(result->value,i); newexp->argList = NULL; newexp->nextArg = NULL; if (top == NULL) top = newexp; else bot->nextArg = newexp; bot = newexp; } if (top == NULL) { *sto = theExp->nextArg; rtn_struct(theEnv,expr,theExp); theExp = *sto; } else { bot->nextArg = theExp->nextArg; *sto = top; rtn_struct(theEnv,expr,theExp); sto = &bot->nextArg; theExp = bot->nextArg; } } else { if (theExp->argList != NULL) ExpandFuncMultifield(theEnv,result,theExp->argList,&theExp->argList,expmult); sto = &theExp->nextArg; theExp = theExp->nextArg; } } } /**************************************************************** NAME : CauseEvaluationError DESCRIPTION : Dummy function use to cause evaluation errors on a function call to generate error messages INPUTS : None RETURNS : A pointer to the FalseSymbol SIDE EFFECTS : EvaluationError set NOTES : None ****************************************************************/ globle void *CauseEvaluationError( void *theEnv) { SetEvaluationError(theEnv,TRUE); return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); } /**************************************************************** NAME : SetSORCommand DESCRIPTION : Toggles SequenceOpMode - if TRUE, multifield references are replaced with sequence expansion operators INPUTS : None RETURNS : The old value of SequenceOpMode SIDE EFFECTS : SequenceOpMode toggled NOTES : None ****************************************************************/ globle intBool SetSORCommand( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) DATA_OBJECT arg; if (EnvArgTypeCheck(theEnv,"set-sequence-operator-recognition",1,SYMBOL,&arg) == FALSE) return(ExpressionData(theEnv)->SequenceOpMode); return(EnvSetSequenceOperatorRecognition(theEnv,(arg.value == EnvFalseSymbol(theEnv)) ? FALSE : TRUE)); #else return(ExpressionData(theEnv)->SequenceOpMode); #endif } /******************************************************************** NAME : GetFunctionRestrictions DESCRIPTION : Gets DefineFunction2() restriction list for function INPUTS : None RETURNS : A string containing the function restriction codes SIDE EFFECTS : EvaluationError set on errors NOTES : None ********************************************************************/ globle void *GetFunctionRestrictions( void *theEnv) { DATA_OBJECT temp; struct FunctionDefinition *fptr; if (EnvArgTypeCheck(theEnv,"get-function-restrictions",1,SYMBOL,&temp) == FALSE) return((SYMBOL_HN *) EnvAddSymbol(theEnv,"")); fptr = FindFunction(theEnv,DOToString(temp)); if (fptr == NULL) { CantFindItemErrorMessage(theEnv,"function",DOToString(temp)); SetEvaluationError(theEnv,TRUE); return((SYMBOL_HN *) EnvAddSymbol(theEnv,"")); } if (fptr->restrictions == NULL) return((SYMBOL_HN *) EnvAddSymbol(theEnv,"0**")); return((SYMBOL_HN *) EnvAddSymbol(theEnv,fptr->restrictions)); } /*************************************************/ /* GetFunctionListFunction: H/L access routine */ /* for the get-function-list function. */ /*************************************************/ globle void GetFunctionListFunction( void *theEnv, DATA_OBJECT *returnValue) { struct FunctionDefinition *theFunction; struct multifield *theList; unsigned long functionCount = 0; if (EnvArgCountCheck(theEnv,"get-function-list",EXACTLY,0) == -1) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { functionCount++; } SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,functionCount); theList = (struct multifield *) EnvCreateMultifield(theEnv,functionCount); SetpValue(returnValue,(void *) theList); for (theFunction = GetFunctionList(theEnv), functionCount = 1; theFunction != NULL; theFunction = theFunction->next, functionCount++) { SetMFType(theList,functionCount,SYMBOL); SetMFValue(theList,functionCount,theFunction->callFunctionName); } } /***************************************/ /* FuncallFunction: H/L access routine */ /* for the funcall function. */ /***************************************/ globle void FuncallFunction( void *theEnv, DATA_OBJECT *returnValue) { int argCount, i, j; DATA_OBJECT theValue; FUNCTION_REFERENCE theReference; char *name; struct multifield *theMultifield; struct expr *lastAdd = NULL, *nextAdd, *multiAdd; /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=================================================*/ /* The funcall function has at least one argument: */ /* the name of the function being called. */ /*=================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return; /*============================================*/ /* Get the name of the function to be called. */ /*============================================*/ if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE) { return; } /*====================*/ /* Find the function. */ /*====================*/ name = DOToString(theValue); if (! GetFunctionReference(theEnv,name,&theReference)) { ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name"); return; } ExpressionInstall(theEnv,&theReference); /*======================================*/ /* Add the arguments to the expression. */ /*======================================*/ for (i = 2; i <= argCount; i++) { EnvRtnUnknown(theEnv,i,&theValue); if (GetEvaluationError(theEnv)) { ExpressionDeinstall(theEnv,&theReference); return; } switch(GetType(theValue)) { case MULTIFIELD: nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$")); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; multiAdd = NULL; theMultifield = (struct multifield *) GetValue(theValue); for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++) { nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j)); if (multiAdd == NULL) { lastAdd->argList = nextAdd; } else { multiAdd->nextArg = nextAdd; } multiAdd = nextAdd; } ExpressionInstall(theEnv,lastAdd); break; default: nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue)); if (lastAdd == NULL) { theReference.argList = nextAdd; } else { lastAdd->nextArg = nextAdd; } lastAdd = nextAdd; ExpressionInstall(theEnv,lastAdd); break; } } /*===========================================================*/ /* Verify a deffunction has the correct number of arguments. */ /*===========================================================*/ #if DEFFUNCTION_CONSTRUCT if (theReference.type == PCALL) { if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE) { PrintErrorID(theEnv,"MISCFUN",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value)); EnvPrintRouter(theEnv,WERROR,"\n"); ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); return; } } #endif /*======================*/ /* Call the expression. */ /*======================*/ EvaluateExpression(theEnv,&theReference,returnValue); /*========================================*/ /* Return the expression data structures. */ /*========================================*/ ExpressionDeinstall(theEnv,&theReference); ReturnExpression(theEnv,theReference.argList); } /************************************/ /* TimeFunction: H/L access routine */ /* for the time function. */ /************************************/ globle double TimeFunction( void *theEnv) { /*=========================================*/ /* The time function accepts no arguments. */ /*=========================================*/ EnvArgCountCheck(theEnv,"time",EXACTLY,0); /*==================*/ /* Return the time. */ /*==================*/ return(gentime()); } /***************************************/ /* TimerFunction: H/L access routine */ /* for the timer function. */ /***************************************/ globle double TimerFunction( void *theEnv) { int numa, i; double startTime; DATA_OBJECT returnValue; startTime = gentime(); numa = EnvRtnArgCount(theEnv); i = 1; while ((i <= numa) && (GetHaltExecution(theEnv) != TRUE)) { EnvRtnUnknown(theEnv,i,&returnValue); i++; } return(gentime() - startTime); } clips-6.24/clipssrc/._factgen.c0000400000175000017500000000075407422635007014520 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zp'TTFB$(FMWBBMPSRclips-6.24/clipssrc/._genrcfun.h0000400000175000017500000000075410441143554014721 0ustar jfsjfsMac OS X  2 RTEXT???? aTTFH Monaco0z0z1TTFS FMWBBMPSRclips-6.24/clipssrc/._cstrnutl.h0000400000175000017500000000012207422634656014772 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/factprt.c0000755000175000017500000003361410177533440014354 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* FACT RETE PRINT FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Print routines for the fact rete primitives. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _FACTPRT_SOURCE_ #include #define _STDIO_INCLUDED_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "envrnmnt.h" #include "symbol.h" #include "router.h" #include "factgen.h" #include "factprt.h" /***************************************/ /* PrintFactJNCompVars1: Print routine */ /* for the FactJNCompVars1 function. */ /***************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactJNCompVars1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsJN1Call *hack; hack = (struct factCompVarsJN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-cmp-vars1 "); if (hack->pass) EnvPrintRouter(theEnv,logicalName,"p "); else EnvPrintRouter(theEnv,logicalName,"n "); PrintLongInteger(theEnv,logicalName,(long) hack->slot1); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->pattern2); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->slot2); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /***************************************/ /* PrintFactJNCompVars2: Print routine */ /* for the FactJNCompVars2 function. */ /***************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactJNCompVars2( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsJN2Call *hack; hack = (struct factCompVarsJN2Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-cmp-vars2 "); if (hack->pass) EnvPrintRouter(theEnv,logicalName,"p "); else EnvPrintRouter(theEnv,logicalName,"n "); EnvPrintRouter(theEnv,logicalName,"s"); PrintLongInteger(theEnv,logicalName,(long) hack->slot1); EnvPrintRouter(theEnv,logicalName," "); if (hack->fromBeginning1) EnvPrintRouter(theEnv,logicalName,"b "); else EnvPrintRouter(theEnv,logicalName,"e "); EnvPrintRouter(theEnv,logicalName,"f"); PrintLongInteger(theEnv,logicalName,(long) hack->offset1); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,"p"); PrintLongInteger(theEnv,logicalName,(long) hack->pattern2); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,"s"); PrintLongInteger(theEnv,logicalName,(long) hack->slot2); EnvPrintRouter(theEnv,logicalName," "); if (hack->fromBeginning2) EnvPrintRouter(theEnv,logicalName,"b "); else EnvPrintRouter(theEnv,logicalName,"e "); EnvPrintRouter(theEnv,logicalName,"f"); PrintLongInteger(theEnv,logicalName,(long) hack->offset2); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /***************************************/ /* PrintFactPNCompVars1: Print routine */ /* for the FactPNCompVars1 function. */ /***************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactPNCompVars1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsPN1Call *hack; hack = (struct factCompVarsPN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-cmp-vars "); if (hack->pass) EnvPrintRouter(theEnv,logicalName,"p "); else EnvPrintRouter(theEnv,logicalName,"n "); PrintLongInteger(theEnv,logicalName,(long) hack->field1); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->field2); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /**************************************/ /* PrintFactSlotLength: Print routine */ /* for the FactSlotLength function. */ /**************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactSlotLength( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factCheckLengthPNCall *hack; hack = (struct factCheckLengthPNCall *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(slot-length "); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName," "); if (hack->exactly) EnvPrintRouter(theEnv,logicalName,"= "); else EnvPrintRouter(theEnv,logicalName,">= "); PrintLongInteger(theEnv,logicalName,(long) hack->minLength); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactJNGetVar1: Print routine */ /* for the FactJNGetvar1 function. */ /*************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactJNGetVar1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarJN1Call *hack; hack = (struct factGetVarJN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-getvar-1 "); if (hack->factAddress) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); if (hack->allFields) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); PrintLongInteger(theEnv,logicalName,(long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->whichField); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactJNGetVar2: Print routine */ /* for the FactJNGetvar2 function. */ /*************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactJNGetVar2( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarJN2Call *hack; hack = (struct factGetVarJN2Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-getvar-2 "); PrintLongInteger(theEnv,logicalName,(long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactJNGetVar3: Print routine */ /* for the FactJNGetVar3 function. */ /*************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactJNGetVar3( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarJN3Call *hack; hack = (struct factGetVarJN3Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-getvar-3 "); if (hack->fromBeginning) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); if (hack->fromEnd) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); PrintLongInteger(theEnv,logicalName,(long) hack->beginOffset); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->endOffset); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactPNGetVar1: Print routine */ /* for the FactPNGetvar1 function. */ /*************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactPNGetVar1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarPN1Call *hack; hack = (struct factGetVarPN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-getvar-1 "); if (hack->factAddress) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); if (hack->allFields) EnvPrintRouter(theEnv,logicalName,"t F"); else EnvPrintRouter(theEnv,logicalName,"f F"); PrintLongInteger(theEnv,logicalName,(long) hack->whichField); EnvPrintRouter(theEnv,logicalName," S"); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactPNGetVar2: Print routine */ /* for the FactPNGetvar2 function. */ /*************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactPNGetVar2( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarPN2Call *hack; hack = (struct factGetVarPN2Call *) ValueToBitMap(theValue);; EnvPrintRouter(theEnv,logicalName,"(fact-pn-getvar-2 S"); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /*************************************/ /* PrintFactPNGetVar3: Print routine */ /* for the FactPNGetvar3 function. */ /*************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactPNGetVar3( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factGetVarPN3Call *hack; hack = (struct factGetVarPN3Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-getvar-3 "); if (hack->fromBeginning) EnvPrintRouter(theEnv,logicalName,"t "); else EnvPrintRouter(theEnv,logicalName,"f "); if (hack->fromEnd) EnvPrintRouter(theEnv,logicalName,"t B"); else EnvPrintRouter(theEnv,logicalName,"f B"); PrintLongInteger(theEnv,logicalName,(long) hack->beginOffset); EnvPrintRouter(theEnv,logicalName," E"); PrintLongInteger(theEnv,logicalName,(long) hack->endOffset); EnvPrintRouter(theEnv,logicalName," S"); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /***************************************/ /* PrintFactPNConstant1: Print routine */ /* for the FactPNConstant1 function. */ /***************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactPNConstant1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factConstantPN1Call *hack; hack = (struct factConstantPN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-constant1 "); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName," = "); else EnvPrintRouter(theEnv,logicalName," != "); PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } /***************************************/ /* PrintFactPNConstant2: Print routine */ /* for the FactPNConstant2 function. */ /***************************************/ #if IBM_TBC && (! DEVELOPER) #pragma argsused #endif globle void PrintFactPNConstant2( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factConstantPN2Call *hack; hack = (struct factConstantPN2Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-pn-constant2 "); PrintLongInteger(theEnv,logicalName,(long) hack->whichSlot); EnvPrintRouter(theEnv,logicalName," "); PrintLongInteger(theEnv,logicalName,(long) hack->offset); if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName," = "); else EnvPrintRouter(theEnv,logicalName," != "); PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/classini.h0000755000175000017500000000312607422634623014522 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_classini #define _H_classini #ifndef _H_constrct #include "constrct.h" #endif #ifndef _H_object #include "object.h" #endif #if OBJECT_SYSTEM #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSINI_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectSystem(void *); #if RUN_TIME LOCALE void ObjectsRunTimeInitialize(void *,DEFCLASS *[],SLOT_NAME *[],DEFCLASS *[],unsigned); #else LOCALE void CreateSystemClasses(void *); #endif #endif #endif clips-6.24/clipssrc/immthpsr.c0000755000175000017500000003504210253660700014544 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* IMPLICIT SYSTEM METHODS PARSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parsing routines for Implicit System Methods */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Added pragmas to remove unused parameter */ /* warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #include #if OBJECT_SYSTEM #include "classcom.h" #include "classfun.h" #endif #include "envrnmnt.h" #include "memalloc.h" #include "cstrnutl.h" #include "extnfunc.h" #include "genrcpsr.h" #include "prccode.h" #define _IMMTHPSR_SOURCE_ #include "immthpsr.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void FormMethodsFromRestrictions(void *,DEFGENERIC *,char *,EXPRESSION *); static RESTRICTION *ParseRestrictionType(void *,int); static EXPRESSION *GenTypeExpression(void *,EXPRESSION *,int,int,char *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************** NAME : AddImplicitMethods DESCRIPTION : Adds a method(s) for a generic function for an overloaded system function INPUTS : A pointer to a gneeric function RETURNS : Nothing useful SIDE EFFECTS : Method added NOTES : Method marked as system Assumes no other methods already present ********************************************************/ globle void AddImplicitMethods( void *theEnv, DEFGENERIC *gfunc) { struct FunctionDefinition *sysfunc; EXPRESSION action; sysfunc = FindFunction(theEnv,ValueToString(gfunc->header.name)); if (sysfunc == NULL) return; action.type = FCALL; action.value = (void *) sysfunc; action.nextArg = NULL; action.argList = NULL; FormMethodsFromRestrictions(theEnv,gfunc,sysfunc->restrictions,&action); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************************** NAME : FormMethodsFromRestrictions DESCRIPTION : Uses restriction string given in DefineFunction2() for system function to create an equivalent method INPUTS : 1) The generic function for the new methods 2) System function restriction string (see DefineFunction2() last argument) 3) The actions to attach to a new method(s) RETURNS : Nothing useful SIDE EFFECTS : Implicit method(s) created NOTES : None **********************************************************************/ static void FormMethodsFromRestrictions( void *theEnv, DEFGENERIC *gfunc, char *rstring, EXPRESSION *actions) { DEFMETHOD *meth; EXPRESSION *plist,*tmp,*bot,*svBot; RESTRICTION *rptr; char theChar[2],defaultc; int min,max,mposn,needMinimumMethod; register int i,j; /* =================================== The system function will accept any number of any type of arguments =================================== */ if (rstring == NULL) { tmp = get_struct(theEnv,expr); rptr = get_struct(theEnv,restriction); PackRestrictionTypes(theEnv,rptr,NULL); rptr->query = NULL; tmp->argList = (EXPRESSION *) rptr; tmp->nextArg = NULL; meth = AddMethod(theEnv,gfunc,NULL,0,0,tmp,1,0,(SYMBOL_HN *) EnvTrueSymbol(theEnv), PackExpression(theEnv,actions),NULL,FALSE); meth->system = 1; DeleteTempRestricts(theEnv,tmp); return; } /* ============================== Extract the range of arguments from the restriction string ============================== */ theChar[1] = '\0'; if (rstring[0] == '*') min = 0; else { theChar[0] = rstring[0]; min = atoi(theChar); } if (rstring[1] == '*') max = -1; else { theChar[0] = rstring[1]; max = atoi(theChar); } if (rstring[2] != '\0') { defaultc = rstring[2]; j = 3; } else { defaultc = 'u'; j= 2; } /* ================================================ Form a list of method restrictions corresponding to the minimum number of arguments ================================================ */ plist = bot = NULL; for (i = 0 ; i < min ; i++) { theChar[0] = (rstring[j] != '\0') ? rstring[j++] : defaultc; rptr = ParseRestrictionType(theEnv,(int) theChar[0]); tmp = get_struct(theEnv,expr); tmp->argList = (EXPRESSION *) rptr; tmp->nextArg = NULL; if (plist == NULL) plist = tmp; else bot->nextArg = tmp; bot = tmp; } /* =============================== Remember where restrictions end for minimum number of arguments =============================== */ svBot = bot; needMinimumMethod = TRUE; /* ======================================================= Attach one or more new methods to correspond to the possible variations of the extra arguments Add a separate method for each specified extra argument ======================================================= */ i = 0; while (rstring[j] != '\0') { if ((rstring[j+1] == '\0') && ((min + i + 1) == max)) { defaultc = rstring[j]; break; } rptr = ParseRestrictionType(theEnv,(int) rstring[j]); tmp = get_struct(theEnv,expr); tmp->argList = (EXPRESSION *) rptr; tmp->nextArg = NULL; if (plist == NULL) plist = tmp; else bot->nextArg = tmp; bot = tmp; i++; j++; if ((rstring[j] != '\0') || ((min + i) == max)) { FindMethodByRestrictions(gfunc,plist,min + i,NULL,&mposn); meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min + i,0,NULL, PackExpression(theEnv,actions),NULL,TRUE); meth->system = 1; } } /* ============================================== Add a method to account for wildcard arguments and attach a query in case there is a limit ============================================== */ if ((min + i) != max) { /* ================================================ If a wildcard is present immediately after the minimum number of args - then the minimum case will already be handled by this method. We don't need to add an extra method for that case ================================================ */ if (i == 0) needMinimumMethod = FALSE; rptr = ParseRestrictionType(theEnv,(int) defaultc); if (max != -1) { rptr->query = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"<=")); rptr->query->argList = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"length$")); rptr->query->argList->argList = GenProcWildcardReference(theEnv,min + i + 1); rptr->query->argList->nextArg = GenConstant(theEnv,INTEGER,(void *) EnvAddLong(theEnv,(long) (max - min - i))); } tmp = get_struct(theEnv,expr); tmp->argList = (EXPRESSION *) rptr; tmp->nextArg = NULL; if (plist == NULL) plist = tmp; else bot->nextArg = tmp; FindMethodByRestrictions(gfunc,plist,min + i + 1,(SYMBOL_HN *) EnvTrueSymbol(theEnv),&mposn); meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min + i + 1,0,(SYMBOL_HN *) EnvTrueSymbol(theEnv), PackExpression(theEnv,actions),NULL,FALSE); meth->system = 1; } /* =================================================== When extra methods had to be added because of different restrictions on the optional arguments OR the system function accepts a fixed number of args, we must add a specific method for the minimum case. Otherwise, the method with the wildcard covers it. =================================================== */ if (needMinimumMethod) { if (svBot != NULL) { bot = svBot->nextArg; svBot->nextArg = NULL; DeleteTempRestricts(theEnv,bot); } FindMethodByRestrictions(gfunc,plist,min,NULL,&mposn); meth = AddMethod(theEnv,gfunc,NULL,mposn,0,plist,min,0,NULL, PackExpression(theEnv,actions),NULL,TRUE); meth->system = 1; } DeleteTempRestricts(theEnv,plist); } /******************************************************************* NAME : ParseRestrictionType DESCRIPTION : Takes a string of type character codes (as given in DefineFunction2()) and converts it into a method restriction structure INPUTS : The type character code RETURNS : The restriction SIDE EFFECTS : Restriction allocated NOTES : None *******************************************************************/ static RESTRICTION *ParseRestrictionType( void *theEnv, int code) { RESTRICTION *rptr; CONSTRAINT_RECORD *rv; EXPRESSION *types = NULL; rptr = get_struct(theEnv,restriction); rptr->query = NULL; rv = ArgumentTypeToConstraintRecord(theEnv,code); if (rv->anyAllowed == FALSE) { if (rv->symbolsAllowed && rv->stringsAllowed) types = GenTypeExpression(theEnv,types,LEXEME_TYPE_CODE,-1,LEXEME_TYPE_NAME); else if (rv->symbolsAllowed) types = GenTypeExpression(theEnv,types,SYMBOL,SYMBOL,NULL); else if (rv->stringsAllowed) types = GenTypeExpression(theEnv,types,STRING,STRING,NULL); if (rv->floatsAllowed && rv->integersAllowed) types = GenTypeExpression(theEnv,types,NUMBER_TYPE_CODE,-1,NUMBER_TYPE_NAME); else if (rv->integersAllowed) types = GenTypeExpression(theEnv,types,INTEGER,INTEGER,NULL); else if (rv->floatsAllowed) types = GenTypeExpression(theEnv,types,FLOAT,FLOAT,NULL); if (rv->instanceNamesAllowed && rv->instanceAddressesAllowed) types = GenTypeExpression(theEnv,types,INSTANCE_TYPE_CODE,-1,INSTANCE_TYPE_NAME); else if (rv->instanceNamesAllowed) types = GenTypeExpression(theEnv,types,INSTANCE_NAME,INSTANCE_NAME,NULL); else if (rv->instanceAddressesAllowed) types = GenTypeExpression(theEnv,types,INSTANCE_ADDRESS,INSTANCE_ADDRESS,NULL); if (rv->externalAddressesAllowed && rv->instanceAddressesAllowed && rv->factAddressesAllowed) types = GenTypeExpression(theEnv,types,ADDRESS_TYPE_CODE,-1,ADDRESS_TYPE_NAME); else { if (rv->externalAddressesAllowed) types = GenTypeExpression(theEnv,types,EXTERNAL_ADDRESS,EXTERNAL_ADDRESS,NULL); if (rv->instanceAddressesAllowed && (rv->instanceNamesAllowed == 0)) types = GenTypeExpression(theEnv,types,INSTANCE_ADDRESS,INSTANCE_ADDRESS,NULL); if (rv->factAddressesAllowed) types = GenTypeExpression(theEnv,types,FACT_ADDRESS,FACT_ADDRESS,NULL); } if (rv->multifieldsAllowed) types = GenTypeExpression(theEnv,types,MULTIFIELD,MULTIFIELD,NULL); } RemoveConstraint(theEnv,rv); PackRestrictionTypes(theEnv,rptr,types); return(rptr); } /*************************************************** NAME : GenTypeExpression DESCRIPTION : Creates an expression corresponding to the type specified and adds it to the front of a temporary type list for a method restriction INPUTS : 1) The top of the current type list 2) The type code when COOL is not installed 3) The primitive type (-1 if not a primitive type) 4) The name of the COOL class if it is not a primitive type RETURNS : The new top of the types list SIDE EFFECTS : Type node allocated and attached NOTES : Restriction types in a non-COOL environment are the type codes given in CONSTANT.H. In a COOL environment, they are pointers to classes ***************************************************/ #if IBM_TBC #pragma argsused #endif static EXPRESSION *GenTypeExpression( void *theEnv, EXPRESSION *top, int nonCOOLCode, int primitiveCode, char *COOLName) { #if OBJECT_SYSTEM #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(nonCOOLCode) #endif #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(primitiveCode) #pragma unused(COOLName) #endif #endif EXPRESSION *tmp; #if OBJECT_SYSTEM if (primitiveCode != -1) tmp = GenConstant(theEnv,0,(void *) DefclassData(theEnv)->PrimitiveClassMap[primitiveCode]); else tmp = GenConstant(theEnv,0,(void *) LookupDefclassByMdlOrScope(theEnv,COOLName)); #else tmp = GenConstant(theEnv,0,EnvAddLong(theEnv,(long) nonCOOLCode)); #endif tmp->nextArg = top; return(tmp); } #endif /* DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ clips-6.24/clipssrc/._cstrcpsr.c0000400000175000017500000000075410441602114014740 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0dn0dnS<TTFL(HFMPSRMWBBLclips-6.24/clipssrc/globlcmp.c0000755000175000017500000002623710177533443014516 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* DEFGLOBAL CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* defglobal construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _GLOBLCMP_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "conscomp.h" #include "globldef.h" #include "envrnmnt.h" #include "globlcmp.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int ConstructToCode(void *,char *,int,FILE *,int,int); static void DefglobalToCode(void *,FILE *,struct defglobal *, int,int,int); static void DefglobalModuleToCode(void *,FILE *,struct defmodule *,int,int,int); static void CloseDefglobalFiles(void *,FILE *,FILE *,int); static void BeforeDefglobalsToCode(void *); static void InitDefglobalsCode(void *,FILE *,int,int); /***************************************************************/ /* DefglobalCompilerSetup: Initializes the defglobal construct */ /* for use with the constructs-to-c command. */ /***************************************************************/ globle void DefglobalCompilerSetup( void *theEnv) { DefglobalData(theEnv)->DefglobalCodeItem = AddCodeGeneratorItem(theEnv,"defglobal",0,BeforeDefglobalsToCode, InitDefglobalsCode,ConstructToCode,2); } /**************************************************************/ /* BeforeDefglobalsToCode: Assigns each defglobal a unique ID */ /* which will be used for pointer references when the data */ /* structures are written to a file as C code */ /**************************************************************/ static void BeforeDefglobalsToCode( void *theEnv) { MarkConstructBsaveIDs(theEnv,DefglobalData(theEnv)->DefglobalModuleIndex); } /*************************************************/ /* InitDefglobalsCode: Writes out initialization */ /* code for defglobals for a run-time module. */ /*************************************************/ #if IBM_TBC #pragma argsused #endif static void InitDefglobalsCode( void *theEnv, FILE *initFP, int imageID, int maxIndices) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(maxIndices) #pragma unused(imageID) #pragma unused(theEnv) #endif fprintf(initFP," ResetDefglobals(theEnv);\n"); } /***********************************************************/ /* ConstructToCode: Produces defglobal code for a run-time */ /* module created using the constructs-to-c function. */ /***********************************************************/ static int ConstructToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct defglobal *theDefglobal; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; int defglobalArrayCount = 0, defglobalArrayVersion = 1; FILE *moduleFile = NULL, *defglobalFile = NULL; /*================================================*/ /* Include the appropriate defglobal header file. */ /*================================================*/ fprintf(headerFP,"#include \"globldef.h\"\n"); /*===================================================================*/ /* Loop through all the modules and all the defglobals writing their */ /* C code representation to the file as they are traversed. */ /*===================================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "struct defglobalModule",ModulePrefix(DefglobalData(theEnv)->DefglobalCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDefglobalFiles(theEnv,moduleFile,defglobalFile,maxIndices); return(0); } DefglobalModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices,moduleCount); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); for (theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,NULL); theDefglobal != NULL; theDefglobal = (struct defglobal *) EnvGetNextDefglobal(theEnv,theDefglobal)) { defglobalFile = OpenFileIfNeeded(theEnv,defglobalFile,fileName,fileID,imageID,&fileCount, defglobalArrayVersion,headerFP, "struct defglobal",ConstructPrefix(DefglobalData(theEnv)->DefglobalCodeItem), FALSE,NULL); if (defglobalFile == NULL) { CloseDefglobalFiles(theEnv,moduleFile,defglobalFile,maxIndices); return(0); } DefglobalToCode(theEnv,defglobalFile,theDefglobal,imageID,maxIndices,moduleCount); defglobalArrayCount++; defglobalFile = CloseFileIfNeeded(theEnv,defglobalFile,&defglobalArrayCount, &defglobalArrayVersion,maxIndices,NULL,NULL); } moduleCount++; moduleArrayCount++; } CloseDefglobalFiles(theEnv,moduleFile,defglobalFile,maxIndices); return(1); } /**********************************************************/ /* CloseDefglobalFiles: Closes all of the C files created */ /* for defglobals. Called when an error occurs or when */ /* the defglobals have all been written to the files. */ /**********************************************************/ static void CloseDefglobalFiles( void *theEnv, FILE *moduleFile, FILE *defglobalFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (defglobalFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,defglobalFile,&count,&arrayVersion,maxIndices,NULL,NULL); } if (moduleFile != NULL) { count = maxIndices; CloseFileIfNeeded(theEnv,moduleFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /***********************************************************/ /* DefglobalModuleToCode: Writes the C code representation */ /* of a single defglobal module to the specified file. */ /***********************************************************/ #if IBM_TBC #pragma argsused #endif static void DefglobalModuleToCode( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, int maxIndices, int moduleCount) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(moduleCount) #endif fprintf(theFile,"{"); ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices, DefglobalData(theEnv)->DefglobalModuleIndex,ConstructPrefix(DefglobalData(theEnv)->DefglobalCodeItem)); fprintf(theFile,"}"); } /**********************************************************/ /* DefglobalToCode: Writes the C code representation of a */ /* single defglobal construct to the specified file. */ /**********************************************************/ static void DefglobalToCode( void *theEnv, FILE *theFile, struct defglobal *theDefglobal, int imageID, int maxIndices, int moduleCount) { /*==================*/ /* Defglobal Header */ /*==================*/ fprintf(theFile,"{"); ConstructHeaderToCode(theEnv,theFile,&theDefglobal->header,imageID,maxIndices, moduleCount,ModulePrefix(DefglobalData(theEnv)->DefglobalCodeItem), ConstructPrefix(DefglobalData(theEnv)->DefglobalCodeItem)); fprintf(theFile,","); /*============================================*/ /* Watch Flag, In Scope Flag, and Busy Count. */ /*============================================*/ fprintf(theFile,"0,0,%ld,",theDefglobal->busyCount); /*================*/ /* Current Value. */ /*================*/ fprintf(theFile,"{NULL,RVOID}"); /*=====================*/ /* Initial Expression. */ /*=====================*/ fprintf(theFile,","); PrintHashedExpressionReference(theEnv,theFile,theDefglobal->initial,imageID,maxIndices); fprintf(theFile,"}"); } /***************************************************************/ /* DefglobalCModuleReference: Writes the C code representation */ /* of a reference to a defglobal module data structure. */ /***************************************************************/ globle void DefglobalCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", ModulePrefix(DefglobalData(theEnv)->DefglobalCodeItem), imageID, (count / maxIndices) + 1, (count % maxIndices)); } /******************************************************************/ /* DefglobalCConstructReference: Writes the C code representation */ /* of a reference to a defglobal data structure. */ /******************************************************************/ globle void DefglobalCConstructReference( void *theEnv, FILE *theFile, void *vTheGlobal, int imageID, int maxIndices) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; if (theGlobal == NULL) { fprintf(theFile,"NULL"); } else { fprintf(theFile,"&%s%d_%ld[%ld]",ConstructPrefix(DefglobalData(theEnv)->DefglobalCodeItem), imageID, (theGlobal->header.bsaveID / maxIndices) + 1, theGlobal->header.bsaveID % maxIndices); } } #endif /* DEFGLOBAL_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) */ clips-6.24/clipssrc/incrrset.h0000755000175000017500000000444010441147405014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* INCREMENTAL RESET HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functionality for the incremental */ /* reset of the pattern and join networks when a new */ /* rule is added. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_incrrset #define _H_incrrset #ifndef _H_ruledef #include "ruledef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INCRRSET_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetIncrementalReset(theEnv) EnvGetIncrementalReset(theEnv) #define SetIncrementalReset(theEnv,a) EnvSetIncrementalReset(theEnv,a) #else #define GetIncrementalReset() EnvGetIncrementalReset(GetCurrentEnvironment()) #define SetIncrementalReset(a) EnvSetIncrementalReset(GetCurrentEnvironment(),a) #endif LOCALE void IncrementalReset(void *,struct defrule *); LOCALE intBool EnvGetIncrementalReset(void *); LOCALE intBool EnvSetIncrementalReset(void *,intBool); LOCALE int GetIncrementalResetCommand(void *); LOCALE int SetIncrementalResetCommand(void *); #endif clips-6.24/clipssrc/._objrtgen.h0000400000175000017500000000061410441072006014710 0ustar jfsjfsMac OS X  2 R:TEXT???? 22S<2MWBB clips-6.24/clipssrc/._exprnbin.h0000400000175000017500000000012207422634632014733 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/iofun.c0000755000175000017500000013451010441602233014015 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* I/O FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for several I/O functions */ /* including printout, read, open, close, remove, rename, */ /* format, and readline. */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* Gary D. Riley */ /* Bebe Ly */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Added the get-char, set-locale, and */ /* read-number functions. */ /* */ /* Modified printing of floats in the format */ /* function to use the locale from the set-locale */ /* function. */ /* */ /* Moved IllegalLogicalNameMessage function to */ /* argacces.c. */ /* */ /*************************************************************/ #define _IOFUN_SOURCE_ #include "setup.h" #if EXT_IO #include #include #include #endif #include #define _STDIO_INCLUDED_ #include #include "envrnmnt.h" #include "router.h" #include "strngrtr.h" #include "filertr.h" #include "argacces.h" #include "extnfunc.h" #include "scanner.h" #include "constant.h" #include "memalloc.h" #include "commline.h" #include "sysdep.h" #include "utility.h" #include "iofun.h" /***************/ /* DEFINITIONS */ /***************/ #define FORMAT_MAX 512 #define FLAG_MAX 80 /********************/ /* ENVIRONMENT DATA */ /********************/ #define IO_FUNCTION_DATA 64 struct IOFunctionData { void *locale; }; #define IOFunctionData(theEnv) ((struct IOFunctionData *) GetEnvironmentData(theEnv,IO_FUNCTION_DATA)) /****************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /****************************************/ #if BASIC_IO static void ReadTokenFromStdin(void *,struct token *); #endif #if EXT_IO static char *ControlStringCheck(void *,int); static char FindFormatFlag(char *,unsigned *,char *,int *); static char *PrintFormatFlag(void *,char *,int,int,int); static char *FillBuffer(void *,char *,int *,unsigned *); static void ReadNumber(void *,char *,struct token *,int); #endif /**************************************/ /* IOFunctionDefinitions: Initializes */ /* the I/O functions. */ /**************************************/ globle void IOFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,IO_FUNCTION_DATA,sizeof(struct IOFunctionData),NULL); IOFunctionData(theEnv)->locale = (SYMBOL_HN *) EnvAddSymbol(theEnv,setlocale(LC_ALL,NULL)); IncrementSymbolCount(IOFunctionData(theEnv)->locale); #if ! RUN_TIME #if BASIC_IO EnvDefineFunction2(theEnv,"printout", 'v', PTIEF PrintoutFunction, "PrintoutFunction", "1*"); EnvDefineFunction2(theEnv,"read", 'u', PTIEF ReadFunction, "ReadFunction", "*1"); EnvDefineFunction2(theEnv,"open", 'b', OpenFunction, "OpenFunction", "23*k"); EnvDefineFunction2(theEnv,"close", 'b', CloseFunction, "CloseFunction", "*1"); EnvDefineFunction2(theEnv,"get-char", 'i', GetCharFunction, "GetCharFunction", "*1"); #endif #if EXT_IO EnvDefineFunction2(theEnv,"remove", 'b', RemoveFunction, "RemoveFunction", "11k"); EnvDefineFunction2(theEnv,"rename", 'b', RenameFunction, "RenameFunction", "22k"); EnvDefineFunction2(theEnv,"format", 's', PTIEF FormatFunction, "FormatFunction", "2**us"); EnvDefineFunction2(theEnv,"readline", 'k', PTIEF ReadlineFunction, "ReadlineFunction", "*1"); EnvDefineFunction2(theEnv,"set-locale", 'u', PTIEF SetLocaleFunction, "SetLocaleFunction", "*1"); EnvDefineFunction2(theEnv,"read-number", 'u', PTIEF ReadNumberFunction, "ReadNumberFunction", "*1"); #endif #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } #if BASIC_IO /******************************************/ /* PrintoutFunction: H/L access routine */ /* for the printout function. */ /******************************************/ globle void PrintoutFunction( void *theEnv) { char *dummyid; int i, argCount; DATA_OBJECT theArgument; /*=======================================================*/ /* The printout function requires at least one argument. */ /*=======================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"printout",AT_LEAST,1)) == -1) return; /*=====================================================*/ /* Get the logical name to which output is to be sent. */ /*=====================================================*/ dummyid = GetLogicalName(theEnv,1,"stdout"); if (dummyid == NULL) { IllegalLogicalNameMessage(theEnv,"printout"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } /*============================================================*/ /* Determine if any router recognizes the output destination. */ /*============================================================*/ if (strcmp(dummyid,"nil") == 0) { return; } else if (QueryRouters(theEnv,dummyid) == FALSE) { UnrecognizedRouterMessage(theEnv,dummyid); return; } /*===============================================*/ /* Print each of the arguments sent to printout. */ /*===============================================*/ for (i = 2; i <= argCount; i++) { EnvRtnUnknown(theEnv,i,&theArgument); if (EvaluationData(theEnv)->HaltExecution) break; switch(GetType(theArgument)) { case SYMBOL: if (strcmp(DOToString(theArgument),"crlf") == 0) { EnvPrintRouter(theEnv,dummyid,"\n"); } else if (strcmp(DOToString(theArgument),"tab") == 0) { EnvPrintRouter(theEnv,dummyid,"\t"); } else if (strcmp(DOToString(theArgument),"vtab") == 0) { EnvPrintRouter(theEnv,dummyid,"\v"); } else if (strcmp(DOToString(theArgument),"ff") == 0) { EnvPrintRouter(theEnv,dummyid,"\f"); } else if (strcmp(DOToString(theArgument),"t") == 0) { EnvPrintRouter(theEnv,dummyid,"\n"); } else { EnvPrintRouter(theEnv,dummyid,DOToString(theArgument)); } break; case STRING: EnvPrintRouter(theEnv,dummyid,DOToString(theArgument)); break; default: PrintDataObject(theEnv,dummyid,&theArgument); break; } } } /*************************************************************/ /* ReadFunction: H/L access routine for the read function. */ /*************************************************************/ globle void ReadFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct token theToken; int numberOfArguments; char *logicalName = NULL; /*===============================================*/ /* Check for an appropriate number of arguments. */ /*===============================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"read",NO_MORE_THAN,1)) == -1) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } /*======================================================*/ /* Determine the logical name from which input is read. */ /*======================================================*/ if (numberOfArguments == 0) { logicalName = "stdin"; } else if (numberOfArguments == 1) { logicalName = GetLogicalName(theEnv,1,"stdin"); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"read"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } } /*============================================*/ /* Check to see that the logical name exists. */ /*============================================*/ if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } /*=======================================*/ /* Collect input into string if the read */ /* source is stdin, else just get token. */ /*=======================================*/ if (strcmp(logicalName,"stdin") == 0) { ReadTokenFromStdin(theEnv,&theToken); } else { GetToken(theEnv,logicalName,&theToken); } RouterData(theEnv)->CommandBufferInputCount = -1; /*====================================================*/ /* Copy the token to the return value data structure. */ /*====================================================*/ returnValue->type = theToken.type; if ((theToken.type == FLOAT) || (theToken.type == STRING) || #if OBJECT_SYSTEM (theToken.type == INSTANCE_NAME) || #endif (theToken.type == SYMBOL) || (theToken.type == INTEGER)) { returnValue->value = theToken.value; } else if (theToken.type == STOP) { returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF"); } else if (theToken.type == UNKNOWN_VALUE) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); } else { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,theToken.printForm); } return; } /********************************************************/ /* ReadTokenFromStdin: Special routine used by the read */ /* function to read a token from standard input. */ /********************************************************/ static void ReadTokenFromStdin( void *theEnv, struct token *theToken) { char *inputString; unsigned inputStringSize; int inchar; /*=============================================*/ /* Continue processing until a token is found. */ /*=============================================*/ theToken->type = STOP; while (theToken->type == STOP) { /*===========================================*/ /* Initialize the variables used for storing */ /* the characters retrieved from stdin. */ /*===========================================*/ inputString = NULL; RouterData(theEnv)->CommandBufferInputCount = 0; inputStringSize = 0; inchar = EnvGetcRouter(theEnv,"stdin"); /*========================================================*/ /* Continue reading characters until a carriage return is */ /* entered or the user halts execution (usually with */ /* control-c). Waiting for the carriage return prevents */ /* the input from being prematurely parsed (such as when */ /* a space is entered after a symbol has been typed). */ /*========================================================*/ while ((inchar != '\n') && (inchar != '\r') && (inchar != EOF) && (! GetHaltExecution(theEnv))) { inputString = ExpandStringWithChar(theEnv,inchar,inputString,&RouterData(theEnv)->CommandBufferInputCount, &inputStringSize,inputStringSize + 80); inchar = EnvGetcRouter(theEnv,"stdin"); } /*==================================================*/ /* Open a string input source using the characters */ /* retrieved from stdin and extract the first token */ /* contained in the string. */ /*==================================================*/ OpenStringSource(theEnv,"read",inputString,0); GetToken(theEnv,"read",theToken); CloseStringSource(theEnv,"read"); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); /*===========================================*/ /* Pressing control-c (or comparable action) */ /* aborts the read function. */ /*===========================================*/ if (GetHaltExecution(theEnv)) { theToken->type = STRING; theToken->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); } /*====================================================*/ /* Return the EOF symbol if the end of file for stdin */ /* has been encountered. This typically won't occur, */ /* but is possible (for example by pressing control-d */ /* in the UNIX operating system). */ /*====================================================*/ if ((theToken->type == STOP) && (inchar == EOF)) { theToken->type = SYMBOL; theToken->value = (void *) EnvAddSymbol(theEnv,"EOF"); } } } /*************************************************************/ /* OpenFunction: H/L access routine for the open function. */ /*************************************************************/ globle int OpenFunction( void *theEnv) { int numberOfArguments; char *fileName, *logicalName, *accessMode = NULL; DATA_OBJECT theArgument; /*========================================*/ /* Check for a valid number of arguments. */ /*========================================*/ if ((numberOfArguments = EnvArgRangeCheck(theEnv,"open",2,3)) == -1) return(0); /*====================*/ /* Get the file name. */ /*====================*/ if ((fileName = GetFileName(theEnv,"open",1)) == NULL) return(0); /*=======================================*/ /* Get the logical name to be associated */ /* with the opened file. */ /*=======================================*/ logicalName = GetLogicalName(theEnv,2,NULL); if (logicalName == NULL) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); IllegalLogicalNameMessage(theEnv,"open"); return(0); } /*==================================*/ /* Check to see if the logical name */ /* is already in use. */ /*==================================*/ if (FindFile(theEnv,logicalName)) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); PrintErrorID(theEnv,"IOFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Logical name "); EnvPrintRouter(theEnv,WERROR,logicalName); EnvPrintRouter(theEnv,WERROR," already in use.\n"); return(0); } /*===========================*/ /* Get the file access mode. */ /*===========================*/ if (numberOfArguments == 2) { accessMode = "r"; } else if (numberOfArguments == 3) { if (EnvArgTypeCheck(theEnv,"open",3,STRING,&theArgument) == FALSE) return(0); accessMode = DOToString(theArgument); } /*=====================================*/ /* Check for a valid file access mode. */ /*=====================================*/ if ((strcmp(accessMode,"r") != 0) && (strcmp(accessMode,"r+") != 0) && (strcmp(accessMode,"w") != 0) && (strcmp(accessMode,"a") != 0) && (strcmp(accessMode,"wb") != 0)) { SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); ExpectedTypeError1(theEnv,"open",3,"string with value \"r\", \"r+\", \"w\", \"wb\", or \"a\""); return(0); } /*================================================*/ /* Open the named file and associate it with the */ /* specified logical name. Return TRUE if the */ /* file was opened successfully, otherwise FALSE. */ /*================================================*/ return(OpenAFile(theEnv,fileName,accessMode,logicalName)); } /***************************************************************/ /* CloseFunction: H/L access routine for the close function. */ /***************************************************************/ globle int CloseFunction( void *theEnv) { int numberOfArguments; char *logicalName; /*======================================*/ /* Check for valid number of arguments. */ /*======================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"close",NO_MORE_THAN,1)) == -1) return(0); /*=====================================================*/ /* If no arguments are specified, then close all files */ /* opened with the open command. Return TRUE if all */ /* files were closed successfully, otherwise FALSE. */ /*=====================================================*/ if (numberOfArguments == 0) return(CloseAllFiles(theEnv)); /*================================*/ /* Get the logical name argument. */ /*================================*/ logicalName = GetLogicalName(theEnv,1,NULL); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"close"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(0); } /*========================================================*/ /* Close the file associated with the specified logical */ /* name. Return TRUE if the file was closed successfully, */ /* otherwise false. */ /*========================================================*/ return(CloseFile(theEnv,logicalName)); } /***************************************/ /* GetCharFunction: H/L access routine */ /* for the get-char function. */ /***************************************/ globle int GetCharFunction( void *theEnv) { int numberOfArguments; char *logicalName; if ((numberOfArguments = EnvArgCountCheck(theEnv,"get-char",NO_MORE_THAN,1)) == -1) { return(-1); } if (numberOfArguments == 0 ) { logicalName = "stdin"; } else { logicalName = GetLogicalName(theEnv,1,"stdin"); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"get-char"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } } if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } return(EnvGetcRouter(theEnv,logicalName)); } #endif #if EXT_IO /****************************************/ /* RemoveFunction: H/L access routine */ /* for the remove function. */ /****************************************/ globle int RemoveFunction( void *theEnv) { char *theFileName; /*======================================*/ /* Check for valid number of arguments. */ /*======================================*/ if (EnvArgCountCheck(theEnv,"remove",EXACTLY,1) == -1) return(FALSE); /*====================*/ /* Get the file name. */ /*====================*/ if ((theFileName = GetFileName(theEnv,"remove",1)) == NULL) return(FALSE); /*==============================================*/ /* Remove the file. Return TRUE if the file was */ /* sucessfully removed, otherwise FALSE. */ /*==============================================*/ return(genremove(theFileName)); } /****************************************/ /* RenameFunction: H/L access routine */ /* for the rename function. */ /****************************************/ globle int RenameFunction( void *theEnv) { char *oldFileName, *newFileName; /*========================================*/ /* Check for a valid number of arguments. */ /*========================================*/ if (EnvArgCountCheck(theEnv,"rename",EXACTLY,2) == -1) return(FALSE); /*===========================*/ /* Check for the file names. */ /*===========================*/ if ((oldFileName = GetFileName(theEnv,"rename",1)) == NULL) return(FALSE); if ((newFileName = GetFileName(theEnv,"rename",2)) == NULL) return(FALSE); /*==============================================*/ /* Rename the file. Return TRUE if the file was */ /* sucessfully renamed, otherwise FALSE. */ /*==============================================*/ return(genrename(oldFileName,newFileName)); } /****************************************/ /* FormatFunction: H/L access routine */ /* for the format function. */ /****************************************/ globle void *FormatFunction( void *theEnv) { int argCount; unsigned start_pos; char *formatString, *logicalName; char formatFlagType; int f_cur_arg = 3; unsigned form_pos = 0; char buffer[FORMAT_MAX]; char percentBuffer[FLAG_MAX]; char *fstr = NULL; unsigned fmaxm = 0; int fpos = 0; void *hptr; int longFound; char *theString; /*======================================*/ /* Set default return value for errors. */ /*======================================*/ hptr = EnvAddSymbol(theEnv,""); /*=========================================*/ /* Format requires at least two arguments: */ /* a logical name and a format string. */ /*=========================================*/ if ((argCount = EnvArgCountCheck(theEnv,"format",AT_LEAST,2)) == -1) { return(hptr); } /*========================================*/ /* First argument must be a logical name. */ /*========================================*/ if ((logicalName = GetLogicalName(theEnv,1,"stdout")) == NULL) { IllegalLogicalNameMessage(theEnv,"format"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(hptr); } if (strcmp(logicalName,"nil") == 0) { /* do nothing */ } else if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); return(hptr); } /*=====================================================*/ /* Second argument must be a string. The appropriate */ /* number of arguments specified by the string must be */ /* present in the argument list. */ /*=====================================================*/ if ((formatString = ControlStringCheck(theEnv,argCount)) == NULL) { return (hptr); } /*==============================================*/ /* Locate a string of 80 character for scanning */ /* sub_string from control_string */ /*==============================================*/ /* Scanning and print the format */ while (formatString[form_pos] != '\0') { if (formatString[form_pos] != '%') { start_pos = form_pos; while ((formatString[form_pos] != '%') && (formatString[form_pos] != '\0') && ((form_pos - start_pos) < FLAG_MAX)) { form_pos++; } fstr = AppendNToString(theEnv,&formatString[start_pos],fstr,form_pos-start_pos,&fpos,&fmaxm); } else { start_pos = form_pos; form_pos++; formatFlagType = FindFormatFlag(formatString,&form_pos,buffer,&longFound); if (formatFlagType != ' ') { strncpy(percentBuffer,&formatString[start_pos], (STD_SIZE) form_pos-start_pos); percentBuffer[form_pos-start_pos] = EOS; if ((! longFound) && ((formatFlagType == 'd') || (formatFlagType == 'o') || (formatFlagType == 'u') || (formatFlagType == 'x'))) { longFound = TRUE; percentBuffer[(form_pos-start_pos) - 1] = 'l'; percentBuffer[form_pos-start_pos] = formatFlagType; percentBuffer[(form_pos-start_pos) + 1] = EOS; } if ((theString = PrintFormatFlag(theEnv,percentBuffer,f_cur_arg,formatFlagType,longFound)) == NULL) { if (fstr != NULL) rm(theEnv,fstr,fmaxm); return (hptr); } fstr = AppendToString(theEnv,theString,fstr,&fpos,&fmaxm); if (fstr == NULL) return(hptr); f_cur_arg++; } else { fstr = AppendToString(theEnv,buffer,fstr,&fpos,&fmaxm); if (fstr == NULL) return(hptr); } } } if (fstr != NULL) { hptr = EnvAddSymbol(theEnv,fstr); if (strcmp(logicalName,"nil") != 0) EnvPrintRouter(theEnv,logicalName,fstr); rm(theEnv,fstr,fmaxm); } else { hptr = EnvAddSymbol(theEnv,""); } return(hptr); } /*********************************************************************/ /* ControlStringCheck: Checks the 2nd parameter which is the format */ /* control string to see if there are enough matching arguments. */ /*********************************************************************/ static char *ControlStringCheck( void *theEnv, int argCount) { DATA_OBJECT t_ptr; char *str_array; char print_buff[10]; int longFound; unsigned i; int per_count; if (EnvArgTypeCheck(theEnv,"format",2,STRING,&t_ptr) == FALSE) return(NULL); per_count = 0; str_array = ValueToString(t_ptr.value); for (i= 0 ; str_array[i] != '\0' ; ) { if (str_array[i] == '%') { i++; if (FindFormatFlag(str_array,&i,print_buff,&longFound) != ' ') { per_count++; } } else { i++; } } if (per_count != (argCount - 2)) { ExpectedCountError(theEnv,"format",EXACTLY,per_count+2); SetEvaluationError(theEnv,TRUE); return (NULL); } return(str_array); } /***********************************************/ /* FindFormatFlag: This function searches for */ /* a format flag in the format string. */ /***********************************************/ static char FindFormatFlag( char *formatString, unsigned *a, char *formatBuffer, int *longFound) { char inchar, formatFlagType; unsigned start_pos, copy_pos = 0; /*===========================================================*/ /* Set return values to the default value. A blank character */ /* indicates that no format flag was found which requires a */ /* parameter. The longFound flag indicates whether the */ /* character 'l' was used with the float or integer flag to */ /* indicate a double precision float or a long integer. */ /*===========================================================*/ formatFlagType = ' '; *longFound = FALSE; /*=====================================================*/ /* The format flags for carriage returns, line feeds, */ /* horizontal and vertical tabs, and the percent sign, */ /* do not require a parameter. */ /*=====================================================*/ if (formatString[*a] == 'n') { sprintf(formatBuffer,"\n"); (*a)++; return(formatFlagType); } else if (formatString[*a] == 'r') { sprintf(formatBuffer,"\r"); (*a)++; return(formatFlagType); } else if (formatString[*a] == 't') { sprintf(formatBuffer,"\t"); (*a)++; return(formatFlagType); } else if (formatString[*a] == 'v') { sprintf(formatBuffer,"\v"); (*a)++; return(formatFlagType); } else if (formatString[*a] == '%') { sprintf(formatBuffer,"%%"); (*a)++; return(formatFlagType); } /*======================================================*/ /* Identify the format flag which requires a parameter. */ /*======================================================*/ start_pos = *a; formatBuffer[copy_pos] = '\0'; while ((formatString[*a] != '%') && (formatString[*a] != '\0') && ((*a - start_pos) < FLAG_MAX)) { inchar = formatString[*a]; formatBuffer[copy_pos++] = inchar; formatBuffer[copy_pos] = '\0'; if ( (inchar == 'd') || (inchar == 'o') || (inchar == 'x') || (inchar == 'u') || (inchar == 'c') || (inchar == 's') || (inchar == 'e') || (inchar == 'f') || (inchar == 'g') ) { formatFlagType = inchar; if (formatString[(*a) - 1] == 'l') { *longFound = TRUE; } (*a)++; return(formatFlagType); } (*a)++; } return(formatFlagType); } /**********************************************************************/ /* PrintFormatFlag: Prints out part of the total format string along */ /* with the argument for that part of the format string. */ /**********************************************************************/ static char *PrintFormatFlag( void *theEnv, char *formatString, int whichArg, int formatType, int longFound) { DATA_OBJECT theResult; char *theString, *printBuffer; unsigned theLength; void *oldLocale; /*=================*/ /* String argument */ /*=================*/ switch (formatType) { case 's': if (EnvArgTypeCheck(theEnv,"format",whichArg,SYMBOL_OR_STRING,&theResult) == FALSE) return(NULL); theLength = strlen(formatString) + strlen(ValueToString(theResult.value)) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); sprintf(printBuffer,formatString,ValueToString(theResult.value)); break; case 'c': EnvRtnUnknown(theEnv,whichArg,&theResult); if ((GetType(theResult) == STRING) || (GetType(theResult) == SYMBOL)) { theLength = strlen(formatString) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); sprintf(printBuffer,formatString,(ValueToString(theResult.value))[0]); } else if (GetType(theResult) == INTEGER) { theLength = strlen(formatString) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); sprintf(printBuffer,formatString,(char) DOToLong(theResult)); } else { ExpectedTypeError1(theEnv,"format",whichArg,"symbol, string, or integer"); return(NULL); } break; case 'd': case 'x': case 'o': case 'u': if (EnvArgTypeCheck(theEnv,"format",whichArg,INTEGER_OR_FLOAT,&theResult) == FALSE) return(NULL); theLength = strlen(formatString) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); oldLocale = EnvAddSymbol(theEnv,setlocale(LC_NUMERIC,NULL)); setlocale(LC_NUMERIC,ValueToString(IOFunctionData(theEnv)->locale)); if (GetType(theResult) == FLOAT) { if (longFound) { sprintf(printBuffer,formatString,(long) ValueToDouble(theResult.value)); } else { sprintf(printBuffer,formatString,(int) ValueToDouble(theResult.value)); } } else { if (longFound) { sprintf(printBuffer,formatString,(long) ValueToLong(theResult.value)); } else { sprintf(printBuffer,formatString,(int) ValueToLong(theResult.value)); } } setlocale(LC_NUMERIC,ValueToString(oldLocale)); break; case 'f': case 'g': case 'e': if (EnvArgTypeCheck(theEnv,"format",whichArg,INTEGER_OR_FLOAT,&theResult) == FALSE) return(NULL); theLength = strlen(formatString) + 200; printBuffer = (char *) gm2(theEnv,(sizeof(char) * theLength)); oldLocale = EnvAddSymbol(theEnv,setlocale(LC_NUMERIC,NULL)); setlocale(LC_NUMERIC,ValueToString(IOFunctionData(theEnv)->locale)); if (GetType(theResult) == FLOAT) { sprintf(printBuffer,formatString,ValueToDouble(theResult.value)); } else { sprintf(printBuffer,formatString,(double) ValueToLong(theResult.value)); } setlocale(LC_NUMERIC,ValueToString(oldLocale)); break; default: EnvPrintRouter(theEnv,WERROR," Error in format, the conversion character"); EnvPrintRouter(theEnv,WERROR," for formatted output is not valid\n"); return(FALSE); } theString = ValueToString(EnvAddSymbol(theEnv,printBuffer)); rm(theEnv,printBuffer,sizeof(char) * theLength); return(theString); } /******************************************/ /* ReadlineFunction: H/L access routine */ /* for the readline function. */ /******************************************/ globle void ReadlineFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { char *buffer; unsigned line_max = 0; int numberOfArguments; char *logicalName; returnValue->type = STRING; if ((numberOfArguments = EnvArgCountCheck(theEnv,"readline",NO_MORE_THAN,1)) == -1) { returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } if (numberOfArguments == 0 ) { logicalName = "stdin"; } else { logicalName = GetLogicalName(theEnv,1,"stdin"); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"readline"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } } if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } RouterData(theEnv)->CommandBufferInputCount = 0; buffer = FillBuffer(theEnv,logicalName,&RouterData(theEnv)->CommandBufferInputCount,&line_max); RouterData(theEnv)->CommandBufferInputCount = -1; if (GetHaltExecution(theEnv)) { returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); if (buffer != NULL) rm(theEnv,buffer,(int) sizeof (char) * line_max); return; } if (buffer == NULL) { returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF"); returnValue->type = SYMBOL; return; } returnValue->value = (void *) EnvAddSymbol(theEnv,buffer); rm(theEnv,buffer,(int) sizeof (char) * line_max); return; } /*************************************************************/ /* FillBuffer: Read characters from a specified logical name */ /* and places them into a buffer until a carriage return */ /* or end-of-file character is read. */ /*************************************************************/ static char *FillBuffer( void *theEnv, char *logicalName, int *currentPosition, unsigned *maximumSize) { int c; char *buf = NULL; /*================================*/ /* Read until end of line or eof. */ /*================================*/ c = EnvGetcRouter(theEnv,logicalName); if (c == EOF) { return(NULL); } /*==================================*/ /* Grab characters until cr or eof. */ /*==================================*/ while ((c != '\n') && (c != '\r') && (c != EOF) && (! GetHaltExecution(theEnv))) { buf = ExpandStringWithChar(theEnv,c,buf,currentPosition,maximumSize,*maximumSize+80); c = EnvGetcRouter(theEnv,logicalName); } /*==================*/ /* Add closing EOS. */ /*==================*/ buf = ExpandStringWithChar(theEnv,EOS,buf,currentPosition,maximumSize,*maximumSize+80); return (buf); } /*****************************************/ /* SetLocaleFunction: H/L access routine */ /* for the set-locale function. */ /*****************************************/ globle void SetLocaleFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { DATA_OBJECT theResult; int numArgs; /*======================================*/ /* Check for valid number of arguments. */ /*======================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"set-locale",NO_MORE_THAN,1)) == -1) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /*=================================*/ /* If there are no arguments, just */ /* return the current locale. */ /*=================================*/ if (numArgs == 0) { returnValue->type = STRING; returnValue->value = IOFunctionData(theEnv)->locale; return; } /*=================*/ /* Get the locale. */ /*=================*/ if (EnvArgTypeCheck(theEnv,"set-locale",1,STRING,&theResult) == FALSE) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return; } /*=====================================*/ /* Return the old value of the locale. */ /*=====================================*/ returnValue->type = STRING; returnValue->value = IOFunctionData(theEnv)->locale; /*======================================================*/ /* Change the value of the locale to the one specified. */ /*======================================================*/ DecrementSymbolCount(theEnv,(struct symbolHashNode *) IOFunctionData(theEnv)->locale); IOFunctionData(theEnv)->locale = DOToPointer(theResult); IncrementSymbolCount(IOFunctionData(theEnv)->locale); } /******************************************/ /* ReadNumberFunction: H/L access routine */ /* for the read-number function. */ /******************************************/ globle void ReadNumberFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct token theToken; int numberOfArguments; char *logicalName = NULL; /*===============================================*/ /* Check for an appropriate number of arguments. */ /*===============================================*/ if ((numberOfArguments = EnvArgCountCheck(theEnv,"read",NO_MORE_THAN,1)) == -1) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } /*======================================================*/ /* Determine the logical name from which input is read. */ /*======================================================*/ if (numberOfArguments == 0) { logicalName = "stdin"; } else if (numberOfArguments == 1) { logicalName = GetLogicalName(theEnv,1,"stdin"); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"read"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } } /*============================================*/ /* Check to see that the logical name exists. */ /*============================================*/ if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); return; } /*=======================================*/ /* Collect input into string if the read */ /* source is stdin, else just get token. */ /*=======================================*/ if (strcmp(logicalName,"stdin") == 0) { ReadNumber(theEnv,logicalName,&theToken,TRUE); } else { ReadNumber(theEnv,logicalName,&theToken,FALSE); } RouterData(theEnv)->CommandBufferInputCount = -1; /*====================================================*/ /* Copy the token to the return value data structure. */ /*====================================================*/ returnValue->type = theToken.type; if ((theToken.type == FLOAT) || (theToken.type == STRING) || #if OBJECT_SYSTEM (theToken.type == INSTANCE_NAME) || #endif (theToken.type == SYMBOL) || (theToken.type == INTEGER)) { returnValue->value = theToken.value; } else if (theToken.type == STOP) { returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF"); } else if (theToken.type == UNKNOWN_VALUE) { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); } else { returnValue->type = STRING; returnValue->value = (void *) EnvAddSymbol(theEnv,theToken.printForm); } return; } /********************************************/ /* ReadNumber: Special routine used by the */ /* read-number function to read a number. */ /********************************************/ static void ReadNumber( void *theEnv, char *logicalName, struct token *theToken, int isStdin) { char *inputString; char *charPtr = NULL; unsigned inputStringSize; int inchar; long theLong; double theDouble; void *oldLocale; theToken->type = STOP; /*===========================================*/ /* Initialize the variables used for storing */ /* the characters retrieved from stdin. */ /*===========================================*/ inputString = NULL; RouterData(theEnv)->CommandBufferInputCount = 0; inputStringSize = 0; inchar = EnvGetcRouter(theEnv,logicalName); /*====================================*/ /* Skip whitespace before any number. */ /*====================================*/ while (isspace(inchar) && (inchar != EOF) && (! GetHaltExecution(theEnv))) { inchar = EnvGetcRouter(theEnv,logicalName); } /*=============================================================*/ /* Continue reading characters until whitespace is found again */ /* (for anything other than stdin) or a CR/LF (for stdin). */ /*=============================================================*/ while ((((! isStdin) && (! isspace(inchar))) || (isStdin && (inchar != '\n') && (inchar != '\r'))) && (inchar != EOF) && (! GetHaltExecution(theEnv))) { inputString = ExpandStringWithChar(theEnv,inchar,inputString,&RouterData(theEnv)->CommandBufferInputCount, &inputStringSize,inputStringSize + 80); inchar = EnvGetcRouter(theEnv,logicalName); } /*===========================================*/ /* Pressing control-c (or comparable action) */ /* aborts the read-number function. */ /*===========================================*/ if (GetHaltExecution(theEnv)) { theToken->type = STRING; theToken->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); return; } /*====================================================*/ /* Return the EOF symbol if the end of file for stdin */ /* has been encountered. This typically won't occur, */ /* but is possible (for example by pressing control-d */ /* in the UNIX operating system). */ /*====================================================*/ if (inchar == EOF) { theToken->type = SYMBOL; theToken->value = (void *) EnvAddSymbol(theEnv,"EOF"); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); return; } /*==================================================*/ /* Open a string input source using the characters */ /* retrieved from stdin and extract the first token */ /* contained in the string. */ /*==================================================*/ /*=======================================*/ /* Change the locale so that numbers are */ /* converted using the localized format. */ /*=======================================*/ oldLocale = EnvAddSymbol(theEnv,setlocale(LC_NUMERIC,NULL)); setlocale(LC_NUMERIC,ValueToString(IOFunctionData(theEnv)->locale)); /*========================================*/ /* Try to parse the number as a long. The */ /* terminating character must either be */ /* white space or the string terminator. */ /*========================================*/ theLong = strtol(inputString,&charPtr,10); if ((charPtr != inputString) && (isspace(*charPtr) || (*charPtr == '\0'))) { theToken->type = INTEGER; theToken->value = (void *) EnvAddLong(theEnv,theLong); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); setlocale(LC_NUMERIC,ValueToString(oldLocale)); return; } /*==========================================*/ /* Try to parse the number as a double. The */ /* terminating character must either be */ /* white space or the string terminator. */ /*==========================================*/ theDouble = strtod(inputString,&charPtr); if ((charPtr != inputString) && (isspace(*charPtr) || (*charPtr == '\0'))) { theToken->type = FLOAT; theToken->value = (void *) EnvAddDouble(theEnv,theDouble); if (inputStringSize > 0) rm(theEnv,inputString,inputStringSize); setlocale(LC_NUMERIC,ValueToString(oldLocale)); return; } /*============================================*/ /* Restore the "C" locale so that any parsing */ /* of numbers uses the C format. */ /*============================================*/ setlocale(LC_NUMERIC,ValueToString(oldLocale)); /*=========================================*/ /* Return "*** READ ERROR ***" to indicate */ /* a number was not successfully parsed. */ /*=========================================*/ theToken->type = STRING; theToken->value = (void *) EnvAddSymbol(theEnv,"*** READ ERROR ***"); } #endif clips-6.24/clipssrc/envrnmnt.c0000755000175000017500000005036310441602147014553 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* ENVIRONMENT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Routines for supporting multiple environments. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /* 6.24: Added code to CreateEnvironment to free */ /* already allocated data if one of the malloc */ /* calls fail. */ /* */ /* Modified AllocateEnvironmentData to print a */ /* message if it was unable to allocate memory. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added CreateRuntimeEnvironment function. */ /* */ /* Added support for context information when an */ /* environment is created (i.e a pointer from the */ /* CLIPS environment to its parent environment). */ /* */ /*************************************************************/ #define _ENVRNMNT_SOURCE_ #include #include #include #include "setup.h" #include "memalloc.h" #include "prntutil.h" #include "router.h" #include "engine.h" #include "sysdep.h" #include "utility.h" #include "envrnmnt.h" #define SIZE_ENVIRONMENT_HASH 131 /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if ALLOW_ENVIRONMENT_GLOBALS static void AddHashedEnvironment(struct environmentData *); static struct environmentData *FindEnvironment(unsigned long); static intBool RemoveHashedEnvironment(struct environmentData *); static void InitializeEnvironmentHashTable(void); #endif static void RemoveEnvironmentCleanupFunctions(struct environmentData *); static void *CreateEnvironmentDriver(struct symbolHashNode **,struct floatHashNode **, struct integerHashNode **,struct bitMapHashNode **); /***************************************/ /* LOCAL INTERNAL VARIABLE DEFINITIONS */ /***************************************/ #if ALLOW_ENVIRONMENT_GLOBALS static unsigned long NextEnvironmentIndex = 0; static struct environmentData **EnvironmentHashTable = NULL; static struct environmentData *CurrentEnvironment = NULL; #endif /*******************************************************/ /* AllocateEnvironmentData: Allocates environment data */ /* for the specified environment data record. */ /*******************************************************/ globle intBool AllocateEnvironmentData( void *vtheEnvironment, unsigned int position, unsigned long size, void (*cleanupFunction)(void *)) { struct environmentData *theEnvironment = (struct environmentData *) vtheEnvironment; /*===========================================*/ /* Environment data can't be of length zero. */ /*===========================================*/ if (size <= 0) { printf("\n[ENVRNMNT1] Environment data position %d allocated with size of 0 or less.\n",position); return(FALSE); } /*================================================================*/ /* Check to see if the data position exceeds the maximum allowed. */ /*================================================================*/ if (position >= MAXIMUM_ENVIRONMENT_POSITIONS) { printf("\n[ENVRNMNT2] Environment data position %d exceeds the maximum allowed.\n",position); return(FALSE); } /*============================================================*/ /* Check if the environment data has already been registered. */ /*============================================================*/ if (theEnvironment->theData[position] != NULL) { printf("\n[ENVRNMNT3] Environment data position %d already allocated.\n",position); return(FALSE); } /*====================*/ /* Allocate the data. */ /*====================*/ theEnvironment->theData[position] = malloc(size); if (theEnvironment->theData[position] == NULL) { printf("\n[ENVRNMNT4] Environment data position %d could not be allocated.\n",position); return(FALSE); } memset(theEnvironment->theData[position],0,size); /*=============================*/ /* Store the cleanup function. */ /*=============================*/ theEnvironment->cleanupFunctions[position] = cleanupFunction; /*===============================*/ /* Data successfully registered. */ /*===============================*/ return(TRUE); } /***************************************************************/ /* DeallocateEnvironmentData: Deallocates all environments */ /* stored in the environment hash table and then deallocates */ /* the environment hash table. */ /***************************************************************/ globle intBool DeallocateEnvironmentData() { #if ALLOW_ENVIRONMENT_GLOBALS struct environmentData *theEnvironment, *nextEnvironment; int i, rv = TRUE; for (i = 0; i < SIZE_ENVIRONMENT_HASH; i++) { for (theEnvironment = EnvironmentHashTable[i]; theEnvironment != NULL; ) { nextEnvironment = theEnvironment->next; if (! DestroyEnvironment(theEnvironment)) { rv = FALSE; } theEnvironment = nextEnvironment; } } free(EnvironmentHashTable); return(rv); #else return(FALSE); #endif } #if ALLOW_ENVIRONMENT_GLOBALS /*********************************************************/ /* InitializeEnvironmentHashTable: Initializes the table */ /* entries in the environment hash table to NULL. */ /*********************************************************/ static void InitializeEnvironmentHashTable() { int i; if (EnvironmentHashTable != NULL) { return; } EnvironmentHashTable = (struct environmentData **) malloc(sizeof (struct environmentData *) * SIZE_ENVIRONMENT_HASH); if (EnvironmentHashTable == NULL) { printf("\n[ENVRNMNT4] Unable to initialize environment hash table.\n"); return; } for (i = 0; i < SIZE_ENVIRONMENT_HASH; i++) EnvironmentHashTable[i] = NULL; } /*********************************************/ /* AddHashedEnvironment: Adds an environment */ /* entry to the environment hash table. */ /*********************************************/ static void AddHashedEnvironment( struct environmentData *theEnvironment) { struct environmentData *temp; unsigned long hashValue; if (EnvironmentHashTable == NULL) { InitializeEnvironmentHashTable(); } hashValue = theEnvironment->environmentIndex % SIZE_ENVIRONMENT_HASH; temp = EnvironmentHashTable[hashValue]; EnvironmentHashTable[hashValue] = theEnvironment; theEnvironment->next = temp; } /***************************************************/ /* RemoveHashedEnvironment: Removes an environment */ /* entry from the environment hash table. */ /***************************************************/ static intBool RemoveHashedEnvironment( struct environmentData *theEnvironment) { unsigned long hashValue; struct environmentData *hptr, *prev; hashValue = theEnvironment->environmentIndex % SIZE_ENVIRONMENT_HASH; for (hptr = EnvironmentHashTable[hashValue], prev = NULL; hptr != NULL; hptr = hptr->next) { if (hptr == theEnvironment) { if (prev == NULL) { EnvironmentHashTable[hashValue] = hptr->next; return(TRUE); } else { prev->next = hptr->next; return(TRUE); } } prev = hptr; } return(FALSE); } /**********************************************************/ /* FindEnvironment: Determines if a specified environment */ /* index has an entry in the environment hash table. */ /**********************************************************/ static struct environmentData *FindEnvironment( unsigned long environmentIndex) { struct environmentData *theEnvironment; unsigned long hashValue; hashValue = environmentIndex % SIZE_ENVIRONMENT_HASH; for (theEnvironment = EnvironmentHashTable[hashValue]; theEnvironment != NULL; theEnvironment = theEnvironment->next) { if (theEnvironment->environmentIndex == environmentIndex) { return(theEnvironment); } } return(NULL); } #endif /************************************************************/ /* CreateEnvironment: Creates an environment data structure */ /* and initializes its content to zero/null. */ /************************************************************/ globle void *CreateEnvironment() { return CreateEnvironmentDriver(NULL,NULL,NULL,NULL); } /**********************************************************/ /* CreateRuntimeEnvironment: Creates an environment data */ /* structure and initializes its content to zero/null. */ /**********************************************************/ globle void *CreateRuntimeEnvironment( struct symbolHashNode **symbolTable, struct floatHashNode **floatTable, struct integerHashNode **integerTable, struct bitMapHashNode **bitmapTable) { return CreateEnvironmentDriver(symbolTable,floatTable,integerTable,bitmapTable); } /*********************************************************/ /* CreateEnvironmentDriver: Creates an environment data */ /* structure and initializes its content to zero/null. */ /*********************************************************/ globle void *CreateEnvironmentDriver( struct symbolHashNode **symbolTable, struct floatHashNode **floatTable, struct integerHashNode **integerTable, struct bitMapHashNode **bitmapTable) { struct environmentData *theEnvironment; void *theData; theEnvironment = (struct environmentData *) malloc(sizeof(struct environmentData)); if (theEnvironment == NULL) { printf("\n[ENVRNMNT5] Unable to create new environment.\n"); return(NULL); } theData = malloc(sizeof(void *) * MAXIMUM_ENVIRONMENT_POSITIONS); if (theData == NULL) { free(theEnvironment); printf("\n[ENVRNMNT6] Unable to create environment data.\n"); return(NULL); } memset(theData,0,sizeof(void *) * MAXIMUM_ENVIRONMENT_POSITIONS); theEnvironment->initialized = FALSE; theEnvironment->theData = (void **) theData; theEnvironment->next = NULL; theEnvironment->listOfCleanupEnvironmentFunctions = NULL; #if ALLOW_ENVIRONMENT_GLOBALS theEnvironment->environmentIndex = NextEnvironmentIndex++; #else theEnvironment->environmentIndex = 0; #endif theEnvironment->context = NULL; theEnvironment->routerContext = NULL; /*=============================================*/ /* Allocate storage for the cleanup functions. */ /*=============================================*/ theData = malloc(sizeof(void (*)(struct environmentData *)) * MAXIMUM_ENVIRONMENT_POSITIONS); if (theData == NULL) { free(theEnvironment->theData); free(theEnvironment); printf("\n[ENVRNMNT7] Unable to create environment data.\n"); return(NULL); } memset(theData,0,sizeof(void (*)(struct environmentData *)) * MAXIMUM_ENVIRONMENT_POSITIONS); theEnvironment->cleanupFunctions = (void (**)(void *))theData; #if ALLOW_ENVIRONMENT_GLOBALS AddHashedEnvironment(theEnvironment); CurrentEnvironment = theEnvironment; #endif EnvInitializeEnvironment(theEnvironment,symbolTable,floatTable,integerTable,bitmapTable); return(theEnvironment); } #if ALLOW_ENVIRONMENT_GLOBALS /*******************************************/ /* SetCurrentEnvironment: Sets the current */ /* environment to the one specified. */ /*******************************************/ globle void SetCurrentEnvironment( void *theEnvironment) { CurrentEnvironment = (struct environmentData *) theEnvironment; } /**************************************************/ /* SetCurrentEnvironmentByIndex: Sets the current */ /* environment to the one having the specified */ /* environment index. */ /**************************************************/ globle intBool SetCurrentEnvironmentByIndex( unsigned long environmentIndex) { struct environmentData *theEnvironment; theEnvironment = FindEnvironment(environmentIndex); if (theEnvironment == NULL) { return(FALSE); } SetCurrentEnvironment(theEnvironment); return(TRUE); } /**************************************************/ /* GetEnvironmentByIndex: Returns the environment */ /* having the specified environment index. */ /**************************************************/ globle void *GetEnvironmentByIndex( unsigned long environmentIndex) { struct environmentData *theEnvironment; theEnvironment = FindEnvironment(environmentIndex); return(theEnvironment); } /********************************************/ /* GetCurrentEnvironment: Returns a pointer */ /* to the current environment. */ /********************************************/ globle void *GetCurrentEnvironment() { return(CurrentEnvironment); } /******************************************/ /* GetEnvironmentIndex: Returns the index */ /* of the specified environment. */ /******************************************/ globle unsigned long GetEnvironmentIndex( void *theEnvironment) { return(((struct environmentData *) theEnvironment)->environmentIndex); } #endif /**********************************************/ /* GetEnvironmentContext: Returns the context */ /* of the specified environment. */ /**********************************************/ globle void *GetEnvironmentContext( void *theEnvironment) { return(((struct environmentData *) theEnvironment)->context); } /*******************************************/ /* SetEnvironmentContext: Sets the context */ /* of the specified environment. */ /*******************************************/ globle void *SetEnvironmentContext( void *theEnvironment, void *theContext) { void *oldContext; oldContext = ((struct environmentData *) theEnvironment)->context; ((struct environmentData *) theEnvironment)->context = theContext; return oldContext; } /***************************************************/ /* GetEnvironmentRouterContext: Returns the router */ /* context of the specified environment. */ /***************************************************/ globle void *GetEnvironmentRouterContext( void *theEnvironment) { return(((struct environmentData *) theEnvironment)->routerContext); } /************************************************/ /* SetEnvironmentRouterContext: Sets the router */ /* context of the specified environment. */ /************************************************/ globle void *SetEnvironmentRouterContext( void *theEnvironment, void *theRouterContext) { void *oldRouterContext; oldRouterContext = ((struct environmentData *) theEnvironment)->routerContext; ((struct environmentData *) theEnvironment)->routerContext = theRouterContext; return oldRouterContext; } /**********************************************/ /* DestroyEnvironment: Destroys the specified */ /* environment returning all of its memory. */ /**********************************************/ globle intBool DestroyEnvironment( void *vtheEnvironment) { struct environmentCleanupFunction *cleanupPtr; int i; struct memoryData *theMemData; intBool rv = TRUE; struct environmentData *theEnvironment = (struct environmentData *) vtheEnvironment; if (EvaluationData(theEnvironment)->CurrentExpression != NULL) { return(FALSE); } #if DEFRULE_CONSTRUCT if (EngineData(theEnvironment)->ExecutingRule != NULL) { return(FALSE); } #endif theMemData = MemoryData(theEnvironment); EnvReleaseMem(theEnvironment,-1,FALSE); for (i = 0; i < MAXIMUM_ENVIRONMENT_POSITIONS; i++) { if (theEnvironment->cleanupFunctions[i] != NULL) { (*theEnvironment->cleanupFunctions[i])(theEnvironment); } } free(theEnvironment->cleanupFunctions); for (cleanupPtr = theEnvironment->listOfCleanupEnvironmentFunctions; cleanupPtr != NULL; cleanupPtr = cleanupPtr->next) { (*cleanupPtr->func)(theEnvironment); } RemoveEnvironmentCleanupFunctions(theEnvironment); EnvReleaseMem(theEnvironment,-1,FALSE); #if ALLOW_ENVIRONMENT_GLOBALS RemoveHashedEnvironment(theEnvironment); #endif if ((theMemData->MemoryAmount != 0) || (theMemData->MemoryCalls != 0)) { printf("\n[ENVRNMNT8] Environment data not fully deallocated.\n"); rv = FALSE; } free(theMemData->MemoryTable); #if BLOCK_MEMORY ReturnAllBlocks(theEnvironment); #endif for (i = 0; i < MAXIMUM_ENVIRONMENT_POSITIONS; i++) { if (theEnvironment->theData[i] != NULL) { free(theEnvironment->theData[i]); theEnvironment->theData[i] = NULL; } } free(theEnvironment->theData); #if ALLOW_ENVIRONMENT_GLOBALS if (CurrentEnvironment == theEnvironment) { CurrentEnvironment = NULL; } #endif free(theEnvironment); return(rv); } /**************************************************/ /* AddEnvironmentCleanupFunction: Adds a function */ /* to the ListOfCleanupEnvironmentFunctions. */ /**************************************************/ globle intBool AddEnvironmentCleanupFunction( void *vtheEnv, char *name, void (*functionPtr)(void *), int priority) { struct environmentCleanupFunction *newPtr, *currentPtr, *lastPtr = NULL; struct environmentData *theEnv = (struct environmentData *) vtheEnv; newPtr = (struct environmentCleanupFunction *) malloc(sizeof(struct environmentCleanupFunction)); if (newPtr == NULL) { return(FALSE); } newPtr->name = name; newPtr->func = functionPtr; newPtr->priority = priority; if (theEnv->listOfCleanupEnvironmentFunctions == NULL) { newPtr->next = NULL; theEnv->listOfCleanupEnvironmentFunctions = newPtr; return(TRUE); } currentPtr = theEnv->listOfCleanupEnvironmentFunctions; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = theEnv->listOfCleanupEnvironmentFunctions; theEnv->listOfCleanupEnvironmentFunctions = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(TRUE); } /**************************************************/ /* RemoveEnvironmentCleanupFunctions: Removes the */ /* list of environment cleanup functions. */ /**************************************************/ static void RemoveEnvironmentCleanupFunctions( struct environmentData *theEnv) { struct environmentCleanupFunction *nextPtr; while (theEnv->listOfCleanupEnvironmentFunctions != NULL) { nextPtr = theEnv->listOfCleanupEnvironmentFunctions->next; free(theEnv->listOfCleanupEnvironmentFunctions); theEnv->listOfCleanupEnvironmentFunctions = nextPtr; } } clips-6.24/clipssrc/._symblcmp.c0000400000175000017500000000075410441602332014725 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zTTFL04FMPSRMWBBLclips-6.24/clipssrc/._objrtbld.h0000400000175000017500000000061410441073150014701 0ustar jfsjfsMac OS X  2 R:TEXT????22S02MWBB clips-6.24/clipssrc/._crstrtgy.c0000400000175000017500000000075410441065231014761 0ustar jfsjfsMac OS X  2 RTEXT???? aTTFH MonacoCC ''6%TTFSlIFMPSRMWBBLclips-6.24/clipssrc/._genrcbin.h0000400000175000017500000000012207422634603014673 0ustar jfsjfsMac OS X  2 RTEXT????`clips-6.24/clipssrc/rulecom.c0000755000175000017500000003527010441150752014352 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* RULE COMMANDS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides the matches command. Also provides the */ /* the developer commands show-joins and rule-complexity. */ /* Also provides the initialization routine which */ /* registers rule commands found in other modules. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES */ /* INCREMENTAL_RESET, and LOGICAL_DEPENDENCIES */ /* compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #define _RULECOM_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "argacces.h" #include "constant.h" #include "constrct.h" #include "crstrtgy.h" #include "engine.h" #include "envrnmnt.h" #include "evaluatn.h" #include "extnfunc.h" #include "incrrset.h" #include "lgcldpnd.h" #include "memalloc.h" #include "pattern.h" #include "reteutil.h" #include "router.h" #include "ruledlt.h" #include "watch.h" #if BLOAD || BLOAD_AND_BSAVE || BLOAD_ONLY #include "rulebin.h" #endif #include "rulecom.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if DEVELOPER static void ShowJoins(void *,void *); #endif /****************************************************************/ /* DefruleCommands: Initializes defrule commands and functions. */ /****************************************************************/ globle void DefruleCommands( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"run",'v', PTIEF RunCommand,"RunCommand", "*1i"); EnvDefineFunction2(theEnv,"halt",'v', PTIEF HaltCommand,"HaltCommand","00"); EnvDefineFunction2(theEnv,"focus",'b', PTIEF FocusCommand,"FocusCommand", "1*w"); EnvDefineFunction2(theEnv,"clear-focus-stack",'v',PTIEF ClearFocusStackCommand, "ClearFocusStackCommand","00"); EnvDefineFunction2(theEnv,"get-focus-stack",'m',PTIEF GetFocusStackFunction, "GetFocusStackFunction","00"); EnvDefineFunction2(theEnv,"pop-focus",'w',PTIEF PopFocusFunction, "PopFocusFunction","00"); EnvDefineFunction2(theEnv,"get-focus",'w',PTIEF GetFocusFunction, "GetFocusFunction","00"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"set-break",'v', PTIEF SetBreakCommand, "SetBreakCommand","11w"); EnvDefineFunction2(theEnv,"remove-break",'v', PTIEF RemoveBreakCommand, "RemoveBreakCommand", "*1w"); EnvDefineFunction2(theEnv,"show-breaks",'v', PTIEF ShowBreaksCommand, "ShowBreaksCommand", "01w"); EnvDefineFunction2(theEnv,"matches",'v',PTIEF MatchesCommand,"MatchesCommand","11w"); EnvDefineFunction2(theEnv,"list-focus-stack",'v', PTIEF ListFocusStackCommand, "ListFocusStackCommand", "00"); EnvDefineFunction2(theEnv,"dependencies", 'v', PTIEF DependenciesCommand, "DependenciesCommand", "11h"); EnvDefineFunction2(theEnv,"dependents", 'v', PTIEF DependentsCommand, "DependentsCommand", "11h"); #endif /* DEBUGGING_FUNCTIONS */ EnvDefineFunction2(theEnv,"get-incremental-reset",'b', GetIncrementalResetCommand,"GetIncrementalResetCommand","00"); EnvDefineFunction2(theEnv,"set-incremental-reset",'b', SetIncrementalResetCommand,"SetIncrementalResetCommand","11"); EnvDefineFunction2(theEnv,"get-strategy", 'w', PTIEF GetStrategyCommand, "GetStrategyCommand", "00"); EnvDefineFunction2(theEnv,"set-strategy", 'w', PTIEF SetStrategyCommand, "SetStrategyCommand", "11w"); #if DEVELOPER && (! BLOAD_ONLY) EnvDefineFunction2(theEnv,"rule-complexity",'l', PTIEF RuleComplexityCommand,"RuleComplexityCommand", "11w"); EnvDefineFunction2(theEnv,"show-joins", 'v', PTIEF ShowJoinsCommand, "ShowJoinsCommand", "11w"); #if DEBUGGING_FUNCTIONS //AddWatchItem(theEnv,"rule-analysis",0,&DefruleData(theEnv)->WatchRuleAnalysis,0,NULL,NULL); #endif #endif /* DEVELOPER && (! BLOAD_ONLY) */ #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif /* ! RUN_TIME */ } #if DEBUGGING_FUNCTIONS /****************************************/ /* MatchesCommand: H/L access routine */ /* for the matches command. */ /****************************************/ globle void MatchesCommand( void *theEnv) { char *ruleName; void *rulePtr; ruleName = GetConstructName(theEnv,"matches","rule name"); if (ruleName == NULL) return; rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } EnvMatches(theEnv,rulePtr); } /********************************/ /* EnvMatches: C access routine */ /* for the matches command. */ /********************************/ globle intBool EnvMatches( void *theEnv, void *theRule) { struct defrule *rulePtr, *tmpPtr; struct partialMatch *listOfMatches, **theStorage; struct joinNode *theJoin, *lastJoin; int i, depth; ACTIVATION *agendaPtr; int flag; int matchesDisplayed; /*=================================================*/ /* Loop through each of the disjuncts for the rule */ /*=================================================*/ for (rulePtr = (struct defrule *) theRule, tmpPtr = rulePtr; rulePtr != NULL; rulePtr = rulePtr->disjunct) { /*======================================*/ /* Determine the last join in the rule. */ /*======================================*/ lastJoin = rulePtr->lastJoin; /*===================================*/ /* Determine the number of patterns. */ /*===================================*/ depth = GetPatternNumberFromJoin(lastJoin); /*=========================================*/ /* Store the alpha memory partial matches. */ /*=========================================*/ theStorage = (struct partialMatch **) genalloc(theEnv,(unsigned) (depth * sizeof(struct partialMatch))); theJoin = lastJoin; i = depth - 1; while (theJoin != NULL) { if (theJoin->joinFromTheRight) { theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; } else { theStorage[i] = ((struct patternNodeHeader *) theJoin->rightSideEntryStructure)->alphaMemory; i--; theJoin = theJoin->lastLevel; } } /*========================================*/ /* List the alpha memory partial matches. */ /*========================================*/ for (i = 0; i < depth; i++) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); return(TRUE); } EnvPrintRouter(theEnv,WDISPLAY,"Matches for Pattern "); PrintLongInteger(theEnv,WDISPLAY,(long int) i + 1); EnvPrintRouter(theEnv,WDISPLAY,"\n"); listOfMatches = theStorage[i]; if (listOfMatches == NULL) EnvPrintRouter(theEnv,WDISPLAY," None\n"); while (listOfMatches != NULL) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); return(TRUE); } PrintPartialMatch(theEnv,WDISPLAY,listOfMatches); EnvPrintRouter(theEnv,WDISPLAY,"\n"); listOfMatches = listOfMatches->next; } } genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); /*========================================*/ /* Store the beta memory partial matches. */ /*========================================*/ depth = lastJoin->depth; theStorage = (struct partialMatch **) genalloc(theEnv,(unsigned) (depth * sizeof(struct partialMatch))); theJoin = lastJoin; for (i = depth - 1; i >= 0; i--) { theStorage[i] = theJoin->beta; theJoin = theJoin->lastLevel; } /*=======================================*/ /* List the beta memory partial matches. */ /*=======================================*/ for (i = 1; i < depth; i++) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); return(TRUE); } matchesDisplayed = 0; EnvPrintRouter(theEnv,WDISPLAY,"Partial matches for CEs 1 - "); PrintLongInteger(theEnv,WDISPLAY,(long int) i + 1); EnvPrintRouter(theEnv,WDISPLAY,"\n"); listOfMatches = theStorage[i]; while (listOfMatches != NULL) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); return(TRUE); } if (listOfMatches->counterf == FALSE) { matchesDisplayed++; PrintPartialMatch(theEnv,WDISPLAY,listOfMatches); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } listOfMatches = listOfMatches->next; } if (matchesDisplayed == 0) { EnvPrintRouter(theEnv,WDISPLAY," None\n"); } } genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); } /*===================*/ /* List activations. */ /*===================*/ rulePtr = tmpPtr; EnvPrintRouter(theEnv,WDISPLAY,"Activations\n"); flag = 1; for (agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,NULL); agendaPtr != NULL; agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,agendaPtr)) { if (GetHaltExecution(theEnv) == TRUE) return(TRUE); if (((struct activation *) agendaPtr)->theRule->header.name == rulePtr->header.name) { flag = 0; PrintPartialMatch(theEnv,WDISPLAY,GetActivationBasis(agendaPtr)); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } if (flag) EnvPrintRouter(theEnv,WDISPLAY," None\n"); return(TRUE); } #endif /* DEBUGGING_FUNCTIONS */ #if DEVELOPER /***********************************************/ /* RuleComplexityCommand: H/L access routine */ /* for the rule-complexity function. */ /***********************************************/ globle long RuleComplexityCommand( void *theEnv) { char *ruleName; struct defrule *rulePtr; ruleName = GetConstructName(theEnv,"rule-complexity","rule name"); if (ruleName == NULL) return(-1); rulePtr = (struct defrule *) EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return(-1); } return(rulePtr->complexity); } /******************************************/ /* ShowJoinsCommand: H/L access routine */ /* for the show-joins command. */ /******************************************/ globle void ShowJoinsCommand( void *theEnv) { char *ruleName; void *rulePtr; ruleName = GetConstructName(theEnv,"show-joins","rule name"); if (ruleName == NULL) return; rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } ShowJoins(theEnv,rulePtr); return; } /*********************************/ /* ShowJoins: C access routine */ /* for the show-joins command. */ /*********************************/ static void ShowJoins( void *theEnv, void *theRule) { struct defrule *rulePtr; struct joinNode *theJoin; struct joinNode *joinList[MAXIMUM_NUMBER_OF_PATTERNS]; int numberOfJoins; rulePtr = (struct defrule *) theRule; /*=================================================*/ /* Loop through each of the disjuncts for the rule */ /*=================================================*/ while (rulePtr != NULL) { /*=====================================*/ /* Determine the number of join nodes. */ /*=====================================*/ numberOfJoins = -1; theJoin = rulePtr->lastJoin; while (theJoin != NULL) { if (theJoin->joinFromTheRight) { theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; } else { numberOfJoins++; joinList[numberOfJoins] = theJoin; theJoin = theJoin->lastLevel; } } /*====================*/ /* Display the joins. */ /*====================*/ while (numberOfJoins >= 0) { char buffer[20]; sprintf(buffer,"%2d%c%c: ",(int) joinList[numberOfJoins]->depth, (joinList[numberOfJoins]->patternIsNegated) ? 'n' : ' ', (joinList[numberOfJoins]->logicalJoin) ? 'l' : ' '); EnvPrintRouter(theEnv,WDISPLAY,buffer); PrintExpression(theEnv,WDISPLAY,joinList[numberOfJoins]->networkTest); EnvPrintRouter(theEnv,WDISPLAY,"\n"); numberOfJoins--; }; /*===============================*/ /* Proceed to the next disjunct. */ /*===============================*/ rulePtr = rulePtr->disjunct; if (rulePtr != NULL) EnvPrintRouter(theEnv,WDISPLAY,"\n"); } } #endif /* DEVELOPER */ #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/insquery.c0000755000175000017500000012630510441147617014571 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Query Functions for Objects */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if INSTANCE_SET_QUERIES #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "envrnmnt.h" #include "memalloc.h" #include "exprnpsr.h" #include "insfun.h" #include "insmngr.h" #include "insqypsr.h" #include "prcdrfun.h" #include "router.h" #include "utility.h" #define _INSQUERY_SOURCE_ #include "insquery.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void PushQueryCore(void *); static void PopQueryCore(void *); static QUERY_CORE *FindQueryCore(void *,int); static QUERY_CLASS *DetermineQueryClasses(void *,EXPRESSION *,char *,unsigned *); static QUERY_CLASS *FormChain(void *,char *,DATA_OBJECT *); static void DeleteQueryClasses(void *,QUERY_CLASS *); static int TestForFirstInChain(void *,QUERY_CLASS *,int); static int TestForFirstInstanceInClass(void *,struct defmodule *,int,DEFCLASS *,QUERY_CLASS *,int); static void TestEntireChain(void *,QUERY_CLASS *,int); static void TestEntireClass(void *,struct defmodule *,int,DEFCLASS *,QUERY_CLASS *,int); static void AddSolution(void *); static void PopQuerySoln(void *); /**************************************************** NAME : SetupQuery DESCRIPTION : Initializes instance query H/L functions and parsers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Sets up kernel functions and parsers NOTES : None ****************************************************/ globle void SetupQuery( void *theEnv) { AllocateEnvironmentData(theEnv,INSTANCE_QUERY_DATA,sizeof(struct instanceQueryData),NULL); #if ! RUN_TIME InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,QUERY_DELIMETER_STRING); IncrementSymbolCount(InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); EnvDefineFunction2(theEnv,"(query-instance)",'o', PTIEF GetQueryInstance,"GetQueryInstance",NULL); EnvDefineFunction2(theEnv,"(query-instance-slot)",'u', PTIEF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL); EnvDefineFunction2(theEnv,"any-instancep",'b',PTIEF AnyInstances,"AnyInstances",NULL); AddFunctionParser(theEnv,"any-instancep",ParseQueryNoAction); EnvDefineFunction2(theEnv,"find-instance",'m', PTIEF QueryFindInstance,"QueryFindInstance",NULL); AddFunctionParser(theEnv,"find-instance",ParseQueryNoAction); EnvDefineFunction2(theEnv,"find-all-instances",'m', PTIEF QueryFindAllInstances,"QueryFindAllInstances",NULL); AddFunctionParser(theEnv,"find-all-instances",ParseQueryNoAction); EnvDefineFunction2(theEnv,"do-for-instance",'u', PTIEF QueryDoForInstance,"QueryDoForInstance",NULL); AddFunctionParser(theEnv,"do-for-instance",ParseQueryAction); EnvDefineFunction2(theEnv,"do-for-all-instances",'u', PTIEF QueryDoForAllInstances,"QueryDoForAllInstances",NULL); AddFunctionParser(theEnv,"do-for-all-instances",ParseQueryAction); EnvDefineFunction2(theEnv,"delayed-do-for-all-instances",'u', PTIEF DelayedQueryDoForAllInstances, "DelayedQueryDoForAllInstances",NULL); AddFunctionParser(theEnv,"delayed-do-for-all-instances",ParseQueryAction); #endif } /************************************************************* NAME : GetQueryInstance DESCRIPTION : Internal function for referring to instance array on instance-queries INPUTS : None RETURNS : The name of the specified instance-set member SIDE EFFECTS : None NOTES : H/L Syntax : ((query-instance) ) *************************************************************/ globle void *GetQueryInstance( void *theEnv) { register QUERY_CORE *core; core = FindQueryCore(theEnv,DOPToInteger(GetFirstArgument())); return(GetFullInstanceName(theEnv,core->solns[DOPToInteger(GetFirstArgument()->nextArg)])); } /*************************************************************************** NAME : GetQueryInstanceSlot DESCRIPTION : Internal function for referring to slots of instances in instance array on instance-queries INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set appropriately NOTES : H/L Syntax : ((query-instance-slot) ) **************************************************************************/ globle void GetQueryInstanceSlot( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; DATA_OBJECT temp; QUERY_CORE *core; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); core = FindQueryCore(theEnv,DOPToInteger(GetFirstArgument())); ins = core->solns[DOPToInteger(GetFirstArgument()->nextArg)]; EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"get",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"instance-set query"); return; } result->type = (unsigned short) sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetInstanceSlotLength(sp)); } } /* ============================================================================= ============================================================================= Following are the instance query functions : any-instancep : Determines if any instances satisfy the query find-instance : Finds first (set of) instance(s) which satisfies the query and stores it in a multi-field find-all-instances : Finds all (sets of) instances which satisfy the the query and stores them in a multi-field do-for-instance : Executes a given action for the first (set of) instance(s) which satisfy the query do-for-all-instances : Executes an action for all instances which satisfy the query as they are found delayed-do-for-all-instances : Same as above - except that the list of instances which satisfy the query is formed before any actions are executed Instance candidate search algorithm : All permutations of first restriction class instances with other restriction class instances (Rightmost are varied first) All permutations of first restriction class's subclasses' instances with other restriction class instances. And so on... For any one class, instances are examined in the order they were defined Example : (defclass a (is-a standard-user)) (defclass b (is-a standard-user)) (defclass c (is-a standard-user)) (defclass d (is-a a b)) (make-instance a1 of a) (make-instance a2 of a) (make-instance b1 of b) (make-instance b2 of b) (make-instance c1 of c) (make-instance c2 of c) (make-instance d1 of d) (make-instance d2 of d) (any-instancep ((?a a b) (?b c)) ) The permutations (?a ?b) would be examined in the following order : (a1 c1),(a1 c2),(a2 c1),(a2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2), (b1 c1),(b1 c2),(b2 c1),(b2 c2),(d1 c1),(d1 c2),(d2 c1),(d2 c2) Notice the duplication because d is a subclass of both and a and b. ============================================================================= ============================================================================= */ /****************************************************************************** NAME : AnyInstances DESCRIPTION : Determines if there any existing instances which satisfy the query INPUTS : None RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to TRUE - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle intBool AnyInstances( void *theEnv) { QUERY_CLASS *qclasses; unsigned rcnt; int TestResult; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "any-instancep",&rcnt); if (qclasses == NULL) return(FALSE); PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); TestResult = TestForFirstInChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); return(TestResult); } /****************************************************************************** NAME : QueryFindInstance DESCRIPTION : Finds the first set of instances which satisfy the query and stores their names in the user's multi-field variable INPUTS : Caller's result buffer RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to TRUE - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindInstance( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt,i; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "find-instance",&rcnt); if (qclasses == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); if (TestForFirstInChain(theEnv,qclasses,0) == TRUE) { result->value = (void *) EnvCreateMultifield(theEnv,rcnt); SetpDOEnd(result,rcnt); for (i = 1 ; i <= rcnt ; i++) { SetMFType(result->value,i,INSTANCE_NAME); SetMFValue(result->value,i,GetFullInstanceName(theEnv,InstanceQueryData(theEnv)->QueryCore->solns[i - 1])); } } else result->value = (void *) EnvCreateMultifield(theEnv,0L); InstanceQueryData(theEnv)->AbortQuery = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryFindAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and stores their names in the user's multi-field variable The sets are stored sequentially : Number of sets = (Multi-field length) / (Set length) The first set is if the first (set length) atoms of the multi-field variable, and so on. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindAllInstances( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; register unsigned i,j; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg, "find-all-instances",&rcnt); if (qclasses == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); return; } PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = NULL; InstanceQueryData(theEnv)->QueryCore->soln_set = NULL; InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt; InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = FALSE; result->value = (void *) EnvCreateMultifield(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_cnt * rcnt); while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 , j = (unsigned) (result->end + 2) ; i < rcnt ; i++ , j++) { SetMFType(result->value,j,INSTANCE_NAME); SetMFValue(result->value,j,GetFullInstanceName(theEnv,InstanceQueryData(theEnv)->QueryCore->soln_set->soln[i])); } result->end = (long) j-2; PopQuerySoln(theEnv); } rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryDoForInstance DESCRIPTION : Finds the first set of instances which satisfy the query and executes a user-action with that set INPUTS : None RETURNS : Caller's result buffer SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to TRUE - if at all). Also the action expression is executed zero or once. Caller's result buffer holds result of user-action NOTES : H/L Syntax : See ParseQueryAction() ******************************************************************************/ globle void QueryDoForInstance( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-instance",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; if (TestForFirstInChain(theEnv,qclasses,0) == TRUE) EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,result); InstanceQueryData(theEnv)->AbortQuery = FALSE; ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : QueryDoForAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and executes a user-function for each set as it is found INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. Also, the action is executed for every instance set. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See ParseQueryAction() ******************************************************************************/ globle void QueryDoForAllInstances( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "do-for-all-instances",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; InstanceQueryData(theEnv)->QueryCore->result = result; ValueInstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result); TestEntireChain(theEnv,qclasses,0); ValueDeinstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result); PropagateReturnValue(theEnv,InstanceQueryData(theEnv)->QueryCore->result); InstanceQueryData(theEnv)->AbortQuery = FALSE; ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /****************************************************************************** NAME : DelayedQueryDoForAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and and exceutes a user-action for each set This function differs from QueryDoForAllInstances() in that it forms the complete list of query satisfactions BEFORE executing any actions. INPUTS : Caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated once for every instance set. The action is executed for evry query satisfaction. Caller's result buffer holds result of last action executed. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void DelayedQueryDoForAllInstances( void *theEnv, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; register unsigned i; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg, "delayed-do-for-all-instances",&rcnt); if (qclasses == NULL) return; PushQueryCore(theEnv); InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core); InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt)); InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument(); InstanceQueryData(theEnv)->QueryCore->action = NULL; InstanceQueryData(theEnv)->QueryCore->soln_set = NULL; InstanceQueryData(theEnv)->QueryCore->soln_size = rcnt; InstanceQueryData(theEnv)->QueryCore->soln_cnt = 0; TestEntireChain(theEnv,qclasses,0); InstanceQueryData(theEnv)->AbortQuery = FALSE; InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg; while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 ; i < rcnt ; i++) InstanceQueryData(theEnv)->QueryCore->solns[i] = InstanceQueryData(theEnv)->QueryCore->soln_set->soln[i]; PopQuerySoln(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,result); EvaluationData(theEnv)->CurrentEvaluationDepth--; if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { PropagateReturnValue(theEnv,result); } PeriodicCleanup(theEnv,FALSE,TRUE); if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { while (InstanceQueryData(theEnv)->QueryCore->soln_set != NULL) PopQuerySoln(theEnv); break; } } ProcedureFunctionData(theEnv)->BreakFlag = FALSE; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt)); rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore); PopQueryCore(theEnv); DeleteQueryClasses(theEnv,qclasses); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /******************************************************* NAME : PushQueryCore DESCRIPTION : Pushes the current QueryCore onto stack INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Allocates new stack node and changes QueryCoreStack NOTES : None *******************************************************/ static void PushQueryCore( void *theEnv) { QUERY_STACK *qptr; qptr = get_struct(theEnv,query_stack); qptr->core = InstanceQueryData(theEnv)->QueryCore; qptr->nxt = InstanceQueryData(theEnv)->QueryCoreStack; InstanceQueryData(theEnv)->QueryCoreStack = qptr; } /****************************************************** NAME : PopQueryCore DESCRIPTION : Pops top of QueryCore stack and restores QueryCore to this core INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Stack node deallocated, QueryCoreStack changed and QueryCore reset NOTES : Assumes stack is not empty ******************************************************/ static void PopQueryCore( void *theEnv) { QUERY_STACK *qptr; InstanceQueryData(theEnv)->QueryCore = InstanceQueryData(theEnv)->QueryCoreStack->core; qptr = InstanceQueryData(theEnv)->QueryCoreStack; InstanceQueryData(theEnv)->QueryCoreStack = InstanceQueryData(theEnv)->QueryCoreStack->nxt; rtn_struct(theEnv,query_stack,qptr); } /*************************************************** NAME : FindQueryCore DESCRIPTION : Looks up a QueryCore Stack Frame Depth 0 is current frame 1 is next deepest, etc. INPUTS : Depth RETURNS : Address of query core stack frame SIDE EFFECTS : None NOTES : None ***************************************************/ static QUERY_CORE *FindQueryCore( void *theEnv, int depth) { QUERY_STACK *qptr; if (depth == 0) return(InstanceQueryData(theEnv)->QueryCore); qptr = InstanceQueryData(theEnv)->QueryCoreStack; while (depth > 1) { qptr = qptr->nxt; depth--; } return(qptr->core); } /********************************************************** NAME : DetermineQueryClasses DESCRIPTION : Builds a list of classes to be used in instance queries - uses parse form. INPUTS : 1) The parse class expression chain 2) The name of the function being executed 3) Caller's buffer for restriction count (# of separate lists) RETURNS : The query list, or NULL on errors SIDE EFFECTS : Memory allocated for list Busy count incremented for all classes NOTES : Each restriction is linked by nxt pointer, multiple classes in a restriction are linked by the chain pointer. Rcnt caller's buffer is set to reflect the total number of chains Assumes classExp is not NULL and that each restriction chain is terminated with the QUERY_DELIMITER_SYMBOL "(QDS)" **********************************************************/ static QUERY_CLASS *DetermineQueryClasses( void *theEnv, EXPRESSION *classExp, char *func, unsigned *rcnt) { QUERY_CLASS *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp; int new_list = FALSE; DATA_OBJECT temp; *rcnt = 0; while (classExp != NULL) { if (EvaluateExpression(theEnv,classExp,&temp)) { DeleteQueryClasses(theEnv,clist); return(NULL); } if ((temp.type == SYMBOL) && (temp.value == (void *) InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL)) { new_list = TRUE; (*rcnt)++; } else if ((tmp = FormChain(theEnv,func,&temp)) != NULL) { if (clist == NULL) clist = cnxt = cchain = tmp; else if (new_list == TRUE) { new_list = FALSE; cnxt->nxt = tmp; cnxt = cchain = tmp; } else cchain->chain = tmp; while (cchain->chain != NULL) cchain = cchain->chain; } else { SyntaxErrorMessage(theEnv,"instance-set query class restrictions"); DeleteQueryClasses(theEnv,clist); SetEvaluationError(theEnv,TRUE); return(NULL); } classExp = classExp->nextArg; } return(clist); } /************************************************************* NAME : FormChain DESCRIPTION : Builds a list of classes to be used in instance 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 classes RETURNS : The query chain, or NULL on errors SIDE EFFECTS : Memory allocated for chain Busy count incremented for all classes NOTES : None *************************************************************/ static QUERY_CLASS *FormChain( void *theEnv, char *func, DATA_OBJECT *val) { DEFCLASS *cls; QUERY_CLASS *head,*bot,*tmp; register long i,end; /* 6.04 Bug Fix */ char *className; struct defmodule *currentModule; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (val->type == DEFCLASS_PTR) { IncrementDefclassBusyCount(theEnv,(void *) val->value); head = get_struct(theEnv,query_class); head->cls = (DEFCLASS *) val->value; if (DefclassInScope(theEnv,head->cls,currentModule)) head->theModule = currentModule; else head->theModule = head->cls->header.whichModule->theModule; 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 =============================================== */ cls = LookupDefclassByMdlOrScope(theEnv,DOPToString(val)); if (cls == NULL) { ClassExistError(theEnv,func,DOPToString(val)); return(NULL); } IncrementDefclassBusyCount(theEnv,(void *) cls); head = get_struct(theEnv,query_class); head->cls = cls; if (DefclassInScope(theEnv,head->cls,currentModule)) head->theModule = currentModule; else head->theModule = head->cls->header.whichModule->theModule; 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) { className = ValueToString(GetMFValue(val->value,i)); cls = LookupDefclassByMdlOrScope(theEnv,className); if (cls == NULL) { ClassExistError(theEnv,func,className); DeleteQueryClasses(theEnv,head); return(NULL); } } else { DeleteQueryClasses(theEnv,head); return(NULL); } IncrementDefclassBusyCount(theEnv,(void *) cls); tmp = get_struct(theEnv,query_class); tmp->cls = cls; if (DefclassInScope(theEnv,tmp->cls,currentModule)) tmp->theModule = currentModule; else tmp->theModule = tmp->cls->header.whichModule->theModule; tmp->chain = NULL; tmp->nxt = NULL; if (head == NULL) head = tmp; else bot->chain = tmp; bot = tmp; } return(head); } return(NULL); } /****************************************************** NAME : DeleteQueryClasses DESCRIPTION : Deletes a query class-list INPUTS : The query list address RETURNS : Nothing useful SIDE EFFECTS : Nodes deallocated Busy count decremented for all classes NOTES : None ******************************************************/ static void DeleteQueryClasses( void *theEnv, QUERY_CLASS *qlist) { QUERY_CLASS *tmp; while (qlist != NULL) { while (qlist->chain != NULL) { tmp = qlist->chain; qlist->chain = qlist->chain->chain; DecrementDefclassBusyCount(theEnv,(void *) tmp->cls); rtn_struct(theEnv,query_class,tmp); } tmp = qlist; qlist = qlist->nxt; DecrementDefclassBusyCount(theEnv,(void *) tmp->cls); rtn_struct(theEnv,query_class,tmp); } } /************************************************************ NAME : TestForFirstInChain DESCRIPTION : Processes all classes in a restriction chain until success or done INPUTS : 1) The current chain 2) The index of the chain restriction (e.g. the 4th query-variable) RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Sets current restriction class Instance variable values set NOTES : None ************************************************************/ static int TestForFirstInChain( void *theEnv, QUERY_CLASS *qchain, int indx) { QUERY_CLASS *qptr; int id; InstanceQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { InstanceQueryData(theEnv)->AbortQuery = FALSE; if ((id = GetTraversalID(theEnv)) == -1) return(FALSE); if (TestForFirstInstanceInClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx)) { ReleaseTraversalID(theEnv); return(TRUE); } ReleaseTraversalID(theEnv); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return(FALSE); } return(FALSE); } /***************************************************************** NAME : TestForFirstInstanceInClass DESCRIPTION : Processes all instances in a class and then all subclasses of a class until success or done INPUTS : 1) The module for which classes tested must be in scope 2) Visitation traversal id 3) The class 4) The current class restriction chain 5) The index of the current restriction RETURNS : TRUE if query succeeds, FALSE otherwise SIDE EFFECTS : Instance variable values set NOTES : None *****************************************************************/ static int TestForFirstInstanceInClass( void *theEnv, struct defmodule *theModule, int id, DEFCLASS *cls, QUERY_CLASS *qchain, int indx) { register unsigned i; INSTANCE_TYPE *ins; DATA_OBJECT temp; if (TestTraversalID(cls->traversalRecord,id)) return(FALSE); SetTraversalID(cls->traversalRecord,id); if (DefclassInScope(theEnv,cls,theModule) == FALSE) return(FALSE); ins = cls->instanceList; while (ins != NULL) { InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins; if (qchain->nxt != NULL) { ins->busy++; if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE) { ins->busy--; break; } ins->busy--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) break; } else { ins->busy++; EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); ins->busy--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) break; } ins = ins->nxtClass; while ((ins != NULL) ? (ins->garbage == 1) : FALSE) ins = ins->nxtClass; } if (ins != NULL) return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) ? FALSE : TRUE); for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { if (TestForFirstInstanceInClass(theEnv,theModule,id,cls->directSubclasses.classArray[i], qchain,indx)) return(TRUE); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return(FALSE); } return(FALSE); } /************************************************************ NAME : TestEntireChain DESCRIPTION : Processes all classes in a restriction chain until done INPUTS : 1) The current chain 2) The index of the chain restriction (i.e. the 4th query-variable) RETURNS : Nothing useful SIDE EFFECTS : Sets current restriction class Query instance variables set Solution sets stored in global list NOTES : None ************************************************************/ static void TestEntireChain( void *theEnv, QUERY_CLASS *qchain, int indx) { QUERY_CLASS *qptr; int id; InstanceQueryData(theEnv)->AbortQuery = TRUE; for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain) { InstanceQueryData(theEnv)->AbortQuery = FALSE; if ((id = GetTraversalID(theEnv)) == -1) return; TestEntireClass(theEnv,qptr->theModule,id,qptr->cls,qchain,indx); ReleaseTraversalID(theEnv); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return; } } /***************************************************************** NAME : TestEntireClass DESCRIPTION : Processes all instances in a class and then all subclasses of a class until done INPUTS : 1) The module for which classes tested must be in scope 2) Visitation traversal id 3) The class 4) The current class restriction chain 5) The index of the current restriction RETURNS : Nothing useful SIDE EFFECTS : Instance variable values set Solution sets stored in global list NOTES : None *****************************************************************/ static void TestEntireClass( void *theEnv, struct defmodule *theModule, int id, DEFCLASS *cls, QUERY_CLASS *qchain, int indx) { register unsigned i; INSTANCE_TYPE *ins; DATA_OBJECT temp; if (TestTraversalID(cls->traversalRecord,id)) return; SetTraversalID(cls->traversalRecord,id); if (DefclassInScope(theEnv,cls,theModule) == FALSE) return; ins = cls->instanceList; while (ins != NULL) { InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins; if (qchain->nxt != NULL) { ins->busy++; TestEntireChain(theEnv,qchain->nxt,indx+1); ins->busy--; if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) break; } else { ins->busy++; EvaluationData(theEnv)->CurrentEvaluationDepth++; EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); ins->busy--; if (EvaluationData(theEnv)->HaltExecution == TRUE) break; if ((temp.type != SYMBOL) ? TRUE : (temp.value != EnvFalseSymbol(theEnv))) { if (InstanceQueryData(theEnv)->QueryCore->action != NULL) { ins->busy++; EvaluationData(theEnv)->CurrentEvaluationDepth++; ValueDeinstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result); EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,InstanceQueryData(theEnv)->QueryCore->result); ValueInstall(theEnv,InstanceQueryData(theEnv)->QueryCore->result); EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); ins->busy--; if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag) { InstanceQueryData(theEnv)->AbortQuery = TRUE; break; } if (EvaluationData(theEnv)->HaltExecution == TRUE) break; } else AddSolution(theEnv); } } ins = ins->nxtClass; while ((ins != NULL) ? (ins->garbage == 1) : FALSE) ins = ins->nxtClass; } if (ins != NULL) return; for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { TestEntireClass(theEnv,theModule,id,cls->directSubclasses.classArray[i],qchain,indx); if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE)) return; } } /*************************************************************************** NAME : AddSolution DESCRIPTION : Adds the current instance set to a global list of solutions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Global list and count updated NOTES : Solutions are stored as sequential arrays of INSTANCE_TYPE * ***************************************************************************/ static void AddSolution( void *theEnv) { QUERY_SOLN *new_soln; register unsigned i; new_soln = (QUERY_SOLN *) gm2(theEnv,(int) sizeof(QUERY_SOLN)); new_soln->soln = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * (InstanceQueryData(theEnv)->QueryCore->soln_size))); for (i = 0 ; i < InstanceQueryData(theEnv)->QueryCore->soln_size ; i++) new_soln->soln[i] = InstanceQueryData(theEnv)->QueryCore->solns[i]; new_soln->nxt = NULL; if (InstanceQueryData(theEnv)->QueryCore->soln_set == NULL) InstanceQueryData(theEnv)->QueryCore->soln_set = new_soln; else InstanceQueryData(theEnv)->QueryCore->soln_bottom->nxt = new_soln; InstanceQueryData(theEnv)->QueryCore->soln_bottom = new_soln; InstanceQueryData(theEnv)->QueryCore->soln_cnt++; } /*************************************************** NAME : PopQuerySoln DESCRIPTION : Deallocates the topmost solution set for an instance-set query INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Solution set deallocated NOTES : Assumes QueryCore->soln_set != 0 ***************************************************/ static void PopQuerySoln( void *theEnv) { InstanceQueryData(theEnv)->QueryCore->soln_bottom = InstanceQueryData(theEnv)->QueryCore->soln_set; InstanceQueryData(theEnv)->QueryCore->soln_set = InstanceQueryData(theEnv)->QueryCore->soln_set->nxt; rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->soln_bottom->soln, (sizeof(INSTANCE_TYPE *) * InstanceQueryData(theEnv)->QueryCore->soln_size)); rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->soln_bottom,sizeof(QUERY_SOLN)); } #endif clips-6.24/clipssrc/objrtfnx.h0000755000175000017500000001275410441150326014544 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_objrtfnx #define _H_objrtfnx #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #ifndef _H_conscomp #include "conscomp.h" #endif #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_object #include "object.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_objrtmch #include "objrtmch.h" #endif struct ObjectMatchVar1 { unsigned short whichSlot; unsigned short whichPattern; unsigned short whichField; unsigned objectAddress : 1; unsigned allFields : 1; }; struct ObjectMatchVar2 { unsigned short whichSlot; unsigned short whichPattern; unsigned fromBeginning : 1; unsigned beginningOffset : 7; unsigned fromEnd : 1; unsigned endOffset : 7; }; struct ObjectMatchLength { unsigned minLength : 15; unsigned exactly : 1; }; struct ObjectCmpPNConstant { unsigned offset : 7; unsigned pass : 1; unsigned fail : 1; unsigned general : 1; unsigned fromBeginning : 1; }; struct ObjectCmpPNSingleSlotVars1 { unsigned short firstSlot; unsigned short secondSlot; unsigned pass : 1; unsigned fail : 1; }; struct ObjectCmpPNSingleSlotVars2 { unsigned short firstSlot; unsigned short secondSlot; unsigned pass : 1; unsigned fail : 1; unsigned offset : 7; unsigned fromBeginning : 1; }; struct ObjectCmpPNSingleSlotVars3 { unsigned short firstSlot; unsigned short secondSlot; unsigned pass : 1; unsigned fail : 1; unsigned firstOffset : 7; unsigned firstFromBeginning : 1; unsigned secondOffset : 7; unsigned secondFromBeginning : 1; }; struct ObjectCmpJoinSingleSlotVars1 { unsigned short firstSlot; unsigned short secondSlot; unsigned short firstPattern; unsigned short secondPattern; unsigned pass : 1; unsigned fail : 1; }; struct ObjectCmpJoinSingleSlotVars2 { unsigned short firstSlot; unsigned short secondSlot; unsigned short firstPattern; unsigned short secondPattern; unsigned pass : 1; unsigned fromBeginning : 1; unsigned offset : 7; unsigned fail : 1; }; struct ObjectCmpJoinSingleSlotVars3 { unsigned short firstSlot; unsigned short secondSlot; unsigned short firstPattern; unsigned short secondPattern; unsigned pass : 1; unsigned fail : 1; unsigned firstOffset : 7; unsigned firstFromBeginning : 1; unsigned secondOffset : 7; unsigned secondFromBeginning : 1; }; #define OBJECT_RETE_DATA 35 struct objectReteData { INSTANCE_TYPE *CurrentPatternObject; INSTANCE_SLOT *CurrentPatternObjectSlot; unsigned CurrentObjectSlotLength; struct multifieldMarker *CurrentPatternObjectMarks; struct entityRecord ObjectGVInfo1; struct entityRecord ObjectGVInfo2; struct entityRecord ObjectGVPNInfo1; struct entityRecord ObjectGVPNInfo2; struct entityRecord ObjectCmpConstantInfo; struct entityRecord LengthTestInfo; struct entityRecord PNSimpleCompareInfo1; struct entityRecord PNSimpleCompareInfo2; struct entityRecord PNSimpleCompareInfo3; struct entityRecord JNSimpleCompareInfo1; struct entityRecord JNSimpleCompareInfo2; struct entityRecord JNSimpleCompareInfo3; OBJECT_MATCH_ACTION *ObjectMatchActionQueue; OBJECT_PATTERN_NODE *ObjectPatternNetworkPointer; OBJECT_ALPHA_NODE *ObjectPatternNetworkTerminalPointer; intBool DelayObjectPatternMatching; unsigned long CurrentObjectMatchTimeTag; long UseEntityTimeTag; #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM && CONSTRUCT_COMPILER && (! RUN_TIME) struct CodeGeneratorItem *ObjectPatternCodeItem; #endif }; #define ObjectReteData(theEnv) ((struct objectReteData *) GetEnvironmentData(theEnv,OBJECT_RETE_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTFNX_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void InstallObjectPrimitives(void *); LOCALE intBool ObjectCmpConstantFunction(void *,void *,DATA_OBJECT *); #endif #endif clips-6.24/clipssrc/main.c0000755000175000017500000001071010441602240013612 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* MAIN MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Moved UserFunctions and EnvUserFunctions to */ /* the new userfunctions.c file. */ /* */ /*************************************************************/ /***************************************************************************/ /* */ /* Permission is hereby granted, free of charge, to any person obtaining */ /* a copy of this software and associated documentation files (the */ /* "Software"), to deal in the Software without restriction, including */ /* without limitation the rights to use, copy, modify, merge, publish, */ /* distribute, and/or sell copies of the Software, and to permit persons */ /* to whom the Software is furnished to do so. */ /* */ /* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS */ /* OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF */ /* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT */ /* OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY */ /* CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES */ /* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN */ /* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF */ /* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* */ /***************************************************************************/ #include #include "setup.h" #include "sysdep.h" #include "envrnmnt.h" #include "extnfunc.h" #include "commline.h" int main(int,char *[]); void UserFunctions(void); void EnvUserFunctions(void *); /****************************************/ /* main: Starts execution of the expert */ /* system development environment. */ /****************************************/ int main( int argc, char *argv[]) { void *theEnv; theEnv = CreateEnvironment(); RerouteStdin(theEnv,argc,argv); CommandLoop(theEnv); /*==================================================================*/ /* Control does not normally return from the CommandLoop function. */ /* However if you are embedding CLIPS, have replaced CommandLoop */ /* with your own embedded calls that will return to this point, and */ /* are running software that helps detect memory leaks, you need to */ /* add function calls here to deallocate memory still being used by */ /* CLIPS. If you have a multi-threaded application, no environments */ /* can be currently executing. If the ALLOW_ENVIRONMENT_GLOBALS */ /* flag in setup.h has been set to TRUE (the default value), you */ /* call the DeallocateEnvironmentData function which will call */ /* DestroyEnvironment for each existing environment and then */ /* deallocate the remaining data used to keep track of allocated */ /* environments. Otherwise, you must explicitly call */ /* DestroyEnvironment for each environment you create. */ /*==================================================================*/ /* DeallocateEnvironmentData(); */ /* DestroyEnvironment(theEnv); */ return(-1); } clips-6.24/clipssrc/._globlpsr.c0000400000175000017500000000075410441602223014722 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z1zTTFL,FMPSRMWBBLclips-6.24/clipssrc/objrtbin.h0000755000175000017500000000354610441072727014530 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /*************************************************************/ #ifndef _H_objrtbin #define _H_objrtbin #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #define OBJECTRETEBIN_DATA 34 struct objectReteBinaryData { long AlphaNodeCount; long PatternNodeCount; OBJECT_ALPHA_NODE *AlphaArray; OBJECT_PATTERN_NODE *PatternArray; }; #define ObjectReteBinaryData(theEnv) ((struct objectReteBinaryData *) GetEnvironmentData(theEnv,OBJECTRETEBIN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectPatternsBload(void *); #endif #endif clips-6.24/clipssrc/._clsltpsr.h0000400000175000017500000000075407422634764014775 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH MonacoqT qT ʸplTTFpH-FMWBBMPSRclips-6.24/clipssrc/genrcpsr.h0000755000175000017500000000402010441143575014526 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_genrcpsr #define _H_genrcpsr #if DEFGENERIC_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #include "genrcfun.h" #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCPSR_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE intBool ParseDefgeneric(void *,char *); LOCALE intBool ParseDefmethod(void *,char *); LOCALE DEFMETHOD *AddMethod(void *,DEFGENERIC *,DEFMETHOD *,int,unsigned,EXPRESSION *, int,int,SYMBOL_HN *,EXPRESSION *,char *,int); LOCALE void PackRestrictionTypes(void *,RESTRICTION *,EXPRESSION *); LOCALE void DeleteTempRestricts(void *,EXPRESSION *); LOCALE DEFMETHOD *FindMethodByRestrictions(DEFGENERIC *,EXPRESSION *,int, SYMBOL_HN *,int *); #ifndef _GENRCPSR_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/argacces.c0000755000175000017500000011175410441602033014450 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* ARGUMENT ACCESS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides access routines for accessing arguments */ /* passed to user or system functions defined using the */ /* DefineFunction protocol. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added IllegalLogicalNameMessage function. */ /* */ /*************************************************************/ #define _ARGACCES_SOURCE_ #include "setup.h" #include #define _STDIO_INCLUDED_ #include #include #include #include "envrnmnt.h" #include "extnfunc.h" #include "router.h" #include "cstrnchk.h" #include "insfun.h" #include "factmngr.h" #include "prntutil.h" #include "argacces.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void NonexistantError(void *,char *,char *,int); static void ExpectedTypeError3(void *,char *,char *,int,char *); /*******************************************************************/ /* EnvRtnLexeme: Access function to retrieve the nth argument from */ /* a user or system function defined using the DefineFunction */ /* protocol. The argument retrieved must be a symbol, string, or */ /* instance name, otherwise an error is generated. Only the */ /* value of the argument is returned (i.e. the string "a" would */ /* be returned for a, "a", and [a]). */ /*******************************************************************/ globle char *EnvRtnLexeme( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnLexeme", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*============================================*/ /* Return the value of the nth argument if it */ /* is a symbol, string, or instance name. */ /*============================================*/ EvaluateExpression(theEnv,argPtr,&result); if ((result.type == SYMBOL) || #if OBJECT_SYSTEM (result.type == INSTANCE_NAME) || #endif (result.type == STRING)) { return(ValueToString(result.value));} /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnLexeme", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"symbol, string, or instance name"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*******************************************************************/ /* EnvRtnDouble: Access function to retrieve the nth argument from */ /* a user or system function defined using the DefineFunction */ /* protocol. The argument retrieved must be a either a float or */ /* an integer (type conversion to a float is performed for */ /* integers), otherwise an error is generated. Only the value of */ /* the argument is returned (i.e. the float 3.0 would be */ /* returned for 3.0 and 3). */ /*******************************************************************/ globle double EnvRtnDouble( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnDouble", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1.0); } /*======================================*/ /* Return the value of the nth argument */ /* if it is a float or integer. */ /*======================================*/ EvaluateExpression(theEnv,argPtr,&result); if (result.type == FLOAT) { return(ValueToDouble(result.value)); } else if (result.type == INTEGER) { return((double) ValueToLong(result.value)); } /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnDouble", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1.0); } /*****************************************************************/ /* EnvRtnLong: Access function to retrieve the nth argument from */ /* a user or system function defined using the DefineFunction */ /* protocol. The argument retrieved must be a either a float */ /* or an integer (type conversion to an integer is performed */ /* for floats), otherwise an error is generated. Only the */ /* value of the argument is returned (i.e. the integer 4 */ /* would be returned for 4.3 and 4). */ /*****************************************************************/ globle long EnvRtnLong( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnLong", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } /*======================================*/ /* Return the value of the nth argument */ /* if it is a float or integer. */ /*======================================*/ EvaluateExpression(theEnv,argPtr,&result); if (result.type == FLOAT) { return((long) ValueToDouble(result.value)); } else if (result.type == INTEGER) { return(ValueToLong(result.value)); } /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnLong", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } /********************************************************************/ /* EnvRtnUnknown: Access function to retrieve the nth argument from */ /* a user or system function defined using the DefineFunction */ /* protocol. The argument retrieved can be of any type. The value */ /* and type of the argument are returned in a DATA_OBJECT */ /* structure provided by the calling function. */ /********************************************************************/ globle DATA_OBJECT_PTR EnvRtnUnknown( void *theEnv, int argumentPosition, DATA_OBJECT_PTR returnValue) { int count = 1; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnUnknown", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*=======================================*/ /* Return the value of the nth argument. */ /*=======================================*/ EvaluateExpression(theEnv,argPtr,returnValue); return(returnValue); } /***********************************************************/ /* EnvRtnArgCount: Returns the length of the argument list */ /* for the function call currently being evaluated. */ /***********************************************************/ globle int EnvRtnArgCount( void *theEnv) { int count = 0; struct expr *argPtr; for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; argPtr != NULL; argPtr = argPtr->nextArg) { count++; } return(count); } /************************************************************************/ /* EnvArgCountCheck: Given the expected number of arguments, determines */ /* if the function currently being evaluated has the correct number */ /* of arguments. Three types of argument checking are provided by */ /* this function: 1) The function has exactly the expected number of */ /* arguments; 2) The function has at least the expected number of */ /* arguments; 3) The function has at most the expected number of */ /* arguments. The number of arguments is returned if no error occurs, */ /* otherwise -1 is returned. */ /************************************************************************/ globle int EnvArgCountCheck( void *theEnv, char *functionName, int countRelation, int expectedNumber) { int numberOfArguments; /*==============================================*/ /* Get the number of arguments for the function */ /* currently being evaluated. */ /*==============================================*/ numberOfArguments = EnvRtnArgCount(theEnv); /*=========================================================*/ /* If the function satisfies expected number of arguments, */ /* constraint, then return the number of arguments found. */ /*=========================================================*/ if (countRelation == EXACTLY) { if (numberOfArguments == expectedNumber) return(numberOfArguments); } else if (countRelation == AT_LEAST) { if (numberOfArguments >= expectedNumber) return(numberOfArguments); } else if (countRelation == NO_MORE_THAN) { if (numberOfArguments <= expectedNumber) return(numberOfArguments); } /*================================================*/ /* The correct number of arguments was not found. */ /* Generate an error message and return -1. */ /*================================================*/ ExpectedCountError(theEnv,functionName,countRelation,expectedNumber); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } /****************************************************************/ /* EnvArgRangeCheck: Checks that the number of arguments passed */ /* to a function falls within a specified minimum and maximum */ /* range. The number of arguments passed to the function is */ /* returned if no error occurs, otherwise -1 is returned. */ /****************************************************************/ globle int EnvArgRangeCheck( void *theEnv, char *functionName, int min, int max) { int numberOfArguments; numberOfArguments = EnvRtnArgCount(theEnv); if ((numberOfArguments < min) || (numberOfArguments > max)) { PrintErrorID(theEnv,"ARGACCES",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," expected at least "); PrintLongInteger(theEnv,WERROR,(long) min); EnvPrintRouter(theEnv,WERROR," and no more than "); PrintLongInteger(theEnv,WERROR,(long) max); EnvPrintRouter(theEnv,WERROR," arguments.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } return(numberOfArguments); } /*************************************************************/ /* EnvArgTypeCheck: Retrieves the nth argument passed to the */ /* function call currently being evaluated and determines */ /* if it matches a specified type. Returns TRUE if the */ /* argument was successfully retrieved and is of the */ /* appropriate type, otherwise returns FALSE. */ /*************************************************************/ globle int EnvArgTypeCheck( void *theEnv, char *functionName, int argumentPosition, int expectedType, DATA_OBJECT_PTR returnValue) { /*========================*/ /* Retrieve the argument. */ /*========================*/ EnvRtnUnknown(theEnv,argumentPosition,returnValue); if (EvaluationData(theEnv)->EvaluationError) return(FALSE); /*========================================*/ /* If the argument's type exactly matches */ /* the expected type, then return TRUE. */ /*========================================*/ if (returnValue->type == expectedType) return (TRUE); /*=============================================================*/ /* Some expected types encompass more than one primitive type. */ /* If the argument's type matches one of the primitive types */ /* encompassed by the expected type, then return TRUE. */ /*=============================================================*/ if ((expectedType == INTEGER_OR_FLOAT) && ((returnValue->type == INTEGER) || (returnValue->type == FLOAT))) { return(TRUE); } if ((expectedType == SYMBOL_OR_STRING) && ((returnValue->type == SYMBOL) || (returnValue->type == STRING))) { return(TRUE); } #if OBJECT_SYSTEM if (((expectedType == SYMBOL_OR_STRING) || (expectedType == SYMBOL)) && (returnValue->type == INSTANCE_NAME)) { return(TRUE); } if ((expectedType == INSTANCE_NAME) && ((returnValue->type == INSTANCE_NAME) || (returnValue->type == SYMBOL))) { return(TRUE); } if ((expectedType == INSTANCE_OR_INSTANCE_NAME) && ((returnValue->type == INSTANCE_ADDRESS) || (returnValue->type == INSTANCE_NAME) || (returnValue->type == SYMBOL))) { return(TRUE); } #endif /*===========================================================*/ /* If the expected type is float and the argument's type is */ /* integer (or vice versa), then convert the argument's type */ /* to match the expected type and then return TRUE. */ /*===========================================================*/ if ((returnValue->type == INTEGER) && (expectedType == FLOAT)) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,(double) ValueToLong(returnValue->value)); return(TRUE); } if ((returnValue->type == FLOAT) && (expectedType == INTEGER)) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,(long) ValueToDouble(returnValue->value)); return(TRUE); } /*=====================================================*/ /* The argument's type didn't match the expected type. */ /* Print an error message and return FALSE. */ /*=====================================================*/ if (expectedType == FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"float"); else if (expectedType == INTEGER) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer"); else if (expectedType == SYMBOL) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol"); else if (expectedType == STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"string"); else if (expectedType == MULTIFIELD) ExpectedTypeError1(theEnv,functionName,argumentPosition,"multifield"); else if (expectedType == INTEGER_OR_FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer or float"); else if (expectedType == SYMBOL_OR_STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol or string"); #if OBJECT_SYSTEM else if (expectedType == INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance name"); else if (expectedType == INSTANCE_ADDRESS) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address"); else if (expectedType == INSTANCE_OR_INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address or instance name"); #endif SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(FALSE); } /******************************************************************/ /* GetNumericArgument: Evaluates an expression to yield a numeric */ /* argument. This provides quicker retrieval than using some of */ /* the other argument access routines. The numeric argument is */ /* returned in a DATA_OBJECT supplied by the calling function. */ /* TRUE is returned if a numeric argument was successfully */ /* retrieved, otherwise FALSE is returned. */ /******************************************************************/ globle intBool GetNumericArgument( void *theEnv, struct expr *theArgument, char *functionName, DATA_OBJECT *result, intBool convertToFloat, int whichArgument) { unsigned short theType; void *theValue; /*==================================================================*/ /* Evaluate the expression (don't bother calling EvaluateExpression */ /* if the type is float or integer). */ /*==================================================================*/ switch(theArgument->type) { case FLOAT: case INTEGER: theType = theArgument->type; theValue = theArgument->value; break; default: EvaluateExpression(theEnv,theArgument,result); theType = result->type; theValue = result->value; break; } /*==========================================*/ /* If the argument is not float or integer, */ /* print an error message and return FALSE. */ /*==========================================*/ if ((theType != FLOAT) && (theType != INTEGER)) { ExpectedTypeError1(theEnv,functionName,whichArgument,"integer or float"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return(FALSE); } /*==========================================================*/ /* If the argument is an integer and the "convert to float" */ /* flag is TRUE, then convert the integer to a float. */ /*==========================================================*/ if ((convertToFloat) && (theType == INTEGER)) { theType = FLOAT; theValue = (void *) EnvAddDouble(theEnv,(double) ValueToLong(theValue)); } /*============================================================*/ /* The numeric argument was successfully retrieved. Store the */ /* argument in the user supplied DATA_OBJECT and return TRUE. */ /*============================================================*/ result->type = theType; result->value = theValue; return(TRUE); } /*********************************************************************/ /* GetLogicalName: Retrieves the nth argument passed to the function */ /* call currently being evaluated and determines if it is a valid */ /* logical name. If valid, the logical name is returned, otherwise */ /* NULL is returned. */ /*********************************************************************/ globle char *GetLogicalName( void *theEnv, int whichArgument, char *defaultLogicalName) { char *logicalName; DATA_OBJECT result; EnvRtnUnknown(theEnv,whichArgument,&result); if ((GetType(result) == SYMBOL) || (GetType(result) == STRING) || (GetType(result) == INSTANCE_NAME)) { logicalName = ValueToString(result.value); if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0)) { logicalName = defaultLogicalName; } } else if (GetType(result) == FLOAT) { logicalName = ValueToString(EnvAddSymbol(theEnv,FloatToString(theEnv,DOToDouble(result)))); } else if (GetType(result) == INTEGER) { logicalName = ValueToString(EnvAddSymbol(theEnv,LongIntegerToString(theEnv,DOToLong(result)))); } else { logicalName = NULL; } return(logicalName); } /************************************************************/ /* GetFileName: Retrieves the nth argument passed to the */ /* function call currently being evaluated and determines */ /* if it is a valid file name. If valid, the file name is */ /* returned, otherwise NULL is returned. */ /************************************************************/ globle char *GetFileName( void *theEnv, char *functionName, int whichArgument) { DATA_OBJECT result; EnvRtnUnknown(theEnv,whichArgument,&result); if ((GetType(result) != STRING) && (GetType(result) != SYMBOL)) { ExpectedTypeError1(theEnv,functionName,whichArgument,"file name"); return(NULL); } return(DOToString(result)); } /******************************************************************/ /* OpenErrorMessage: Generalized error message for opening files. */ /******************************************************************/ globle void OpenErrorMessage( void *theEnv, char *functionName, char *fileName) { PrintErrorID(theEnv,"ARGACCES",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," was unable to open file "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR,".\n"); } /************************************************************/ /* GetModuleName: Retrieves the nth argument passed to the */ /* function call currently being evaluated and determines */ /* if it is a valid module name. If valid, the module */ /* name is returned or NULL is returned to indicate all */ /* modules. */ /************************************************************/ globle struct defmodule *GetModuleName( void *theEnv, char *functionName, int whichArgument, int *error) { DATA_OBJECT result; struct defmodule *theModule; *error = FALSE; /*========================*/ /* Retrieve the argument. */ /*========================*/ EnvRtnUnknown(theEnv,whichArgument,&result); /*=================================*/ /* A module name must be a symbol. */ /*=================================*/ if (GetType(result) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name"); *error = TRUE; return(NULL); } /*=======================================*/ /* Check to see that the symbol actually */ /* corresponds to a defined module. */ /*=======================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name"); *error = TRUE; } return(NULL); } /*=================================*/ /* Return a pointer to the module. */ /*=================================*/ return(theModule); } /****************************************************************/ /* GetConstructName: Retrieves the 1st argument passed to the */ /* function call currently being evaluated and determines if */ /* it is a valid name for a construct. Also checks that the */ /* function is only passed a single argument. This routine */ /* is used by functions such as ppdeftemplate, undefrule, */ /* etc... to retrieve the construct name on which to operate. */ /****************************************************************/ globle char *GetConstructName( void *theEnv, char *functionName, char *constructType) { DATA_OBJECT result; if (EnvRtnArgCount(theEnv) != 1) { ExpectedCountError(theEnv,functionName,EXACTLY,1); return(NULL); } EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,1,constructType); return(NULL); } return(DOToString(result)); } /**************************************************************************/ /* NonexistantError: Prints the error message for a nonexistant argument. */ /**************************************************************************/ static void NonexistantError( void *theEnv, char *accessFunction, char *functionName, int argumentPosition) { PrintErrorID(theEnv,"ARGACCES",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,accessFunction); EnvPrintRouter(theEnv,WERROR," received a request from function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," for argument #"); PrintLongInteger(theEnv,WERROR,(long int) argumentPosition); EnvPrintRouter(theEnv,WERROR," which is non-existent\n"); } /*********************************************************/ /* ExpectedCountError: Prints the error message for an */ /* incorrect number of arguments passed to a function. */ /*********************************************************/ globle void ExpectedCountError( void *theEnv, char *functionName, int countRelation, int expectedNumber) { PrintErrorID(theEnv,"ARGACCES",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); if (countRelation == EXACTLY) { EnvPrintRouter(theEnv,WERROR," expected exactly "); } else if (countRelation == AT_LEAST) { EnvPrintRouter(theEnv,WERROR," expected at least "); } else if (countRelation == NO_MORE_THAN) { EnvPrintRouter(theEnv,WERROR," expected no more than "); } else { EnvPrintRouter(theEnv,WERROR," generated an illegal argument check for "); } PrintLongInteger(theEnv,WERROR,(long int) expectedNumber); EnvPrintRouter(theEnv,WERROR," argument(s)\n"); } /*************************************************************/ /* NAME : CheckFunctionArgCount */ /* DESCRIPTION : Checks the number of arguments against */ /* the system function restriction list */ /* INPUTS : 1) Name of the calling function */ /* 2) The restriction list can be NULL */ /* 3) The number of arguments */ /* RETURNS : TRUE if OK, FALSE otherwise */ /* SIDE EFFECTS : EvaluationError set on errrors */ /* NOTES : Used to check generic function implicit */ /* method (system function) calls and system */ /* function calls which have the sequence */ /* expansion operator in their argument list */ /*************************************************************/ globle intBool CheckFunctionArgCount( void *theEnv, char *functionName, char *restrictions, int argumentCount) { register int minArguments, maxArguments; char theChar[2]; theChar[0] = '0'; theChar[1] = EOS; /*=====================================================*/ /* If there are no restrictions, then there is no need */ /* to check for the correct number of arguments. */ /*=====================================================*/ if (restrictions == NULL) return(TRUE); /*===========================================*/ /* Determine the minimum number of arguments */ /* required by the function. */ /*===========================================*/ if (isdigit(restrictions[0])) { theChar[0] = restrictions[0]; minArguments = atoi(theChar); } else { minArguments = -1; } /*===========================================*/ /* Determine the maximum number of arguments */ /* required by the function. */ /*===========================================*/ if (isdigit(restrictions[1])) { theChar[0] = restrictions[1]; maxArguments = atoi(theChar); } else { maxArguments = 10000; } /*==============================================*/ /* If the function expects exactly N arguments, */ /* then check to see if there are N arguments. */ /*==============================================*/ if (minArguments == maxArguments) { if (argumentCount != minArguments) { ExpectedCountError(theEnv,functionName,EXACTLY,minArguments); SetEvaluationError(theEnv,TRUE); return(FALSE); } return(TRUE); } /*==================================*/ /* Check to see if there were fewer */ /* arguments passed than expected. */ /*==================================*/ if (argumentCount < minArguments) { ExpectedCountError(theEnv,functionName,AT_LEAST,minArguments); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*=================================*/ /* Check to see if there were more */ /* arguments passed than expected. */ /*=================================*/ if (argumentCount > maxArguments) { ExpectedCountError(theEnv,functionName,NO_MORE_THAN,maxArguments); SetEvaluationError(theEnv,TRUE); return(FALSE); } /*===============================*/ /* The number of arguments falls */ /* within the expected range. */ /*===============================*/ return(TRUE); } /*******************************************************************/ /* ExpectedTypeError1: Prints the error message for the wrong type */ /* of argument passed to a user or system defined function. The */ /* expected type is passed as a string to this function. */ /*******************************************************************/ globle void ExpectedTypeError1( void *theEnv, char *functionName, int whichArg, char *expectedType) { PrintErrorID(theEnv,"ARGACCES",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," expected argument #"); PrintLongInteger(theEnv,WERROR,(long int) whichArg); EnvPrintRouter(theEnv,WERROR," to be of type "); EnvPrintRouter(theEnv,WERROR,expectedType); EnvPrintRouter(theEnv,WERROR,"\n"); } /**************************************************************/ /* ExpectedTypeError2: Prints the error message for the wrong */ /* type of argument passed to a user or system defined */ /* function. The expected type is derived by examining the */ /* function's argument restriction list. */ /**************************************************************/ globle void ExpectedTypeError2( void *theEnv, char *functionName, int whichArg) { struct FunctionDefinition *theFunction; char *theType; theFunction = FindFunction(theEnv,functionName); if (theFunction == NULL) return; theType = GetArgumentTypeName(GetNthRestriction(theFunction,whichArg)); ExpectedTypeError1(theEnv,functionName,whichArg,theType); } /*******************************************************************/ /* ExpectedTypeError3: Prints the error message for the wrong type */ /* of argument passed to a user or system defined function when */ /* the argument was requested by calling RtnLexeme, RtnLong, or */ /* RtnDouble. */ /*******************************************************************/ static void ExpectedTypeError3( void *theEnv, char *accessFunction, char *functionName, int argumentPosition, char *type) { PrintErrorID(theEnv,"ARGACCES",6,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,accessFunction); EnvPrintRouter(theEnv,WERROR," received a request from function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," for argument #"); PrintLongInteger(theEnv,WERROR,(long int) argumentPosition); EnvPrintRouter(theEnv,WERROR," which is not of type "); EnvPrintRouter(theEnv,WERROR,type); EnvPrintRouter(theEnv,WERROR,"\n"); } /***************************************************/ /* GetFactOrInstanceArgument: Utility routine for */ /* retrieving a fact or instance argument */ /***************************************************/ void *GetFactOrInstanceArgument( void *theEnv, int thePosition, DATA_OBJECT *item, char *functionName) { #if DEFTEMPLATE_CONSTRUCT || OBJECT_SYSTEM void *ptr; #endif /*==============================*/ /* Retrieve the first argument. */ /*==============================*/ EnvRtnUnknown(theEnv,thePosition,item); /*==================================================*/ /* Fact and instance addresses are valid arguments. */ /*==================================================*/ if ((GetpType(item) == FACT_ADDRESS) || (GetpType(item) == INSTANCE_ADDRESS)) { return(GetpValue(item)); } /*==================================================*/ /* An integer is a valid argument if it corresponds */ /* to the fact index of an existing fact. */ /*==================================================*/ #if DEFTEMPLATE_CONSTRUCT else if (GetpType(item) == INTEGER) { if ((ptr = (void *) FindIndexedFact(theEnv,DOPToLong(item))) == NULL) { char tempBuffer[20]; sprintf(tempBuffer,"f-%ld",DOPToLong(item)); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); } return(ptr); } #endif /*================================================*/ /* Instance names and symbols are valid arguments */ /* if they correspond to an existing instance. */ /*================================================*/ #if OBJECT_SYSTEM else if ((GetpType(item) == INSTANCE_NAME) || (GetpType(item) == SYMBOL)) { if ((ptr = (void *) FindInstanceBySymbol(theEnv,(SYMBOL_HN *) GetpValue(item))) == NULL) { CantFindItemErrorMessage(theEnv,"instance",ValueToString(GetpValue(item))); } return(ptr); } #endif /*========================================*/ /* Any other type is an invalid argument. */ /*========================================*/ ExpectedTypeError2(theEnv,functionName,thePosition); return(NULL); } /****************************************************/ /* IllegalLogicalNameMessage: Generic error message */ /* for illegal logical names. */ /****************************************************/ void IllegalLogicalNameMessage( void *theEnv, char *theFunction) { PrintErrorID(theEnv,"IOFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Illegal logical name used for "); EnvPrintRouter(theEnv,WERROR,theFunction); EnvPrintRouter(theEnv,WERROR," function.\n"); } clips-6.24/clipssrc/factcmp.c0000755000175000017500000003220007422634722014320 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT PATTERN NETWORK CONSTRUCTS-TO-C MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for the */ /* fact pattern network. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _FACTCMP_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT && (! RUN_TIME) && DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER #define FactPrefix() ArbitraryPrefix(FactData(theEnv)->FactCodeItem,0) #include #define _STDIO_INCLUDED_ #include "factbld.h" #include "conscomp.h" #include "factcmp.h" #include "tmpltdef.h" #include "envrnmnt.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int PatternNetworkToCode(void *,char *,int,FILE *,int,int); static void BeforePatternNetworkToCode(void *); static struct factPatternNode *GetNextPatternNode(struct factPatternNode *); static void CloseNetworkFiles(void *,FILE *,int); static void PatternNodeToCode(void *,FILE *,struct factPatternNode *,int,int); /**************************************************************/ /* FactPatternsCompilerSetup: Initializes the constructs-to-c */ /* command for use with the fact pattern network. */ /**************************************************************/ globle void FactPatternsCompilerSetup( void *theEnv) { FactData(theEnv)->FactCodeItem = AddCodeGeneratorItem(theEnv,"facts",0,BeforePatternNetworkToCode, NULL,PatternNetworkToCode,1); } /****************************************************************/ /* BeforePatternNetworkToCode: Assigns each pattern node with a */ /* unique ID which will be used for pointer references when */ /* the data structures are written to a file as C code */ /****************************************************************/ static void BeforePatternNetworkToCode( void *theEnv) { int whichPattern = 0; int whichDeftemplate = 0; struct defmodule *theModule; struct deftemplate *theDeftemplate; struct factPatternNode *thePattern; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=========================*/ /* Set the current module. */ /*=========================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*======================================================*/ /* Loop through each deftemplate in the current module. */ /*======================================================*/ for (theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theDeftemplate != NULL; theDeftemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theDeftemplate)) { /*=================================================*/ /* Assign each pattern node in the pattern network */ /* for the deftemplate a unique integer ID. */ /*=================================================*/ theDeftemplate->header.bsaveID = whichDeftemplate++; for (thePattern = theDeftemplate->patternNetwork; thePattern != NULL; thePattern = GetNextPatternNode(thePattern)) { thePattern->bsaveID = whichPattern++; } } } } /********************************************************************/ /* GetNextPatternNode: Returns the next node in a pattern network */ /* tree. The next node is computed using a depth first traversal. */ /********************************************************************/ static struct factPatternNode *GetNextPatternNode( struct factPatternNode *thePattern) { /*=========================================*/ /* If it's possible to go deeper into the */ /* tree, then move down to the next level. */ /*=========================================*/ if (thePattern->nextLevel != NULL) return(thePattern->nextLevel); /*========================================*/ /* Keep backing up toward the root of the */ /* tree until a side branch can be taken. */ /*========================================*/ while (thePattern->rightNode == NULL) { /*========================================*/ /* Back up to check the next side branch. */ /*========================================*/ thePattern = thePattern->lastLevel; /*======================================*/ /* If we branched up from the root, the */ /* entire tree has been traversed. */ /*======================================*/ if (thePattern == NULL) return(NULL); } /*==================================*/ /* Move on to the next side branch. */ /*==================================*/ return(thePattern->rightNode); } /********************************************************************/ /* PatternNetworkToCode: Produces the fact pattern network code for */ /* a run-time module created using the constructs-to-c function. */ /********************************************************************/ static int PatternNetworkToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; struct deftemplate *theTemplate; struct factPatternNode *thePatternNode; int networkArrayCount = 0, networkArrayVersion = 1; FILE *networkFile = NULL; /*===========================================================*/ /* Include the appropriate fact pattern network header file. */ /*===========================================================*/ fprintf(headerFP,"#include \"factbld.h\"\n"); /*===============================*/ /* Loop through all the modules. */ /*===============================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*=========================*/ /* Set the current module. */ /*=========================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*======================================*/ /* Loop through all of the deftemplates */ /* in the current module. */ /*======================================*/ for (theTemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,NULL); theTemplate != NULL; theTemplate = (struct deftemplate *) EnvGetNextDeftemplate(theEnv,theTemplate)) { /*======================================================*/ /* Loop through each pattern node in the deftemplate's */ /* pattern network writing its C code representation to */ /* the file as it is traversed. */ /*======================================================*/ for (thePatternNode = theTemplate->patternNetwork; thePatternNode != NULL; thePatternNode = GetNextPatternNode(thePatternNode)) { networkFile = OpenFileIfNeeded(theEnv,networkFile,fileName,fileID,imageID,&fileCount, networkArrayVersion,headerFP, "struct factPatternNode",FactPrefix(),FALSE,NULL); if (networkFile == NULL) { CloseNetworkFiles(theEnv,networkFile,maxIndices); return(0); } PatternNodeToCode(theEnv,networkFile,thePatternNode,imageID,maxIndices); networkArrayCount++; networkFile = CloseFileIfNeeded(theEnv,networkFile,&networkArrayCount, &networkArrayVersion,maxIndices,NULL,NULL); } } } /*==============================*/ /* Close any C files left open. */ /*==============================*/ CloseNetworkFiles(theEnv,networkFile,maxIndices); /*===============================*/ /* Return TRUE to indicate the C */ /* code was successfully saved. */ /*===============================*/ return(TRUE); } /****************************************************************/ /* CloseNetworkFiles: Closes all of the C files created for the */ /* fact pattern network. Called when an error occurs or when */ /* the fact pattern network data structures have all been */ /* written to the files. */ /****************************************************************/ static void CloseNetworkFiles( void *theEnv, FILE *networkFile, int maxIndices) { int count = maxIndices; int arrayVersion = 0; if (networkFile != NULL) { CloseFileIfNeeded(theEnv,networkFile,&count,&arrayVersion,maxIndices,NULL,NULL); } } /************************************************************/ /* PatternNodeToCode: Writes the C code representation of a */ /* single fact pattern node slot to the specified file. */ /************************************************************/ static void PatternNodeToCode( void *theEnv, FILE *theFile, struct factPatternNode *thePatternNode, int imageID, int maxIndices) { fprintf(theFile,"{"); /*=====================*/ /* Pattern Node Header */ /*=====================*/ PatternNodeHeaderToCode(theEnv,theFile,&thePatternNode->header,imageID,maxIndices); /*========================*/ /* Field and Slot Indices */ /*========================*/ fprintf(theFile,",0,%d,%d,%d,",thePatternNode->whichField, thePatternNode->whichSlot, thePatternNode->leaveFields); /*===============*/ /* Network Tests */ /*===============*/ PrintHashedExpressionReference(theEnv,theFile,thePatternNode->networkTest,imageID,maxIndices); /*============*/ /* Next Level */ /*============*/ if (thePatternNode->nextLevel == NULL) { fprintf(theFile,",NULL,"); } else { fprintf(theFile,",&%s%d_%ld[%ld],",FactPrefix(), imageID,(thePatternNode->nextLevel->bsaveID / maxIndices) + 1, thePatternNode->nextLevel->bsaveID % maxIndices); } /*============*/ /* Last Level */ /*============*/ if (thePatternNode->lastLevel == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",FactPrefix(), imageID,(thePatternNode->lastLevel->bsaveID / maxIndices) + 1, thePatternNode->lastLevel->bsaveID % maxIndices); } /*===========*/ /* Left Node */ /*===========*/ if (thePatternNode->leftNode == NULL) { fprintf(theFile,"NULL,"); } else { fprintf(theFile,"&%s%d_%ld[%ld],",FactPrefix(), imageID,(thePatternNode->leftNode->bsaveID / maxIndices) + 1, thePatternNode->leftNode->bsaveID % maxIndices); } /*============*/ /* Right Node */ /*============*/ if (thePatternNode->rightNode == NULL) { fprintf(theFile,"NULL}"); } else { fprintf(theFile,"&%s%d_%ld[%ld]}",FactPrefix(), imageID,(thePatternNode->rightNode->bsaveID / maxIndices) + 1, thePatternNode->rightNode->bsaveID % maxIndices); } } /**********************************************************/ /* FactPatternNodeReference: Prints C code representation */ /* of a fact pattern node data structure reference. */ /**********************************************************/ globle void FactPatternNodeReference( void *theEnv, void *theVPattern, FILE *theFile, int imageID, int maxIndices) { struct factPatternNode *thePattern = (struct factPatternNode *) theVPattern; if (thePattern == NULL) fprintf(theFile,"NULL"); else { fprintf(theFile,"&%s%d_%ld[%ld]",FactPrefix(), imageID,(thePattern->bsaveID / maxIndices) + 1, thePattern->bsaveID % maxIndices); } } #endif /* DEFRULE_CONSTRUCT && (! RUN_TIME) && DEFTEMPLATE_CONSTRUCT && CONSTRUCT_COMPILER */ clips-6.24/clipssrc/drive.c0000755000175000017500000010504210441162301014001 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* DRIVE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Handles join network activity associated with */ /* with the addition of a data entity such as a fact or */ /* instance. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Removed INCREMENTAL_RESET and */ /* LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Rule with exists CE has incorrect activation. */ /* DR0867 */ /* */ /*************************************************************/ #define _DRIVE_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "agenda.h" #include "constant.h" #include "engine.h" #include "envrnmnt.h" #include "memalloc.h" #include "prntutil.h" #include "reteutil.h" #include "retract.h" #include "router.h" #include "lgcldpnd.h" #include "incrrset.h" #include "drive.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void PPDrive(void *,struct partialMatch *,struct partialMatch *,struct joinNode *); static void PNRDrive(void *,struct joinNode *,struct partialMatch *, struct partialMatch *); static void EmptyDrive(void *,struct joinNode *,struct partialMatch *); static void JoinNetErrorMessage(void *,struct joinNode *); /************************************************/ /* NetworkAssert: Primary routine for filtering */ /* a partial match through the join network. */ /************************************************/ globle void NetworkAssert( void *theEnv, struct partialMatch *binds, struct joinNode *join, int enterDirection) { struct partialMatch *lhsBinds = NULL, *rhsBinds = NULL; struct partialMatch *comparePMs = NULL, *newBinds; int exprResult; /*=========================================================*/ /* If an incremental reset is being performed and the join */ /* is not part of the network to be reset, then return. */ /*=========================================================*/ #if (! BLOAD_ONLY) && (! RUN_TIME) if (EngineData(theEnv)->IncrementalResetInProgress && (join->initialize == FALSE)) return; #endif /*=========================================================*/ /* If the associated LHS pattern is a not CE or the join */ /* is a nand join, then we need an additional field in the */ /* partial match to keep track of the pseudo fact if one */ /* is created. The partial match is automatically stored */ /* in the beta memory and the counterf slot is used to */ /* determine if it is an actual partial match. If counterf */ /* is TRUE, there are one or more fact or instances */ /* keeping the not or nand join from being satisfied. */ /*=========================================================*/ if ((enterDirection == LHS) && ((join->patternIsNegated) || (join->joinFromTheRight))) { newBinds = AddSingleMatch(theEnv,binds,NULL, (join->ruleToActivate == NULL) ? 0 : 1, (int) join->logicalJoin); newBinds->notOriginf = TRUE; newBinds->counterf = TRUE; binds = newBinds; binds->next = join->beta; join->beta = binds; } /*==================================================*/ /* Use a special routine if this is the first join. */ /*==================================================*/ if (join->firstJoin) { EmptyDrive(theEnv,join,binds); return; } /*==================================================*/ /* Initialize some variables used to indicate which */ /* side is being compared to the new partial match. */ /*==================================================*/ if (enterDirection == LHS) { if (join->joinFromTheRight) { comparePMs = ((struct joinNode *) join->rightSideEntryStructure)->beta;} else { comparePMs = ((struct patternNodeHeader *) join->rightSideEntryStructure)->alphaMemory; } lhsBinds = binds; } else if (enterDirection == RHS) { if (join->patternIsNegated || join->joinFromTheRight) { comparePMs = join->beta; } else { comparePMs = join->lastLevel->beta; } rhsBinds = binds; } else { SystemError(theEnv,"DRIVE",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*===================================================*/ /* Compare each set of binds on the opposite side of */ /* the join with the set of binds that entered this */ /* join. If the binds don't mismatch, then perform */ /* the appropriate action for the logic of the join. */ /*===================================================*/ while (comparePMs != NULL) { /*===========================================================*/ /* Initialize some variables pointing to the partial matches */ /* in the LHS and RHS of the join. In addition, check for */ /* certain conditions under which the partial match can be */ /* skipped since it's not a "real" partial match. */ /*===========================================================*/ if (enterDirection == RHS) { lhsBinds = comparePMs; /*=====================================================*/ /* The partial matches entering from the LHS of a join */ /* are stored in the beta memory of the previous join */ /* (unless the current join is a join from the right */ /* or is attached to a not CE). If the previous join */ /* is a join from the right or associated with a not */ /* CE, then some of its partial matches in its beta */ /* memory will not be "real" partial matches. That is, */ /* there may be a partial match in the alpha memory */ /* that prevents the partial match from satisfying the */ /* join's conditions. If this is the case, then the */ /* counterf flag in the partial match will be set to */ /* TRUE and in this case, we move on to the next */ /* partial match to be checked. */ /*=====================================================*/ if (lhsBinds->counterf && (join->patternIsNegated == FALSE) && (join->joinFromTheRight == FALSE)) { comparePMs = comparePMs->next; continue; } /*==================================================*/ /* If the join is associated with a not CE or has a */ /* join from the right, then the LHS partial match */ /* currently being checked may already have a */ /* partial match from the alpha memory preventing */ /* it from being satisfied. If this is the case, */ /* then move on to the next partial match in the */ /* beta memory of the join. */ /*==================================================*/ if ((join->patternIsNegated || join->joinFromTheRight) && (lhsBinds->counterf)) { comparePMs = comparePMs->next; continue; } } else { rhsBinds = comparePMs; } /*========================================================*/ /* If the join has no expression associated with it, then */ /* the new partial match derived from the LHS and RHS */ /* partial matches is valid. In the event that the join */ /* is a join from the right, it must also be checked that */ /* the RHS partial match is the same partial match that */ /* the LHS partial match was generated from. Each LHS */ /* partial match in a join from the right corresponds */ /* uniquely to a partial match from the RHS of the join. */ /* To determine whether the LHS partial match is the one */ /* associated with the RHS partial match, we compare the */ /* the entity addresses found in the partial matches to */ /* make sure they're equal. */ /*========================================================*/ if (join->networkTest == NULL) { exprResult = TRUE; if (join->joinFromTheRight) { int i; for (i = 0; i < (int) (lhsBinds->bcount - 1); i++) { if (lhsBinds->binds[i].gm.theMatch != rhsBinds->binds[i].gm.theMatch) { exprResult = FALSE; break; } } } } /*=========================================================*/ /* If the join has an expression associated with it, then */ /* evaluate the expression to determine if the new partial */ /* match derived from the LHS and RHS partial matches is */ /* valid (i.e. variable bindings are consistent and */ /* predicate expressions evaluate to TRUE). */ /*=========================================================*/ else { exprResult = EvaluateJoinExpression(theEnv,join->networkTest,lhsBinds,rhsBinds,join); if (EvaluationData(theEnv)->EvaluationError) { if (join->patternIsNegated) exprResult = TRUE; SetEvaluationError(theEnv,FALSE); } } /*====================================================*/ /* If the join expression evaluated to TRUE (i.e. */ /* there were no conflicts between variable bindings, */ /* all tests were satisfied, etc.), then perform the */ /* appropriate action given the logic of this join. */ /*====================================================*/ if (exprResult != FALSE) { /*==============================================*/ /* Use the PPDrive routine when the join isn't */ /* associated with a not CE and it doesn't have */ /* a join from the right. */ /*==============================================*/ if ((join->patternIsNegated == FALSE) && (join->joinFromTheRight == FALSE)) { PPDrive(theEnv,lhsBinds,rhsBinds,join); } /*=====================================================*/ /* Use the PNRDrive routine when the new partial match */ /* enters from the RHS of the join and the join either */ /* is associated with a not CE or has a join from the */ /* right. */ /*=====================================================*/ else if (enterDirection == RHS) { PNRDrive(theEnv,join,comparePMs,rhsBinds); } /*===========================================================*/ /* If the new partial match entered from the LHS of the join */ /* and the join is either associated with a not CE or the */ /* join has a join from the right, then mark the LHS partial */ /* match indicating that there is a RHS partial match */ /* preventing this join from being satisfied. Once this has */ /* happened, the other RHS partial matches don't have to be */ /* tested since it only takes one partial match to prevent */ /* the LHS from being satisfied. */ /*===========================================================*/ else if (enterDirection == LHS) { binds->binds[binds->bcount - 1].gm.theValue = (void *) rhsBinds; comparePMs = NULL; continue; } } /*====================================*/ /* Move on to the next partial match. */ /*====================================*/ comparePMs = comparePMs->next; } /*==================================================================*/ /* If a join with an associated not CE or join from the right was */ /* entered from the LHS side of the join, and the join expression */ /* failed for all sets of matches for the new bindings on the LHS */ /* side (there was no RHS partial match preventing the LHS partial */ /* match from being satisfied), then the LHS partial match appended */ /* with an pseudo-fact that represents the instance of the not */ /* pattern or join from the right that was satisfied should be sent */ /* to the joins below this join. */ /*==================================================================*/ if ((join->patternIsNegated || join->joinFromTheRight) && (enterDirection == LHS) && (binds->binds[binds->bcount - 1].gm.theValue == NULL)) { PNLDrive(theEnv,join,binds); } return; } /*******************************************************/ /* EvaluateJoinExpression: Evaluates join expressions. */ /* Performs a faster evaluation for join expressions */ /* than if EvaluateExpression was used directly. */ /*******************************************************/ globle intBool EvaluateJoinExpression( void *theEnv, struct expr *joinExpr, struct partialMatch *lbinds, struct partialMatch *rbinds, struct joinNode *joinPtr) { DATA_OBJECT theResult; int andLogic, result = TRUE; struct partialMatch *oldLHSBinds; struct partialMatch *oldRHSBinds; struct joinNode *oldJoin; /*======================================*/ /* A NULL expression evaluates to TRUE. */ /*======================================*/ if (joinExpr == NULL) return(TRUE); /*=========================================*/ /* Initialize some of the global variables */ /* used when evaluating expressions. */ /*=========================================*/ oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds; oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds; oldJoin = EngineData(theEnv)->GlobalJoin; EngineData(theEnv)->GlobalLHSBinds = lbinds; EngineData(theEnv)->GlobalRHSBinds = rbinds; EngineData(theEnv)->GlobalJoin = joinPtr; /*=====================================================*/ /* Partial matches stored in joins that are associated */ /* with a not CE contain an additional slot shouldn't */ /* be considered when evaluating expressions. Since */ /* joins that have joins from the right don't have any */ /* expression, we don't have to do this for partial */ /* matches contained in these joins. */ /*=====================================================*/ if (joinPtr->patternIsNegated) lbinds->bcount--; /*====================================================*/ /* Initialize some variables which allow this routine */ /* to avoid calling the "and" and "or" functions if */ /* they are the first part of the expression to be */ /* evaluated. Most of the join expressions do not use */ /* deeply nested and/or functions so this technique */ /* speeds up evaluation. */ /*====================================================*/ if (joinExpr->value == ExpressionData(theEnv)->PTR_AND) { andLogic = TRUE; joinExpr = joinExpr->argList; } else if (joinExpr->value == ExpressionData(theEnv)->PTR_OR) { andLogic = FALSE; joinExpr = joinExpr->argList; } else { andLogic = TRUE; } /*=========================================*/ /* Evaluate each of the expressions linked */ /* together in the join expression. */ /*=========================================*/ while (joinExpr != NULL) { /*================================*/ /* Evaluate a primitive function. */ /*================================*/ if ((EvaluationData(theEnv)->PrimitivesArray[joinExpr->type] == NULL) ? FALSE : EvaluationData(theEnv)->PrimitivesArray[joinExpr->type]->evaluateFunction != NULL) { struct expr *oldArgument; oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = joinExpr; result = (*EvaluationData(theEnv)->PrimitivesArray[joinExpr->type]->evaluateFunction)(theEnv,joinExpr->value,&theResult); EvaluationData(theEnv)->CurrentExpression = oldArgument; } /*=============================*/ /* Evaluate the "or" function. */ /*=============================*/ else if (joinExpr->value == ExpressionData(theEnv)->PTR_OR) { result = FALSE; if (EvaluateJoinExpression(theEnv,joinExpr,lbinds,rbinds,joinPtr) == TRUE) { if (EvaluationData(theEnv)->EvaluationError) { if (joinPtr->patternIsNegated) lbinds->bcount++; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(FALSE); } result = TRUE; } else if (EvaluationData(theEnv)->EvaluationError) { if (joinPtr->patternIsNegated) lbinds->bcount++; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(FALSE); } } /*==============================*/ /* Evaluate the "and" function. */ /*==============================*/ else if (joinExpr->value == ExpressionData(theEnv)->PTR_AND) { result = TRUE; if (EvaluateJoinExpression(theEnv,joinExpr,lbinds,rbinds,joinPtr) == FALSE) { if (EvaluationData(theEnv)->EvaluationError) { if (joinPtr->patternIsNegated) lbinds->bcount++; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(FALSE); } result = FALSE; } else if (EvaluationData(theEnv)->EvaluationError) { if (joinPtr->patternIsNegated) lbinds->bcount++; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(FALSE); } } /*==========================================================*/ /* Evaluate all other expressions using EvaluateExpression. */ /*==========================================================*/ else { EvaluateExpression(theEnv,joinExpr,&theResult); if (EvaluationData(theEnv)->EvaluationError) { JoinNetErrorMessage(theEnv,joinPtr); if (joinPtr->patternIsNegated) lbinds->bcount++; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(FALSE); } if ((theResult.value == EnvFalseSymbol(theEnv)) && (theResult.type == SYMBOL)) { result = FALSE; } else { result = TRUE; } } /*====================================*/ /* Handle the short cut evaluation of */ /* the "and" and "or" functions. */ /*====================================*/ if ((andLogic == TRUE) && (result == FALSE)) { if (joinPtr->patternIsNegated) lbinds->bcount++; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(FALSE); } else if ((andLogic == FALSE) && (result == TRUE)) { if (joinPtr->patternIsNegated) lbinds->bcount++; EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; return(TRUE); } /*==============================================*/ /* Move to the next expression to be evaluated. */ /*==============================================*/ joinExpr = joinExpr->nextArg; } /*=======================================*/ /* Restore some of the global variables. */ /*=======================================*/ EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds; EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds; EngineData(theEnv)->GlobalJoin = oldJoin; /*=====================================*/ /* Restore the count value for the LHS */ /* binds if it had to be modified. */ /*=====================================*/ if (joinPtr->patternIsNegated) lbinds->bcount++; /*=================================================*/ /* Return the result of evaluating the expression. */ /*=================================================*/ return(result); } /*******************************************************************/ /* PPDrive: Handles the merging of an alpha memory partial match */ /* with a beta memory partial match for a join that has positive */ /* LHS entry and positive RHS entry. The partial matches being */ /* merged have previously been checked to determine that they */ /* satisify the constraints for the join. Once merged, the new */ /* partial match is sent to each child join of the join from */ /* which the merge took place. */ /*******************************************************************/ static void PPDrive( void *theEnv, struct partialMatch *lhsBinds, struct partialMatch *rhsBinds, struct joinNode *join) { struct partialMatch *linker; struct joinNode *listOfJoins; /*==================================================*/ /* Merge the alpha and beta memory partial matches. */ /*==================================================*/ linker = MergePartialMatches(theEnv,lhsBinds,rhsBinds, (join->ruleToActivate == NULL) ? 0 : 1, (int) join->logicalJoin); /*=======================================================*/ /* Add the partial match to the beta memory of the join. */ /*=======================================================*/ linker->next = join->beta; join->beta = linker; /*====================================================*/ /* Activate the rule satisfied by this partial match. */ /*====================================================*/ if (join->ruleToActivate != NULL) AddActivation(theEnv,join->ruleToActivate,linker); /*================================================*/ /* Send the new partial match to all child joins. */ /*================================================*/ listOfJoins = join->nextLevel; if (listOfJoins != NULL) { if (((struct joinNode *) (listOfJoins->rightSideEntryStructure)) == join) { NetworkAssert(theEnv,linker,listOfJoins,RHS); } else while (listOfJoins != NULL) { NetworkAssert(theEnv,linker,listOfJoins,LHS); listOfJoins = listOfJoins->rightDriveNode; } } return; } /**********************************************************************/ /* PNRDrive: Handles the entry of a partial match from the RHS of a */ /* join that has positive LHS entry and negative RHS entry (meaning */ /* the conditional element associated with this join is a not */ /* conditional element). Entry of the alpha memory partial match */ /* will cause the counterf value of the associated beta memory */ /* partial match to be set. This in turn may cause partial matches */ /* associated with the beta memory partial match to be removed from */ /* the network. */ /**********************************************************************/ static void PNRDrive( void *theEnv, struct joinNode *join, struct partialMatch *lhsBinds, struct partialMatch *rhsBinds) { struct joinNode *listOfJoins; /*==================================================*/ /* If the partial match already has a partial match */ /* in the alpha memory which prevents it from being */ /* satisfied, then don't do anything. */ /*==================================================*/ if (lhsBinds->counterf == TRUE) return; /*=================================================*/ /* Set the counterf flag to indicate that an alpha */ /* memory partial match is preventing the beta */ /* memory partial match from being satisfied. */ /*=================================================*/ lhsBinds->counterf = TRUE; /*===================================================================*/ /* If the partial match caused an activation, remove the activation. */ /*===================================================================*/ if ((lhsBinds->activationf) ? (lhsBinds->binds[lhsBinds->bcount].gm.theValue != NULL) : FALSE) { RemoveActivation(theEnv,(struct activation *) lhsBinds->binds[lhsBinds->bcount].gm.theValue,TRUE,TRUE); } /*===========================================================*/ /* The counterf flag was FALSE. This means that a pointer to */ /* the pseudo-fact matching the not CE is stored directly in */ /* the partial match. Determine the ID of this pseudo-fact */ /* and remove all partial matches from descendent joins that */ /* contain the ID. */ /*===========================================================*/ if (join->joinFromTheRight) /* GDR 111599 #834 Begin */ { RetractCheckDriveRetractions(theEnv,lhsBinds->binds[lhsBinds->bcount - 1].gm.theMatch, (int) join->depth-1); } /* GDR 111599 #834 End */ listOfJoins = join->nextLevel; if (listOfJoins != NULL) { if (((struct joinNode *) (listOfJoins->rightSideEntryStructure)) == join) { NegEntryRetract(theEnv,listOfJoins,lhsBinds,NULL); } else while (listOfJoins != NULL) { PosEntryRetract(theEnv,listOfJoins, lhsBinds->binds[lhsBinds->bcount - 1].gm.theMatch, lhsBinds,(int) join->depth-1,NULL); listOfJoins = listOfJoins->rightDriveNode; } } /*=========================================================================*/ /* Remove any logical dependency links associated with this partial match. */ /*=========================================================================*/ if (lhsBinds->dependentsf) RemoveLogicalSupport(theEnv,lhsBinds); /*========================================*/ /* Put the pseudo-fact on a garbage list. */ /*========================================*/ lhsBinds->binds[lhsBinds->bcount - 1].gm.theMatch->next = EngineData(theEnv)->GarbageAlphaMatches; EngineData(theEnv)->GarbageAlphaMatches = lhsBinds->binds[lhsBinds->bcount - 1].gm.theMatch; /*========================================================*/ /* Store the partial match from the alpha memory that is */ /* preventing the LHS partial match from being satisfied. */ /*========================================================*/ lhsBinds->binds[lhsBinds->bcount - 1].gm.theValue = (void *) rhsBinds; } /********************************************************************/ /* PNLDrive: Handles the entry of a partial match from the LHS of a */ /* join that has positive LHS entry and negative RHS entry */ /* (meaning the conditional element associated with this join is */ /* a not conditional element). An new partial match is created by */ /* combining the match from the beta memory with a "pseudo" */ /* partial match corresponding to the facts which didn't match */ /* the not CE. Once merged, the new partial match is sent to each */ /* child join of the join from which the merge took place. */ /********************************************************************/ globle void PNLDrive( void *theEnv, struct joinNode *join, struct partialMatch *binds) { struct joinNode *listOfJoins; struct alphaMatch *tempAlpha; /*=======================================================*/ /* Create a pseudo-fact representing the facts which did */ /* not match the not CE associated with this join. */ /*=======================================================*/ tempAlpha = get_struct(theEnv,alphaMatch); tempAlpha->next = NULL; tempAlpha->matchingItem = NULL; tempAlpha->markers = NULL; /*===============================================*/ /* Store the pointer to the pseudo-fact directly */ /* in the beta memory partial match. */ /*===============================================*/ binds->counterf = FALSE; binds->binds[binds->bcount - 1].gm.theMatch = tempAlpha; /*====================================================*/ /* Activate the rule satisfied by this partial match. */ /*====================================================*/ if (join->ruleToActivate != NULL) AddActivation(theEnv,join->ruleToActivate,binds); /*========================================================*/ /* Send the merged partial match to all descendent joins. */ /*========================================================*/ listOfJoins = join->nextLevel; if (listOfJoins != NULL) { if (((struct joinNode *) (listOfJoins->rightSideEntryStructure)) == join) { NetworkAssert(theEnv,binds,listOfJoins,RHS); } else while (listOfJoins != NULL) { NetworkAssert(theEnv,binds,listOfJoins,LHS); listOfJoins = listOfJoins->rightDriveNode; } } } /***************************************************************/ /* EmptyDrive: Handles the entry of a alpha memory partial */ /* match from the RHS of a join that is the first join of */ /* a rule (i.e. a join that cannot be entered from the LHS). */ /***************************************************************/ static void EmptyDrive( void *theEnv, struct joinNode *join, struct partialMatch *rhsBinds) { struct partialMatch *linker; struct joinNode *listOfJoins; int joinExpr; /*======================================================*/ /* Determine if the alpha memory partial match satifies */ /* the join expression. If it doesn't then no further */ /* action is taken. */ /*======================================================*/ if (join->networkTest != NULL) { joinExpr = EvaluateJoinExpression(theEnv,join->networkTest,NULL,rhsBinds,join); EvaluationData(theEnv)->EvaluationError = FALSE; if (joinExpr == FALSE) return; } /*===========================================================*/ /* The first join of a rule cannot be connected to a NOT CE. */ /*===========================================================*/ if (join->patternIsNegated == TRUE) { SystemError(theEnv,"DRIVE",2); EnvExitRouter(theEnv,EXIT_FAILURE); } /*=========================================================*/ /* If the join's RHS entry is associated with a pattern CE */ /* (positive entry), then copy the alpha memory partial */ /* match and send it to all child joins. */ /*=========================================================*/ linker = CopyPartialMatch(theEnv,rhsBinds, (join->ruleToActivate == NULL) ? 0 : 1, (int) join->logicalJoin); /*=======================================================*/ /* Add the partial match to the beta memory of the join. */ /*=======================================================*/ linker->next = join->beta; join->beta = linker; /*====================================================*/ /* Activate the rule satisfied by this partial match. */ /*====================================================*/ if (join->ruleToActivate != NULL) AddActivation(theEnv,join->ruleToActivate,linker); /*============================================*/ /* Send the partial match to all child joins. */ /*============================================*/ listOfJoins = join->nextLevel; while (listOfJoins != NULL) { NetworkAssert(theEnv,linker,listOfJoins,LHS); listOfJoins = listOfJoins->rightDriveNode; } } /********************************************************************/ /* JoinNetErrorMessage: Prints an informational message indicating */ /* which join of a rule generated an error when a join expression */ /* was being evaluated. */ /********************************************************************/ static void JoinNetErrorMessage( void *theEnv, struct joinNode *joinPtr) { char buffer[60]; PrintErrorID(theEnv,"DRIVE",1,TRUE); EnvPrintRouter(theEnv,WERROR,"This error occurred in the join network\n"); sprintf(buffer," Problem resides in join #%d in rule(s):\n",joinPtr->depth); EnvPrintRouter(theEnv,WERROR,buffer); TraceErrorToRule(theEnv,joinPtr," "); EnvPrintRouter(theEnv,WERROR,"\n"); } #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/ed.h0000755000175000017500000004133610176267162013312 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* EMACS HEADER FILE */ /*******************************************************/ /* * This file is the general header file for all parts of the MicroEMACS * display editor. It contains definitions used by everyone, and it contains * the stuff you have to edit to create a version of the editor for a * specific operating system and terminal. */ #ifndef _EDITOR_HEADER_ #define _EDITOR_HEADER_ #include #define _STDIO_INCLUDED_ #include #include #include "argacces.h" #include "constant.h" #include "constrct.h" #include "memalloc.h" #include "evaluatn.h" #include "router.h" #include "scanner.h" #include "symbol.h" #if VAX_VMS #define ANSI 1 /* Normally used for VAX VMS */ #define VT52 0 /* VT52 terminal (Zenith). */ #define TERMCAP 0 /* Use TERMCAP */ #define IBM_PC 0 /* Standard IBM PC BIOS */ #endif #if UNIX_7 || UNIX_V #define ANSI 0 /* Normally used for VAX VMS */ #define VT52 0 /* VT52 terminal (Zenith). */ #define TERMCAP 1 /* Use TERMCAP */ #define IBM_PC 0 /* Standard IBM PC BIOS */ #endif #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB #define ANSI 0 /* Normally used for VAX VMS */ #define VT52 0 /* VT52 terminal (Zenith). */ #define TERMCAP 0 /* Use TERMCAP */ #define IBM_PC 1 /* Standard IBM PC BIOS */ #endif #if IBM_GCC #define ANSI 0 /* Normally used for VAX VMS */ #define VT52 0 /* VT52 terminal (Zenith). */ #define TERMCAP 0 /* Use TERMCAP */ #define IBM_PC 1 /* Standard IBM PC BIOS */ #endif #define CVMVAS 1 /* C-V, M-V arg. in screens. */ #define VERSION_NUM "3.0" /* Emacs editor Version number */ #define NFILEN 256 /* # of bytes, file name */ #define NBUFN 16 /* # of bytes, buffer name */ #define NLINE 256 /* # of bytes, line */ #define NKBDM 256 /* # of strokes, keyboard macro */ #define NPAT 80 /* # of bytes, pattern */ #define HUGE 1000 /* Huge number */ #define AGRAVE 0x60 /* M- prefix, Grave (LK201) */ #define METACH 0x1B /* M- prefix, Control-[, ESC */ #define CTMECH 0x1C /* C-M- prefix, Control-\ */ #define EXITCH 0x1D /* Exit level, Control-] */ #define COTLCH 0x1E /* C- prefix, Control-^ */ #define HELPCH 0x1F /* Help key, Control-_ */ #define DEL_KEY 0x7F /* Del key, most keyboards */ #define COTL 0x0100 /* Control flag, or'ed in */ #define META 0x0200 /* Meta flag, or'ed in */ #define CTLX 0x0400 /* ^X flag, or'ed in */ #define ABORT 2 /* Death, ^G, abort, etc. */ #define FIOSUC 0 /* File I/O, success. */ #define FIOFNF 1 /* File I/O, file not found. */ #define FIOEOF 2 /* File I/O, end of file. */ #define FIOERR 3 /* File I/O, error. */ #define CFCPCN 0x0001 /* Last command was C-P, C-N */ #define CFKILL 0x0002 /* Last command was a kill */ /* * There is a window structure allocated for every active display window. The * windows are kept in a big list, in top to bottom screen order, with the * listhead at "wheadp". Each window contains its own values of dot and mark. * The flag field contains some bits that are set by commands to guide * redisplay; although this is a bit of a compromise in terms of decoupling, * the full blown redisplay is just too expensive to run for every input * character. */ typedef struct WINDOW { struct WINDOW *w_wndp; /* Next window */ struct BUFFER *w_bufp; /* Buffer displayed in window */ struct LINE *w_linep; /* Top line in the window */ struct LINE *w_dotp; /* Line containing "." */ short w_doto; /* Byte offset for "." */ struct LINE *w_markp; /* Line containing "mark" */ short w_marko; /* Byte offset for "mark" */ char w_toprow; /* Origin 0 top row of window */ char w_ntrows; /* # of rows of text in window */ char w_force; /* If NZ, forcing row. */ char w_flag; /* Flags. */ } WINDOW; #define WFFORCE 0x01 /* Window needs forced reframe */ #define WFMOVE 0x02 /* Movement from line to line */ #define WFEDIT 0x04 /* Editing within a line */ #define WFHARD 0x08 /* Better to a full display */ #define WFMODE 0x10 /* Update mode line. */ /* * Text is kept in buffers. A buffer header, described below, exists for every * buffer in the system. The buffers are kept in a big list, so that commands * that search for a buffer by name can find the buffer header. There is a * safe store for the dot and mark in the header, but this is only valid if * the buffer is not being displayed (that is, if "b_nwnd" is 0). The text for * the buffer is kept in a circularly linked list of lines, with a pointer to * the header line in "b_linep". */ typedef struct BUFFER { struct BUFFER *b_bufp; /* Link to next BUFFER */ struct LINE *b_dotp; /* Link to "." LINE structure */ short b_doto; /* Offset of "." in above LINE */ struct LINE *b_markp; /* The same as the above two, */ short b_marko; /* but for the "mark" */ struct LINE *b_linep; /* Link to the header LINE */ char b_nwnd; /* Count of windows on buffer */ char b_flag; /* Flags */ char b_fname[NFILEN]; /* File name */ char b_bname[NBUFN]; /* Buffer name */ } BUFFER; #define BFTEMP 0x01 /* Internal temporary buffer */ #define BFCHG 0x02 /* Changed since last write */ /* * The starting position of a region, and the size of the region in * characters, is kept in a region structure. Used by the region commands. */ typedef struct { struct LINE *r_linep; /* Origin LINE address. */ short r_offset; /* Origin LINE offset. */ long r_size; /* Length in characters. */ } REGION; /* * All text is kept in circularly linked lists of "LINE" structures. These * begin at the header line (which is the blank line beyond the end of the * buffer). This line is pointed to by the "BUFFER". Each line contains a the * number of bytes in the line (the "used" size), the size of the text array, * and the text. The end of line is not stored as a byte; it's implied. Future * additions will include update hints, and a list of marks into the line. */ typedef struct LINE { struct LINE *l_fp; /* Link to the next line */ struct LINE *l_bp; /* Link to the previous line */ short l_size; /* Allocated size */ short l_used; /* Used size */ char l_text[1]; /* A bunch of characters. */ } LINE; #define lforw(lp) ((lp)->l_fp) #define lback(lp) ((lp)->l_bp) #define lgetc(lp, n) ((lp)->l_text[(int) (n)]&0xFF) #define lputc(lp, n, c) ((lp)->l_text[(int) (n)]= (char) (c)) #define llength(lp) ((lp)->l_used) /* * The editor communicates with the display using a high level interface. A * "TERM" structure holds useful variables, and indirect pointers to routines * that do useful operations. The low level get and put routines are here too. * This lets a terminal, in addition to having non standard commands, have * funny get and put character code too. The calls might get changed to * "termp->t_field" style in the future, to make it possible to run more than * one terminal type. */ typedef struct { short t_nrow; /* Number of rows. */ short t_ncol; /* Number of columns. */ VOID (*t_open)(void); /* Open terminal at the start. */ VOID (*t_close)(void); /* Close terminal at end. */ int (*t_getchar)(void); /* Get character from keyboard. */ VOID (*t_putchar)(int); /* Put character to display. */ VOID (*t_flush)(void); /* Flush output buffers. */ VOID (*t_move)(int,int); /* Move the cursor, origin 0. */ VOID (*t_eeol)(void); /* Erase to end of line. */ VOID (*t_eeop)(void); /* Erase to end of page. */ VOID (*t_beep)(void); /* Beep. */ } TERM; #if IBM_PC || IBM_GCC /* * This section defines the code returned by all the special keys on * a PC numeric Keypad. It could also be used to define the function * keys if desired. */ #define UP_ARROW 256 #define DOWN_ARROW 257 #define RIGHT_ARROW 258 #define LEFT_ARROW 259 #define HOME_KEY 260 #define END_KEY 261 #define PGUP_KEY 262 #define PGDN_KEY 263 #define COTL_RIGHT_ARROW 264 #define COTL_LEFT_ARROW 265 #define COTL_AT_SIGN 266 #endif #if IBM_PC || VAX_VMS #define BADKEY 999 #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _EDBASIC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int gotobol(void *,int,int); LOCALE int backchar(void *,int,int); LOCALE int gotoeol(void *,int,int); LOCALE int forwchar(void *,int,int); LOCALE int gotobob(void *,int,int); LOCALE int gotoeob(void *,int,int); LOCALE int forwline(void *,int,int); LOCALE int backline(void *,int,int); LOCALE int getgoal(LINE *); LOCALE int forwpage(void *,int,int); LOCALE int backpage(void *,int,int); LOCALE int setmark(void *,int,int); LOCALE int swapmark(void *,int,int); LOCALE int wrapword(void *); LOCALE int backword(void *,int,int); LOCALE int forwword(void *,int,int); LOCALE int upperword(void *,int,int); LOCALE int lowerword(void *,int,int); LOCALE int capword(void *,int,int); LOCALE int delfword(void *,int,int); LOCALE int delbword(void *,int,int); LOCALE int inword(void); LOCALE int killregion(void *,int,int); LOCALE int copyregion(void *,int,int); LOCALE int upperregion(void *,int,int); LOCALE int lowerregion(void *,int,int); LOCALE int getregion(REGION *); LOCALE int fileread(void *,int,int); LOCALE int filevisit(void *,int,int); LOCALE int filevisit_guts(void *,char []); LOCALE int readin(void *,char []); LOCALE int makename(char [],char []); LOCALE int filewrite(void *,int,int); LOCALE int filesave(void *,int,int); LOCALE int writeout(char *); LOCALE int filename(void *,int,int); LOCALE int ffropen(char *); LOCALE int ffwopen(char *); LOCALE int ffclose(void); LOCALE int ffputline(char [],int); LOCALE int ffgetline(char [],int); LOCALE VOID ttopen(void); LOCALE VOID ttclose(void); LOCALE VOID ttputc(int); LOCALE VOID ttflush(void); LOCALE int ttgetc(void); #if VAX_VMS LOCALE int parse_esc_seq(void); #endif #undef LOCALE #ifdef _EDMAIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE VOID edinit(void *,char []); LOCALE int execute(void *,int,int,int); LOCALE int getkey(void); LOCALE int getctl(void); LOCALE int quickexit(void *,int,int); LOCALE int edquit(void *,int,int); LOCALE int temp_quit(void *,int,int); LOCALE int ctlxlp(void *,int,int); LOCALE int ctlxrp(void *,int,int); LOCALE int ctlxe(void *,int,int); LOCALE int ctrlg(void *,int,int); LOCALE VOID full_cleanup(void *); LOCALE int kill_all_buffers(void *,BUFFER **); LOCALE int kill_all_windows(void *); LOCALE int spec_clear(void *,BUFFER *); LOCALE VOID EditCommand(void *); LOCALE VOID EditorFunctionDefinition(void *); #ifndef _EDMAIN_SOURCE_ extern int currow; extern int curcol; extern int fillcol; extern int thisflag; extern int lastflag; extern int curgoal; extern BUFFER *curbp; extern WINDOW *curwp; extern BUFFER *bheadp; extern WINDOW *wheadp; extern BUFFER *blistp; extern short kbdm[NKBDM]; extern short *kbdmip; extern short *kbdmop; extern char pat[NPAT]; extern char lastbufn[NBUFN]; extern BUFFER *CompileBufferp; #endif #undef LOCALE #ifdef _EDMISC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int compile_region(void *,int,int); LOCALE int compile_file(void *,int,int); LOCALE int get_compile(void *,char *,char *); LOCALE int region_fnd(void *,char *); LOCALE int region_getc(void *,char *); LOCALE int region_ungetc(void *,int,char *); LOCALE int buffer_fnd(void *,char *); LOCALE int buffer_getc(void *,char *); LOCALE int buffer_ungetc(void *,int,char *); LOCALE int query_cmp(void *,char *); LOCALE int print_cmp(void *,char *,char *); LOCALE VOID init_cmp_router(void *); LOCALE VOID kill_cmp_router(void *); LOCALE int setfillcol(void *,int,int); LOCALE int showcpos(void *,int,int); LOCALE int getccol(int); LOCALE int getcline(void); LOCALE int cntlines(void); LOCALE int gotoline(void *,int,int); LOCALE int twiddle(void *,int,int); LOCALE int quote(void *,int,int); LOCALE int tab(void *,int,int); LOCALE int openline(void *,int,int); LOCALE int newline(void *,int,int); LOCALE int deblank(void *,int,int); LOCALE int indent(void *,int,int); LOCALE int forwdel(void *,int,int); LOCALE int backdel(void *,int,int); LOCALE int kill_fwd(void *,int,int); LOCALE int yank(void *,int,int); LOCALE int forwsearch(void *,int,int); LOCALE int backsearch(void *,int,int); LOCALE int bkwrdrpl(void *,int,int); LOCALE int bkwrdcr(void *,int,int); LOCALE int frwsr(void *,int,int); LOCALE int querysr(void *,int,int); LOCALE int lreplace(void *,char *); LOCALE int smatchb(void *,int,int); LOCALE int searchcl(int); LOCALE int searchop(int); LOCALE int readpattern(void *,char *); LOCALE int spawncli(void *,int,int); LOCALE int spawn(void *,int,int); #if VAX_VMS LOCALE int sys(char *); #endif #undef LOCALE #ifdef _EDSTRUCT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE int usebuffer(void *,int,int); LOCALE int killbuffer(void *,int,int); LOCALE int listbuffers(void *,int,int); LOCALE int makelist(void *); LOCALE int addline(void *,BUFFER *,char *); LOCALE int anycb(void); LOCALE BUFFER *bfind(void *,char *,int,int); LOCALE int bclear(void *,BUFFER *); LOCALE LINE *lalloc(void *,int); LOCALE VOID lfree(void *,LINE *); LOCALE VOID lchange(int); LOCALE int linsert(void *,int,int); LOCALE int lnewline(void *); LOCALE int ldelete(void *,long,int); LOCALE int ldelnewline(void *); LOCALE VOID kdelete(void *); LOCALE int kinsert(void *,int); LOCALE int kremove(int); LOCALE int reposition(void *,int,int); LOCALE int EditorRefresh(void *,int,int); LOCALE int nextwind(void *,int,int); LOCALE int prevwind(void *,int,int); LOCALE int mvdnwind(void *,int,int); LOCALE int mvupwind(void *,int,int); LOCALE int onlywind(void *,int,int); LOCALE int splitwind(void *,int,int); LOCALE int enlargewind(void *,int,int); LOCALE int shrinkwind(void *,int,int); LOCALE WINDOW *wpopup(void *); LOCALE VOID vtinit(void *); LOCALE VOID vttidy(void); LOCALE VOID vtmove(int,int); LOCALE VOID vtputc(int); LOCALE VOID vteeol(void); LOCALE VOID update(void); LOCALE VOID updateline(int,char [],char []); LOCALE VOID modeline(WINDOW *); LOCALE VOID movecursor(int,int); LOCALE VOID mlerase(void); LOCALE int mlyesno(void *,char *); LOCALE int mlreply(void *,char *,char *,int); LOCALE VOID mlwrite(char *,...); LOCALE VOID mlputs(char *); LOCALE VOID mlputi(int,int); LOCALE VOID mlputli(long,int); LOCALE VOID kill_video_buffers(void *); #ifndef _EDSTRUCT_SOURCE_ extern int mpresf; extern int sgarbf; #endif #ifndef _EDTERM_SOURCE_ extern TERM term; #endif #endif clips-6.24/clipssrc/._factrete.h0000400000175000017500000000075410441143460014703 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z1`TTFS FMWBBMPSRclips-6.24/clipssrc/._cstrnchk.c0000400000175000017500000000075410441131446014721 0ustar jfsjfsMac OS X  2 RTEXT????@TTFH Monacoc$c$V TTFS TFMWBBMPSRclips-6.24/clipssrc/._cstrnops.h0000400000175000017500000000075407422635013014766 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zp+TTF WFMWBBMPSRclips-6.24/clipssrc/reorder.h0000755000175000017500000000756607422634701014370 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* REORDER HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines necessary for converting the */ /* the LHS of a rule into an appropriate form suitable for */ /* the KB Rete topology. This includes transforming the */ /* LHS so there is at most one "or" CE (and this is the */ /* first CE of the LHS if it is used), adding initial */ /* patterns to the LHS (if no LHS is specified or a "test" */ /* or "not" CE is the first pattern within an "and" CE), */ /* removing redundant CEs, and determining appropriate */ /* information on nesting for implementing joins from the */ /* right. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_reorder #define _H_reorder struct lhsParseNode; #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_ruledef #include "ruledef.h" #endif #ifndef _H_pattern #include "pattern.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _REORDER_SOURCE_ #define LOCALE #else #define LOCALE extern #endif /***********************************************************************/ /* lhsParseNode structure: Stores information about the intermediate */ /* parsed representation of the lhs of a rule. */ /***********************************************************************/ struct lhsParseNode { unsigned short type; void *value; unsigned int negated : 1; unsigned int logical : 1; unsigned int multifieldSlot : 1; unsigned int bindingVariable : 1; unsigned int derivedConstraints : 1; unsigned int userCE : 1; unsigned int whichCE : 7; unsigned int marked : 1; unsigned int withinMultifieldSlot : 1; unsigned short multiFieldsBefore; unsigned short multiFieldsAfter; unsigned short singleFieldsBefore; unsigned short singleFieldsAfter; struct constraintRecord *constraints; struct lhsParseNode *referringNode; struct patternParser *patternType; short pattern; short index; struct symbolHashNode *slot; short slotNumber; int beginNandDepth; int endNandDepth; struct expr *networkTest; struct lhsParseNode *expression; void *userData; struct lhsParseNode *right; struct lhsParseNode *bottom; }; LOCALE struct lhsParseNode *ReorderPatterns(void *,struct lhsParseNode *,int *); LOCALE struct lhsParseNode *CopyLHSParseNodes(void *,struct lhsParseNode *); LOCALE void CopyLHSParseNode(void *,struct lhsParseNode *,struct lhsParseNode *,int); LOCALE struct lhsParseNode *GetLHSParseNode(void *); LOCALE void ReturnLHSParseNodes(void *,struct lhsParseNode *); LOCALE struct lhsParseNode *ExpressionToLHSParseNodes(void *,struct expr *); LOCALE struct expr *LHSParseNodesToExpression(void *,struct lhsParseNode *); LOCALE void AddInitialPatterns(void *,struct lhsParseNode *); #endif clips-6.24/clipssrc/rulebin.c0000755000175000017500000010532510441073041014336 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* DEFRULE BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* defrule construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* Barry Cameron */ /* */ /* Revision History: */ /* */ /* 6.24: Removed CONFLICT_RESOLUTION_STRATEGIES, */ /* DYNAMIC_SALIENCE, and LOGICAL_DEPENDENCIES */ /* compilation flags. */ /* */ /*************************************************************/ #define _RULEBIN_SOURCE_ #include "setup.h" #if DEFRULE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include #include "memalloc.h" #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "reteutil.h" #include "agenda.h" #include "engine.h" #include "retract.h" #include "rulebsc.h" #include "pattern.h" #include "moduldef.h" #include "rulebin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveExpressions(void *,FILE *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); static void BsaveJoins(void *,FILE *); static void BsaveJoin(void *,FILE *,struct joinNode *); static void BsaveDisjuncts(void *,FILE *,struct defrule *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateDefruleModule(void *,void *,long); static void UpdateDefrule(void *,void *,long); static void UpdateJoin(void *,void *,long); static void ClearBload(void *); static void DeallocateDefruleBloadData(void *); /*****************************************************/ /* DefruleBinarySetup: Installs the binary save/load */ /* feature for the defrule construct. */ /*****************************************************/ globle void DefruleBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,RULEBIN_DATA,sizeof(struct defruleBinaryData),DeallocateDefruleBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"defrule",20,BsaveFind,BsaveExpressions, BsaveStorage,BsaveBinaryItem, BloadStorage,BloadBinaryItem, ClearBload); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"defrule",20,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /*******************************************************/ /* DeallocateDefruleBloadData: Deallocates environment */ /* data for the defrule bsave functionality. */ /*******************************************************/ static void DeallocateDefruleBloadData( void *theEnv) { #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) unsigned long space; long i; struct defruleModule *theModuleItem; struct activation *theActivation, *tmpActivation; for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfJoins; i++) { DestroyAlphaBetaMemory(theEnv,DefruleBinaryData(theEnv)->JoinArray[i].beta); } for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfDefruleModules; i++) { theModuleItem = &DefruleBinaryData(theEnv)->ModuleArray[i]; theActivation = theModuleItem->agenda; while (theActivation != NULL) { tmpActivation = theActivation->next; if (theActivation->sortedBasis != NULL) { DestroyPartialMatch(theEnv,theActivation->sortedBasis); } rtn_struct(theEnv,activation,theActivation); theActivation = tmpActivation; } } space = DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct defruleModule); if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->ModuleArray,space); space = DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct defrule); if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->DefruleArray,space); space = DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct joinNode); if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->JoinArray,space); #endif } #if BLOAD_AND_BSAVE /*************************************************************/ /* BsaveFind: Determines the amount of memory needed to save */ /* the defrule and joinNode data structures in addition to */ /* the memory needed for their associated expressions. */ /*************************************************************/ static void BsaveFind( void *theEnv) { struct defrule *theDefrule, *theDisjunct; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DefruleBinaryData(theEnv)->NumberOfDefruleModules); SaveBloadCount(theEnv,DefruleBinaryData(theEnv)->NumberOfDefrules); SaveBloadCount(theEnv,DefruleBinaryData(theEnv)->NumberOfJoins); /*====================================================*/ /* Set the binary save ID for defrule data structures */ /* and count the number of each type. */ /*====================================================*/ TagRuleNetwork(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefruleModules, &DefruleBinaryData(theEnv)->NumberOfDefrules, &DefruleBinaryData(theEnv)->NumberOfJoins); /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*============================*/ /* Set the current module to */ /* the module being examined. */ /*============================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*==================================================*/ /* Loop through each defrule in the current module. */ /*==================================================*/ for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { /*================================================*/ /* Initialize the construct header for the binary */ /* save. The binary save ID has already been set. */ /*================================================*/ MarkConstructHeaderNeededItems(&theDefrule->header,theDefrule->header.bsaveID); /*===========================================*/ /* Count and mark data structures associated */ /* with dynamic salience. */ /*===========================================*/ ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDefrule->dynamicSalience); MarkNeededItems(theEnv,theDefrule->dynamicSalience); /*==========================================*/ /* Loop through each disjunct of the rule */ /* counting and marking the data structures */ /* associated with RHS actions. */ /*==========================================*/ for (theDisjunct = theDefrule; theDisjunct != NULL; theDisjunct = theDisjunct->disjunct) { ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDisjunct->actions); MarkNeededItems(theEnv,theDisjunct->actions); } } } /*===============================*/ /* Reset the bsave tags assigned */ /* to defrule data structures. */ /*===============================*/ MarkRuleNetwork(theEnv,1); } /************************************************/ /* BsaveExpressions: Saves the expressions used */ /* by defrules to the binary save file. */ /************************************************/ static void BsaveExpressions( void *theEnv, FILE *fp) { struct defrule *theDefrule, *theDisjunct; struct defmodule *theModule; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*======================================================*/ /* Set the current module to the module being examined. */ /*======================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*==================================================*/ /* Loop through each defrule in the current module. */ /*==================================================*/ for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { /*===========================================*/ /* Save the dynamic salience of the defrule. */ /*===========================================*/ BsaveExpression(theEnv,theDefrule->dynamicSalience,fp); /*===================================*/ /* Loop through each disjunct of the */ /* defrule and save its RHS actions. */ /*===================================*/ for (theDisjunct = theDefrule; theDisjunct != NULL; theDisjunct = theDisjunct->disjunct) { BsaveExpression(theEnv,theDisjunct->actions,fp); } } } /*==============================*/ /* Set the marked flag for each */ /* join in the join network. */ /*==============================*/ MarkRuleNetwork(theEnv,1); } /*****************************************************/ /* BsaveStorage: Writes out storage requirements for */ /* all defrule structures to the binary file */ /*****************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { unsigned long space; space = sizeof(long) * 3; GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); GenWrite(&DefruleBinaryData(theEnv)->NumberOfDefruleModules,(unsigned long) sizeof(long int),fp); GenWrite(&DefruleBinaryData(theEnv)->NumberOfDefrules,(unsigned long) sizeof(long int),fp); GenWrite(&DefruleBinaryData(theEnv)->NumberOfJoins,(unsigned long) sizeof(long int),fp); } /*******************************************/ /* BsaveBinaryItem: Writes out all defrule */ /* structures to the binary file. */ /*******************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { unsigned long int space; struct defrule *theDefrule; struct defmodule *theModule; struct defruleModule *theModuleItem; struct bsaveDefruleModule tempDefruleModule; /*===============================================*/ /* Write out the space required by the defrules. */ /*===============================================*/ space = (DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct bsaveDefrule)) + (DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct bsaveJoinNode)) + (DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct bsaveDefruleModule)); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); /*===============================================*/ /* Write out each defrule module data structure. */ /*===============================================*/ DefruleBinaryData(theEnv)->NumberOfDefrules = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); theModuleItem = (struct defruleModule *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&tempDefruleModule.header, &theModuleItem->header); GenWrite(&tempDefruleModule,(unsigned long) sizeof(struct bsaveDefruleModule),fp); } /*========================================*/ /* Write out each defrule data structure. */ /*========================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); theDefrule != NULL; theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule)) { BsaveDisjuncts(theEnv,fp,theDefrule); } } /*=============================*/ /* Write out the Rete Network. */ /*=============================*/ MarkRuleNetwork(theEnv,1); BsaveJoins(theEnv,fp); /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of defrules, defrule modules, and joins in the binary image */ /* (these were overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefruleModules); RestoreBloadCount(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefrules); RestoreBloadCount(theEnv,&DefruleBinaryData(theEnv)->NumberOfJoins); } /************************************************************/ /* BsaveDisjuncts: Writes out all the disjunct defrule data */ /* structures for a specific rule to the binary file. */ /************************************************************/ static void BsaveDisjuncts( void *theEnv, FILE *fp, struct defrule *theDefrule) { struct defrule *theDisjunct; struct bsaveDefrule tempDefrule; long int disjunctExpressionCount = 0L; int first; /*=========================================*/ /* Loop through each disjunct of the rule. */ /*=========================================*/ for (theDisjunct = theDefrule, first = TRUE; theDisjunct != NULL; theDisjunct = theDisjunct->disjunct, first = FALSE) { DefruleBinaryData(theEnv)->NumberOfDefrules++; /*======================================*/ /* Set header and miscellaneous values. */ /*======================================*/ AssignBsaveConstructHeaderVals(&tempDefrule.header, &theDisjunct->header); tempDefrule.salience = theDisjunct->salience; tempDefrule.localVarCnt = theDisjunct->localVarCnt; tempDefrule.complexity = theDisjunct->complexity; tempDefrule.autoFocus = theDisjunct->autoFocus; /*=======================================*/ /* Set dynamic salience data structures. */ /*=======================================*/ if (theDisjunct->dynamicSalience != NULL) { if (first) { tempDefrule.dynamicSalience = ExpressionData(theEnv)->ExpressionCount; disjunctExpressionCount = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDisjunct->dynamicSalience); } else { tempDefrule.dynamicSalience = disjunctExpressionCount; } } else { tempDefrule.dynamicSalience = -1L; } /*==============================================*/ /* Set the index to the disjunct's RHS actions. */ /*==============================================*/ if (theDisjunct->actions != NULL) { tempDefrule.actions = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDisjunct->actions); } else { tempDefrule.actions = -1L; } /*=================================*/ /* Set the index to the disjunct's */ /* logical join and last join. */ /*=================================*/ tempDefrule.logicalJoin = BsaveJoinIndex(theDisjunct->logicalJoin); tempDefrule.lastJoin = BsaveJoinIndex(theDisjunct->lastJoin); /*=====================================*/ /* Set the index to the next disjunct. */ /*=====================================*/ if (theDisjunct->disjunct != NULL) { tempDefrule.disjunct = DefruleBinaryData(theEnv)->NumberOfDefrules; } else { tempDefrule.disjunct = -1L; } /*=================================*/ /* Write the disjunct to the file. */ /*=================================*/ GenWrite(&tempDefrule,(unsigned long) sizeof(struct bsaveDefrule),fp); } } /********************************************/ /* BsaveJoins: Writes out all the join node */ /* data structures to the binary file. */ /********************************************/ static void BsaveJoins( void *theEnv, FILE *fp) { struct defrule *rulePtr; struct joinNode *joinPtr; struct defmodule *theModule; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); /*===========================================*/ /* Loop through each rule and its disjuncts. */ /*===========================================*/ rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,NULL); while (rulePtr != NULL) { /*=========================================*/ /* Loop through each join of the disjunct. */ /*=========================================*/ for (joinPtr = rulePtr->lastJoin; joinPtr != NULL; joinPtr = GetPreviousJoin(joinPtr)) { if (joinPtr->marked) BsaveJoin(theEnv,fp,joinPtr); } /*=======================================*/ /* Move on to the next rule or disjunct. */ /*=======================================*/ if (rulePtr->disjunct != NULL) rulePtr = rulePtr->disjunct; else rulePtr = (struct defrule *) EnvGetNextDefrule(theEnv,rulePtr); } } } /********************************************/ /* BsaveJoin: Writes out a single join node */ /* data structure to the binary file. */ /********************************************/ static void BsaveJoin( void *theEnv, FILE *fp, struct joinNode *joinPtr) { struct bsaveJoinNode tempJoin; joinPtr->marked = 0; tempJoin.depth = joinPtr->depth; tempJoin.rhsType = joinPtr->rhsType; tempJoin.firstJoin = joinPtr->firstJoin; tempJoin.logicalJoin = joinPtr->logicalJoin; tempJoin.joinFromTheRight = joinPtr->joinFromTheRight; tempJoin.patternIsNegated = joinPtr->patternIsNegated; if (joinPtr->joinFromTheRight) { tempJoin.rightSideEntryStructure = BsaveJoinIndex(joinPtr->rightSideEntryStructure); } else { tempJoin.rightSideEntryStructure = -1L; } tempJoin.lastLevel = BsaveJoinIndex(joinPtr->lastLevel); tempJoin.nextLevel = BsaveJoinIndex(joinPtr->nextLevel); tempJoin.rightMatchNode = BsaveJoinIndex(joinPtr->rightMatchNode); tempJoin.rightDriveNode = BsaveJoinIndex(joinPtr->rightDriveNode); tempJoin.networkTest = HashedExpressionIndex(theEnv,joinPtr->networkTest); if (joinPtr->ruleToActivate != NULL) { tempJoin.ruleToActivate = GetDisjunctIndex(joinPtr->ruleToActivate); } else { tempJoin.ruleToActivate = -1L; } GenWrite(&tempJoin,(unsigned long) sizeof(struct bsaveJoinNode),fp); } /***********************************************************/ /* AssignBsavePatternHeaderValues: Assigns the appropriate */ /* values to a bsave pattern header record. */ /***********************************************************/ globle void AssignBsavePatternHeaderValues( struct bsavePatternNodeHeader *theBsaveHeader, struct patternNodeHeader *theHeader) { theBsaveHeader->multifieldNode = theHeader->multifieldNode; theBsaveHeader->entryJoin = BsaveJoinIndex(theHeader->entryJoin); theBsaveHeader->singlefieldNode = theHeader->singlefieldNode; theBsaveHeader->stopNode = theHeader->stopNode; theBsaveHeader->beginSlot = theHeader->beginSlot; theBsaveHeader->endSlot = theHeader->endSlot; } #endif /* BLOAD_AND_BSAVE */ /************************************************/ /* BloadStorage: Loads storage requirements for */ /* the defrules used by this binary image. */ /************************************************/ static void BloadStorage( void *theEnv) { unsigned long space; /*=================================================*/ /* Determine the number of defrule, defruleModule, */ /* and joinNode data structures to be read. */ /*=================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefruleModules,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->NumberOfDefrules,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&DefruleBinaryData(theEnv)->NumberOfJoins,(unsigned long) sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* defruleModule data structures. */ /*===================================*/ if (DefruleBinaryData(theEnv)->NumberOfDefruleModules == 0) { DefruleBinaryData(theEnv)->ModuleArray = NULL; DefruleBinaryData(theEnv)->DefruleArray = NULL; DefruleBinaryData(theEnv)->JoinArray = NULL; } space = DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct defruleModule); DefruleBinaryData(theEnv)->ModuleArray = (struct defruleModule *) genlongalloc(theEnv,space); /*===============================*/ /* Allocate the space needed for */ /* the defrule data structures. */ /*===============================*/ if (DefruleBinaryData(theEnv)->NumberOfDefrules == 0) { DefruleBinaryData(theEnv)->DefruleArray = NULL; DefruleBinaryData(theEnv)->JoinArray = NULL; return; } space = DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct defrule); DefruleBinaryData(theEnv)->DefruleArray = (struct defrule *) genlongalloc(theEnv,space); /*===============================*/ /* Allocate the space needed for */ /* the joinNode data structures. */ /*===============================*/ space = DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct joinNode); DefruleBinaryData(theEnv)->JoinArray = (struct joinNode *) genlongalloc(theEnv,space); } /****************************************************/ /* BloadBinaryItem: Loads and refreshes the defrule */ /* constructs used by this binary image. */ /****************************************************/ static void BloadBinaryItem( void *theEnv) { unsigned long space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); /*===========================================*/ /* Read in the defruleModule data structures */ /* and refresh the pointers. */ /*===========================================*/ BloadandRefresh(theEnv,DefruleBinaryData(theEnv)->NumberOfDefruleModules,(unsigned) sizeof(struct bsaveDefruleModule), UpdateDefruleModule); /*=====================================*/ /* Read in the defrule data structures */ /* and refresh the pointers. */ /*=====================================*/ BloadandRefresh(theEnv,DefruleBinaryData(theEnv)->NumberOfDefrules,(unsigned) sizeof(struct bsaveDefrule), UpdateDefrule); /*======================================*/ /* Read in the joinNode data structures */ /* and refresh the pointers. */ /*======================================*/ BloadandRefresh(theEnv,DefruleBinaryData(theEnv)->NumberOfJoins,(unsigned) sizeof(struct bsaveJoinNode), UpdateJoin); } /**********************************************/ /* UpdateDefruleModule: Bload refresh routine */ /* for defrule module data structures. */ /**********************************************/ static void UpdateDefruleModule( void *theEnv, void *buf, long obji) { struct bsaveDefruleModule *bdmPtr; bdmPtr = (struct bsaveDefruleModule *) buf; UpdateDefmoduleItemHeader(theEnv,&bdmPtr->header,&DefruleBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(struct defrule), (void *) DefruleBinaryData(theEnv)->DefruleArray); DefruleBinaryData(theEnv)->ModuleArray[obji].agenda = NULL; } /****************************************/ /* UpdateDefrule: Bload refresh routine */ /* for defrule data structures. */ /****************************************/ static void UpdateDefrule( void *theEnv, void *buf, long obji) { struct bsaveDefrule *br; br = (struct bsaveDefrule *) buf; UpdateConstructHeader(theEnv,&br->header,&DefruleBinaryData(theEnv)->DefruleArray[obji].header, (int) sizeof(struct defruleModule),(void *) DefruleBinaryData(theEnv)->ModuleArray, (int) sizeof(struct defrule),(void *) DefruleBinaryData(theEnv)->DefruleArray); DefruleBinaryData(theEnv)->DefruleArray[obji].dynamicSalience = ExpressionPointer(br->dynamicSalience); DefruleBinaryData(theEnv)->DefruleArray[obji].actions = ExpressionPointer(br->actions); DefruleBinaryData(theEnv)->DefruleArray[obji].logicalJoin = BloadJoinPointer(br->logicalJoin); DefruleBinaryData(theEnv)->DefruleArray[obji].lastJoin = BloadJoinPointer(br->lastJoin); DefruleBinaryData(theEnv)->DefruleArray[obji].disjunct = BloadDefrulePointer(DefruleBinaryData(theEnv)->DefruleArray,br->disjunct); DefruleBinaryData(theEnv)->DefruleArray[obji].salience = br->salience; DefruleBinaryData(theEnv)->DefruleArray[obji].localVarCnt = br->localVarCnt; DefruleBinaryData(theEnv)->DefruleArray[obji].complexity = br->complexity; DefruleBinaryData(theEnv)->DefruleArray[obji].autoFocus = br->autoFocus; DefruleBinaryData(theEnv)->DefruleArray[obji].executing = 0; DefruleBinaryData(theEnv)->DefruleArray[obji].afterBreakpoint = 0; #if DEBUGGING_FUNCTIONS DefruleBinaryData(theEnv)->DefruleArray[obji].watchActivation = AgendaData(theEnv)->WatchActivations; DefruleBinaryData(theEnv)->DefruleArray[obji].watchFiring = DefruleData(theEnv)->WatchRules; #endif } /*************************************/ /* UpdateJoin: Bload refresh routine */ /* for joinNode data structures. */ /*************************************/ static void UpdateJoin( void *theEnv, void *buf, long obji) { struct bsaveJoinNode *bj; bj = (struct bsaveJoinNode *) buf; DefruleBinaryData(theEnv)->JoinArray[obji].firstJoin = bj->firstJoin; DefruleBinaryData(theEnv)->JoinArray[obji].logicalJoin = bj->logicalJoin; DefruleBinaryData(theEnv)->JoinArray[obji].joinFromTheRight = bj->joinFromTheRight; DefruleBinaryData(theEnv)->JoinArray[obji].patternIsNegated = bj->patternIsNegated; DefruleBinaryData(theEnv)->JoinArray[obji].depth = bj->depth; DefruleBinaryData(theEnv)->JoinArray[obji].rhsType = bj->rhsType; DefruleBinaryData(theEnv)->JoinArray[obji].networkTest = HashedExpressionPointer(bj->networkTest); DefruleBinaryData(theEnv)->JoinArray[obji].nextLevel = BloadJoinPointer(bj->nextLevel); DefruleBinaryData(theEnv)->JoinArray[obji].lastLevel = BloadJoinPointer(bj->lastLevel); if (bj->joinFromTheRight == TRUE) { DefruleBinaryData(theEnv)->JoinArray[obji].rightSideEntryStructure = (void *) BloadJoinPointer(bj->rightSideEntryStructure); } DefruleBinaryData(theEnv)->JoinArray[obji].rightMatchNode = BloadJoinPointer(bj->rightMatchNode); DefruleBinaryData(theEnv)->JoinArray[obji].rightDriveNode = BloadJoinPointer(bj->rightDriveNode); DefruleBinaryData(theEnv)->JoinArray[obji].ruleToActivate = BloadDefrulePointer(DefruleBinaryData(theEnv)->DefruleArray,bj->ruleToActivate); DefruleBinaryData(theEnv)->JoinArray[obji].initialize = 0; DefruleBinaryData(theEnv)->JoinArray[obji].marked = 0; DefruleBinaryData(theEnv)->JoinArray[obji].bsaveID = 0L; DefruleBinaryData(theEnv)->JoinArray[obji].beta = NULL; } /************************************************************/ /* UpdatePatternNodeHeader: Refreshes the values in pattern */ /* node headers from the loaded binary image. */ /************************************************************/ globle void UpdatePatternNodeHeader( void *theEnv, struct patternNodeHeader *theHeader, struct bsavePatternNodeHeader *theBsaveHeader) { struct joinNode *theJoin; theHeader->singlefieldNode = theBsaveHeader->singlefieldNode; theHeader->multifieldNode = theBsaveHeader->multifieldNode; theHeader->stopNode = theBsaveHeader->stopNode; theHeader->beginSlot = theBsaveHeader->beginSlot; theHeader->endSlot = theBsaveHeader->endSlot; theHeader->initialize = 0; theHeader->marked = 0; theHeader->alphaMemory = NULL; theHeader->endOfQueue = NULL; theJoin = BloadJoinPointer(theBsaveHeader->entryJoin); theHeader->entryJoin = theJoin; while (theJoin != NULL) { theJoin->rightSideEntryStructure = (void *) theHeader; theJoin = theJoin->rightMatchNode; } } /**************************************/ /* ClearBload: Defrule clear routine */ /* when a binary load is in effect. */ /**************************************/ static void ClearBload( void *theEnv) { unsigned long int space; long i; struct patternParser *theParser = NULL; struct patternEntity *theEntity = NULL; void *theModule; /*===========================================*/ /* Delete all known entities before removing */ /* the defrule data structures. */ /*===========================================*/ GetNextPatternEntity(theEnv,&theParser,&theEntity); while (theEntity != NULL) { (*theEntity->theInfo->base.deleteFunction)(theEnv,theEntity); theEntity = NULL; GetNextPatternEntity(theEnv,&theParser,&theEntity); } /*=========================================*/ /* Remove all activations from the agenda. */ /*=========================================*/ SaveCurrentModule(theEnv); for (theModule = EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,theModule); RemoveAllActivations(theEnv); } RestoreCurrentModule(theEnv); EnvClearFocusStack(theEnv); /*==========================================================*/ /* Remove all partial matches from the beta memories in the */ /* join network. Alpha memories do not need to be examined */ /* since all pattern entities have been deleted by now. */ /*==========================================================*/ for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfJoins; i++) { FlushAlphaBetaMemory(theEnv,DefruleBinaryData(theEnv)->JoinArray[i].beta); } /*================================================*/ /* Decrement the symbol count for each rule name. */ /*================================================*/ for (i = 0; i < DefruleBinaryData(theEnv)->NumberOfDefrules; i++) { UnmarkConstructHeader(theEnv,&DefruleBinaryData(theEnv)->DefruleArray[i].header); } /*==================================================*/ /* Return the space allocated for the bload arrays. */ /*==================================================*/ space = DefruleBinaryData(theEnv)->NumberOfDefruleModules * sizeof(struct defruleModule); if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->ModuleArray,space); DefruleBinaryData(theEnv)->NumberOfDefruleModules = 0; space = DefruleBinaryData(theEnv)->NumberOfDefrules * sizeof(struct defrule); if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->DefruleArray,space); DefruleBinaryData(theEnv)->NumberOfDefrules = 0; space = DefruleBinaryData(theEnv)->NumberOfJoins * sizeof(struct joinNode); if (space != 0) genlongfree(theEnv,(void *) DefruleBinaryData(theEnv)->JoinArray,space); DefruleBinaryData(theEnv)->NumberOfJoins = 0; } /*******************************************************/ /* BloadDefruleModuleReference: Returns the defrule */ /* module pointer for using with the bload function. */ /*******************************************************/ globle void *BloadDefruleModuleReference( void *theEnv, int theIndex) { return ((void *) &DefruleBinaryData(theEnv)->ModuleArray[theIndex]); } #endif /* DEFRULE_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips-6.24/clipssrc/._objrtmch.h0000400000175000017500000000075410441150445014717 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0z0z;U''TTFS PFMWBBMPSRclips-6.24/clipssrc/._dffctpsr.c0000400000175000017500000000075410056701050014711 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z޼TTF$:FMPSRMWBBLclips-6.24/clipssrc/._utility.h0000400000175000017500000000075410441151275014614 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z<llTTFS FMWBBMPSRclips-6.24/clipssrc/._insmoddp.c0000400000175000017500000000075410441072127014717 0ustar jfsjfsMac OS X  2 RTEXT????`aTTFH Monaco0z0zއHH;ETTFHFMPSRMWBBLclips-6.24/clipssrc/._insqypsr.c0000400000175000017500000000075410441147636015002 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco0\0\9TTFS FMWBBMPSRclips-6.24/clipssrc/._tmpltpsr.h0000400000175000017500000000012207422634533014773 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/genrcbin.h0000755000175000017500000000366407422634603014511 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_genrcbin #define _H_genrcbin #include "genrcfun.h" #define GENRCBIN_DATA 28 struct defgenericBinaryData { DEFGENERIC *DefgenericArray; long ModuleCount; long GenericCount; long MethodCount; long RestrictionCount; long TypeCount; DEFGENERIC_MODULE *ModuleArray; DEFMETHOD *MethodArray; RESTRICTION *RestrictionArray; void **TypeArray; }; #define DefgenericBinaryData(theEnv) ((struct defgenericBinaryData *) GetEnvironmentData(theEnv,GENRCBIN_DATA)) #define GenericPointer(i) (((i) == -1L) ? NULL : (DEFGENERIC *) &DefgenericBinaryData(theEnv)->DefgenericArray[i]) #ifdef LOCALE #undef LOCALE #endif #ifdef _GENRCBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupGenericsBload(void *); LOCALE void *BloadDefgenericModuleReference(void *,int); #endif clips-6.24/clipssrc/._ed.h0000400000175000017500000000075410176267162013511 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zʒ;;:TTFUBDhFMWBBMPSRclips-6.24/clipssrc/._tmpltutl.h0000400000175000017500000000075410441602351014772 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0i0i<TTFL0FMPSRMWBBLclips-6.24/clipssrc/._globlcom.c0000400000175000017500000000075410441143622014677 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0c0c1,,TTFS FMWBBMPSRclips-6.24/clipssrc/insmult.h0000755000175000017500000000354010441147600014375 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_insmult #define _H_insmult #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _INSMULT_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if (! RUN_TIME) LOCALE void SetupInstanceMultifieldCommands(void *); #endif LOCALE void MVSlotReplaceCommand(void *,DATA_OBJECT *); LOCALE void MVSlotInsertCommand(void *,DATA_OBJECT *); LOCALE void MVSlotDeleteCommand(void *,DATA_OBJECT *); LOCALE intBool DirectMVReplaceCommand(void *); LOCALE intBool DirectMVInsertCommand(void *); LOCALE intBool DirectMVDeleteCommand(void *); #ifndef _INSMULT_SOURCE_ #endif #endif clips-6.24/clipssrc/insfile.c0000755000175000017500000016161510441602225014335 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* INSTANCE LOAD/SAVE (ASCII/BINARY) MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: File load/save routines for instances */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Added environment parameter to GenClose. */ /* Added environment parameter to GenOpen. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Corrected code to remove compiler warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM #include "argacces.h" #include "classcom.h" #include "classfun.h" #include "memalloc.h" #include "extnfunc.h" #include "inscom.h" #include "insfun.h" #include "insmngr.h" #include "inspsr.h" #include "object.h" #include "router.h" #include "strngrtr.h" #include "symblbin.h" #include "sysdep.h" #include "envrnmnt.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include "factmngr.h" #endif #define _INSFILE_SOURCE_ #include "insfile.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define MAX_BLOCK_SIZE 10240 /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ struct bsaveSlotValue { long slotName; unsigned valueCount; }; struct bsaveSlotValueAtom { unsigned short type; long value; }; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static long InstancesSaveCommandParser(void *,char *,long (*)(void *,char *,int, EXPRESSION *,intBool)); static DATA_OBJECT *ProcessSaveClassList(void *,char *,EXPRESSION *,int,intBool); static void ReturnSaveClassList(void *,DATA_OBJECT *); static long SaveOrMarkInstances(void *,void *,int,DATA_OBJECT *,intBool,intBool, void (*)(void *,void *,INSTANCE_TYPE *)); static long SaveOrMarkInstancesOfClass(void *,void *,struct defmodule *,int,DEFCLASS *, intBool,int,void (*)(void *,void *,INSTANCE_TYPE *)); static void SaveSingleInstanceText(void *,void *,INSTANCE_TYPE *); static void ProcessFileErrorMessage(void *,char *,char *); #if BSAVE_INSTANCES static void WriteBinaryHeader(void *,FILE *); static void MarkSingleInstance(void *,void *,INSTANCE_TYPE *); static void MarkNeededAtom(void *,int,void *); static void SaveSingleInstanceBinary(void *,void *,INSTANCE_TYPE *); static void SaveAtomBinary(void *,unsigned short,void *,FILE *); #endif static long LoadOrRestoreInstances(void *,char *,int,int); #if BLOAD_INSTANCES static intBool VerifyBinaryHeader(void *,char *); static intBool LoadSingleBinaryInstance(void *); static void BinaryLoadInstanceError(void *,SYMBOL_HN *,DEFCLASS *); static void CreateSlotValue(void *,DATA_OBJECT *,struct bsaveSlotValueAtom *,unsigned long); static void *GetBinaryAtomValue(void *,struct bsaveSlotValueAtom *); static void BufferedRead(void *,void *,unsigned long); static void FreeReadBuffer(void *); #endif /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************** NAME : SetupInstanceFileCommands DESCRIPTION : Defines function interfaces for saving instances to files INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions defined to KB NOTES : None ***************************************************/ globle void SetupInstanceFileCommands( void *theEnv) { #if BLOAD_INSTANCES || BSAVE_INSTANCES AllocateEnvironmentData(theEnv,INSTANCE_FILE_DATA,sizeof(struct instanceFileData),NULL); InstanceFileData(theEnv)->InstanceBinaryPrefixID = "\5\6\7CLIPS"; InstanceFileData(theEnv)->InstanceBinaryVersionID = "V6.00"; #endif #if (! RUN_TIME) EnvDefineFunction2(theEnv,"save-instances",'l',PTIEF SaveInstancesCommand, "SaveInstancesCommand","1*wk"); EnvDefineFunction2(theEnv,"load-instances",'l',PTIEF LoadInstancesCommand, "LoadInstancesCommand","11k"); EnvDefineFunction2(theEnv,"restore-instances",'l',PTIEF RestoreInstancesCommand, "RestoreInstancesCommand","11k"); #if BSAVE_INSTANCES EnvDefineFunction2(theEnv,"bsave-instances",'l',PTIEF BinarySaveInstancesCommand, "BinarySaveInstancesCommand","1*wk"); #endif #if BLOAD_INSTANCES EnvDefineFunction2(theEnv,"bload-instances",'l',PTIEF BinaryLoadInstancesCommand, "BinaryLoadInstancesCommand","11k"); #endif #endif } /**************************************************************************** NAME : SaveInstancesCommand DESCRIPTION : H/L interface for saving current instances to a file INPUTS : None RETURNS : The number of instances saved SIDE EFFECTS : Instances saved to named file NOTES : H/L Syntax : (save-instances [local|visible [[inherit] +]]) ****************************************************************************/ globle long SaveInstancesCommand( void *theEnv) { return(InstancesSaveCommandParser(theEnv,"save-instances",EnvSaveInstances)); } /****************************************************** NAME : LoadInstancesCommand DESCRIPTION : H/L interface for loading instances from a file INPUTS : None RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from named file NOTES : H/L Syntax : (load-instances ) ******************************************************/ globle long LoadInstancesCommand( void *theEnv) { char *fileFound; DATA_OBJECT temp; long instanceCount; if (EnvArgTypeCheck(theEnv,"load-instances",1,SYMBOL_OR_STRING,&temp) == FALSE) return(0L); fileFound = DOToString(temp); instanceCount = EnvLoadInstances(theEnv,fileFound); if (EvaluationData(theEnv)->EvaluationError) ProcessFileErrorMessage(theEnv,"load-instances",fileFound); return(instanceCount); } /*************************************************** NAME : EnvLoadInstances DESCRIPTION : Loads instances from named file INPUTS : The name of the input file RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from file NOTES : None ***************************************************/ globle long EnvLoadInstances( void *theEnv, char *file) { return(LoadOrRestoreInstances(theEnv,file,TRUE,TRUE)); } /*************************************************** NAME : EnvLoadInstancesFromString DESCRIPTION : Loads instances from given string INPUTS : 1) The input string 2) Index of char in string after last valid char (-1 for all chars) RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from string NOTES : Uses string routers ***************************************************/ globle long EnvLoadInstancesFromString( void *theEnv, char *theString, int theMax) { long theCount; char * theStrRouter = "*** load-instances-from-string ***"; if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) : (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax))) return(-1L); theCount = LoadOrRestoreInstances(theEnv,theStrRouter,TRUE,FALSE); CloseStringSource(theEnv,theStrRouter); return(theCount); } /********************************************************* NAME : RestoreInstancesCommand DESCRIPTION : H/L interface for loading instances from a file w/o messages INPUTS : None RETURNS : The number of instances restored SIDE EFFECTS : Instances loaded from named file NOTES : H/L Syntax : (restore-instances ) *********************************************************/ globle long RestoreInstancesCommand( void *theEnv) { char *fileFound; DATA_OBJECT temp; long instanceCount; if (EnvArgTypeCheck(theEnv,"restore-instances",1,SYMBOL_OR_STRING,&temp) == FALSE) return(0L); fileFound = DOToString(temp); instanceCount = EnvRestoreInstances(theEnv,fileFound); if (EvaluationData(theEnv)->EvaluationError) ProcessFileErrorMessage(theEnv,"restore-instances",fileFound); return(instanceCount); } /*************************************************** NAME : EnvRestoreInstances DESCRIPTION : Restores instances from named file INPUTS : The name of the input file RETURNS : The number of instances restored SIDE EFFECTS : Instances restored from file NOTES : None ***************************************************/ globle long EnvRestoreInstances( void *theEnv, char *file) { return(LoadOrRestoreInstances(theEnv,file,FALSE,TRUE)); } /*************************************************** NAME : EnvRestoreInstancesFromString DESCRIPTION : Restores instances from given string INPUTS : 1) The input string 2) Index of char in string after last valid char (-1 for all chars) RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from string NOTES : Uses string routers ***************************************************/ globle long EnvRestoreInstancesFromString( void *theEnv, char *theString, int theMax) { long theCount; char * theStrRouter = "*** load-instances-from-string ***"; if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) : (!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax))) return(-1L); theCount = LoadOrRestoreInstances(theEnv,theStrRouter,FALSE,FALSE); CloseStringSource(theEnv,theStrRouter); return(theCount); } #if BLOAD_INSTANCES /******************************************************* NAME : BinaryLoadInstancesCommand DESCRIPTION : H/L interface for loading instances from a binary file INPUTS : None RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded from named binary file NOTES : H/L Syntax : (bload-instances ) *******************************************************/ globle long BinaryLoadInstancesCommand( void *theEnv) { char *fileFound; DATA_OBJECT temp; long instanceCount; if (EnvArgTypeCheck(theEnv,"bload-instances",1,SYMBOL_OR_STRING,&temp) == FALSE) return(0L); fileFound = DOToString(temp); instanceCount = EnvBinaryLoadInstances(theEnv,fileFound); if (EvaluationData(theEnv)->EvaluationError) ProcessFileErrorMessage(theEnv,"bload-instances",fileFound); return(instanceCount); } /**************************************************** NAME : EnvBinaryLoadInstances DESCRIPTION : Loads instances quickly from a binary file INPUTS : The file name RETURNS : The number of instances loaded SIDE EFFECTS : Instances loaded w/o message-passing NOTES : None ****************************************************/ globle long EnvBinaryLoadInstances( void *theEnv, char *theFile) { long i,instanceCount; if (GenOpenReadBinary(theEnv,"bload-instances",theFile) == 0) { SetEvaluationError(theEnv,TRUE); return(-1L); } if (VerifyBinaryHeader(theEnv,theFile) == FALSE) { GenCloseBinary(theEnv); SetEvaluationError(theEnv,TRUE); return(-1L); } EnvIncrementGCLocks(theEnv); ReadNeededAtomicValues(theEnv); InstanceFileData(theEnv)->BinaryInstanceFileOffset = 0L; GenReadBinary(theEnv,(void *) &InstanceFileData(theEnv)->BinaryInstanceFileSize,(unsigned long) sizeof(unsigned long)); GenReadBinary(theEnv,(void *) &instanceCount,(unsigned long) sizeof(long)); for (i = 0L ; i < instanceCount ; i++) { if (LoadSingleBinaryInstance(theEnv) == FALSE) { FreeReadBuffer(theEnv); FreeAtomicValueStorage(theEnv); GenCloseBinary(theEnv); SetEvaluationError(theEnv,TRUE); EnvDecrementGCLocks(theEnv); return(i); } } FreeReadBuffer(theEnv); FreeAtomicValueStorage(theEnv); GenCloseBinary(theEnv); EnvDecrementGCLocks(theEnv); return(instanceCount); } #endif /******************************************************* NAME : EnvSaveInstances DESCRIPTION : Saves current instances to named file INPUTS : 1) The name of the output file 2) A flag indicating whether to save local (current module only) or visible instances LOCAL_SAVE or VISIBLE_SAVE 3) A list of expressions containing the names of classes for which instances are to be saved 4) A flag indicating if the subclasses of specified classes shoudl also be processed RETURNS : The number of instances saved SIDE EFFECTS : Instances saved to file NOTES : None *******************************************************/ globle long EnvSaveInstances( void *theEnv, char *file, int saveCode, EXPRESSION *classExpressionList, intBool inheritFlag) { FILE *sfile = NULL; int oldPEC,oldATS,oldIAN; DATA_OBJECT *classList; long instanceCount; classList = ProcessSaveClassList(theEnv,"save-instances",classExpressionList, saveCode,inheritFlag); if ((classList == NULL) && (classExpressionList != NULL)) return(0L); SaveOrMarkInstances(theEnv,(void *) sfile,saveCode,classList, inheritFlag,TRUE,NULL); if ((sfile = GenOpen(theEnv,file,"w")) == NULL) { OpenErrorMessage(theEnv,"save-instances",file); ReturnSaveClassList(theEnv,classList); SetEvaluationError(theEnv,TRUE); return(0L); } oldPEC = PrintUtilityData(theEnv)->PreserveEscapedCharacters; PrintUtilityData(theEnv)->PreserveEscapedCharacters = TRUE; oldATS = PrintUtilityData(theEnv)->AddressesToStrings; PrintUtilityData(theEnv)->AddressesToStrings = TRUE; oldIAN = PrintUtilityData(theEnv)->InstanceAddressesToNames; PrintUtilityData(theEnv)->InstanceAddressesToNames = TRUE; SetFastSave(theEnv,sfile); instanceCount = SaveOrMarkInstances(theEnv,(void *) sfile,saveCode,classList, inheritFlag,TRUE,SaveSingleInstanceText); GenClose(theEnv,sfile); SetFastSave(theEnv,NULL); PrintUtilityData(theEnv)->PreserveEscapedCharacters = oldPEC; PrintUtilityData(theEnv)->AddressesToStrings = oldATS; PrintUtilityData(theEnv)->InstanceAddressesToNames = oldIAN; ReturnSaveClassList(theEnv,classList); return(instanceCount); } #if BSAVE_INSTANCES /**************************************************************************** NAME : BinarySaveInstancesCommand DESCRIPTION : H/L interface for saving current instances to a binary file INPUTS : None RETURNS : The number of instances saved SIDE EFFECTS : Instances saved (in binary format) to named file NOTES : H/L Syntax : (bsave-instances [local|visible [[inherit] +]]) *****************************************************************************/ globle long BinarySaveInstancesCommand( void *theEnv) { return(InstancesSaveCommandParser(theEnv,"bsave-instances",EnvBinarySaveInstances)); } /******************************************************* NAME : EnvBinarySaveInstances DESCRIPTION : Saves current instances to binary file INPUTS : 1) The name of the output file 2) A flag indicating whether to save local (current module only) or visible instances LOCAL_SAVE or VISIBLE_SAVE 3) A list of expressions containing the names of classes for which instances are to be saved 4) A flag indicating if the subclasses of specified classes shoudl also be processed RETURNS : The number of instances saved SIDE EFFECTS : Instances saved to file NOTES : None *******************************************************/ globle long EnvBinarySaveInstances( void *theEnv, char *file, int saveCode, EXPRESSION *classExpressionList, intBool inheritFlag) { DATA_OBJECT *classList; FILE *bsaveFP; long instanceCount; classList = ProcessSaveClassList(theEnv,"bsave-instances",classExpressionList, saveCode,inheritFlag); if ((classList == NULL) && (classExpressionList != NULL)) return(0L); InstanceFileData(theEnv)->BinaryInstanceFileSize = 0L; InitAtomicValueNeededFlags(theEnv); instanceCount = SaveOrMarkInstances(theEnv,NULL,saveCode,classList,inheritFlag, FALSE,MarkSingleInstance); if ((bsaveFP = GenOpen(theEnv,file,"wb")) == NULL) { OpenErrorMessage(theEnv,"bsave-instances",file); ReturnSaveClassList(theEnv,classList); SetEvaluationError(theEnv,TRUE); return(0L); } WriteBinaryHeader(theEnv,bsaveFP); WriteNeededAtomicValues(theEnv,bsaveFP); fwrite((void *) &InstanceFileData(theEnv)->BinaryInstanceFileSize,sizeof(unsigned long),1,bsaveFP); fwrite((void *) &instanceCount,sizeof(long),1,bsaveFP); SetAtomicValueIndices(theEnv,FALSE); SaveOrMarkInstances(theEnv,(void *) bsaveFP,saveCode,classList, inheritFlag,FALSE,SaveSingleInstanceBinary); RestoreAtomicValueBuckets(theEnv); GenClose(theEnv,bsaveFP); ReturnSaveClassList(theEnv,classList); return(instanceCount); } #endif /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /****************************************************** NAME : InstancesSaveCommandParser DESCRIPTION : Argument parser for save-instances and bsave-instances INPUTS : 1) The name of the calling function 2) A pointer to the support function to call for the save/bsave RETURNS : The number of instances saved SIDE EFFECTS : Instances saved/bsaved NOTES : None ******************************************************/ static long InstancesSaveCommandParser( void *theEnv, char *functionName, long (*saveFunction)(void *,char *,int,EXPRESSION *,intBool)) { char *fileFound; DATA_OBJECT temp; int argCount,saveCode = LOCAL_SAVE; EXPRESSION *classList = NULL; intBool inheritFlag = FALSE; if (EnvArgTypeCheck(theEnv,functionName,1,SYMBOL_OR_STRING,&temp) == FALSE) return(0L); fileFound = DOToString(temp); argCount = EnvRtnArgCount(theEnv); if (argCount > 1) { if (EnvArgTypeCheck(theEnv,functionName,2,SYMBOL,&temp) == FALSE) { ExpectedTypeError1(theEnv,functionName,2,"symbol \"local\" or \"visible\""); SetEvaluationError(theEnv,TRUE); return(0L); } if (strcmp(DOToString(temp),"local") == 0) saveCode = LOCAL_SAVE; else if (strcmp(DOToString(temp),"visible") == 0) saveCode = VISIBLE_SAVE; else { ExpectedTypeError1(theEnv,functionName,2,"symbol \"local\" or \"visible\""); SetEvaluationError(theEnv,TRUE); return(0L); } classList = GetFirstArgument()->nextArg->nextArg; /* =========================== Check for "inherit" keyword Must be at least one class name following =========================== */ if ((classList != NULL) ? (classList->nextArg != NULL) : FALSE) { if ((classList->type != SYMBOL) ? FALSE : (strcmp(ValueToString(classList->value),"inherit") == 0)) { inheritFlag = TRUE; classList = classList->nextArg; } } } return((*saveFunction)(theEnv,fileFound,saveCode,classList,inheritFlag)); } /**************************************************** NAME : ProcessSaveClassList DESCRIPTION : Evaluates a list of class name expressions and stores them in a data object list INPUTS : 1) The name of the calling function 2) The class expression list 3) A flag indicating if only local or all visible instances are being saved 4) A flag indicating if inheritance relationships should be checked between classes RETURNS : The evaluated class pointer data objects - NULL on errors SIDE EFFECTS : Data objects allocated and classes validated NOTES : None ****************************************************/ static DATA_OBJECT *ProcessSaveClassList( void *theEnv, char *functionName, EXPRESSION *classExps, int saveCode, intBool inheritFlag) { DATA_OBJECT *head = NULL,*prv,*newItem,tmp; DEFCLASS *theDefclass; struct defmodule *currentModule; int argIndex = inheritFlag ? 4 : 3; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); while (classExps != NULL) { if (EvaluateExpression(theEnv,classExps,&tmp)) goto ProcessClassListError; if (tmp.type != SYMBOL) goto ProcessClassListError; if (saveCode == LOCAL_SAVE) theDefclass = LookupDefclassAnywhere(theEnv,currentModule,DOToString(tmp)); else theDefclass = LookupDefclassInScope(theEnv,DOToString(tmp)); if (theDefclass == NULL) goto ProcessClassListError; else if (theDefclass->abstract && (inheritFlag == FALSE)) goto ProcessClassListError; prv = newItem = head; while (newItem != NULL) { if (newItem->value == (void *) theDefclass) goto ProcessClassListError; else if (inheritFlag) { if (HasSuperclass((DEFCLASS *) newItem->value,theDefclass) || HasSuperclass(theDefclass,(DEFCLASS *) newItem->value)) goto ProcessClassListError; } prv = newItem; newItem = newItem->next; } newItem = get_struct(theEnv,dataObject); newItem->type = DEFCLASS_PTR; newItem->value = (void *) theDefclass; newItem->next = NULL; if (prv == NULL) head = newItem; else prv->next = newItem; argIndex++; classExps = classExps->nextArg; } return(head); ProcessClassListError: ExpectedTypeError1(theEnv,functionName,argIndex, (char *) (inheritFlag ? "valid class name" : "valid concrete class name")); ReturnSaveClassList(theEnv,head); SetEvaluationError(theEnv,TRUE); return(NULL); } /**************************************************** NAME : ReturnSaveClassList DESCRIPTION : Deallocates the class data object list created by ProcessSaveClassList INPUTS : The class data object list RETURNS : Nothing useful SIDE EFFECTS : Class data object returned NOTES : None ****************************************************/ static void ReturnSaveClassList( void *theEnv, DATA_OBJECT *classList) { DATA_OBJECT *tmp; while (classList != NULL) { tmp = classList; classList = classList->next; rtn_struct(theEnv,dataObject,tmp); } } /*************************************************** NAME : SaveOrMarkInstances DESCRIPTION : Iterates through all specified instances either marking needed atoms or writing instances in binary/text format INPUTS : 1) NULL (for marking), logical name (for text saves) file pointer (for binary saves) 2) A cope flag indicating LOCAL or VISIBLE saves only 3) A list of data objects containing the names of classes of instances to be saved 4) A flag indicating whether to include subclasses of arg #3 5) A flag indicating if the iteration can be interrupted or not 6) The access function to mark or save an instance (can be NULL if only counting instances) RETURNS : The number of instances saved SIDE EFFECTS : Instances amrked or saved NOTES : None ***************************************************/ static long SaveOrMarkInstances( void *theEnv, void *theOutput, int saveCode, DATA_OBJECT *classList, intBool inheritFlag, intBool interruptOK, void (*saveInstanceFunc)(void *,void *,INSTANCE_TYPE *)) { struct defmodule *currentModule; int traversalID; DATA_OBJECT *tmp; INSTANCE_TYPE *ins; long instanceCount = 0L; currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (classList != NULL) { traversalID = GetTraversalID(theEnv); if (traversalID != -1) { for (tmp = classList ; (! ((tmp == NULL) || (EvaluationData(theEnv)->HaltExecution && interruptOK))) ; tmp = tmp->next) instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode, (DEFCLASS *) tmp->value,inheritFlag, traversalID,saveInstanceFunc); ReleaseTraversalID(theEnv); } } else { for (ins = (INSTANCE_TYPE *) GetNextInstanceInScope(theEnv,NULL) ; (ins != NULL) && (EvaluationData(theEnv)->HaltExecution != TRUE) ; ins = (INSTANCE_TYPE *) GetNextInstanceInScope(theEnv,(void *) ins)) { if ((saveCode == VISIBLE_SAVE) ? TRUE : (ins->cls->header.whichModule->theModule == currentModule)) { if (saveInstanceFunc != NULL) (*saveInstanceFunc)(theEnv,theOutput,ins); instanceCount++; } } } return(instanceCount); } /*************************************************** NAME : SaveOrMarkInstancesOfClass DESCRIPTION : Saves off the direct (and indirect) instance of the specified class INPUTS : 1) The logical name of the output (or file pointer for binary output) 2) The current module 3) A flag indicating local or visible saves 4) The defclass 5) A flag indicating whether to save subclass instances or not 6) A traversal id for marking visited classes 7) A pointer to the instance manipulation function to call (can be NULL for only counting instances) RETURNS : The number of instances saved SIDE EFFECTS : Appropriate instances saved NOTES : None ***************************************************/ static long SaveOrMarkInstancesOfClass( void *theEnv, void *theOutput, struct defmodule *currentModule, int saveCode, DEFCLASS *theDefclass, intBool inheritFlag, int traversalID, void (*saveInstanceFunc)(void *,void *,INSTANCE_TYPE *)) { INSTANCE_TYPE *theInstance; DEFCLASS *subclass; register unsigned i; long instanceCount = 0L; if (TestTraversalID(theDefclass->traversalRecord,traversalID)) return(instanceCount); SetTraversalID(theDefclass->traversalRecord,traversalID); if (((saveCode == LOCAL_SAVE) && (theDefclass->header.whichModule->theModule == currentModule)) || ((saveCode == VISIBLE_SAVE) && DefclassInScope(theEnv,theDefclass,currentModule))) { for (theInstance = (INSTANCE_TYPE *) EnvGetNextInstanceInClass(theEnv,(void *) theDefclass,NULL) ; theInstance != NULL ; theInstance = (INSTANCE_TYPE *) EnvGetNextInstanceInClass(theEnv,(void *) theDefclass,(void *) theInstance)) { if (saveInstanceFunc != NULL) (*saveInstanceFunc)(theEnv,theOutput,theInstance); instanceCount++; } } if (inheritFlag) { for (i = 0 ; i < theDefclass->directSubclasses.classCount ; i++) { subclass = theDefclass->directSubclasses.classArray[i]; instanceCount += SaveOrMarkInstancesOfClass(theEnv,theOutput,currentModule,saveCode, subclass,TRUE,traversalID, saveInstanceFunc); } } return(instanceCount); } /*************************************************** NAME : SaveSingleInstanceText DESCRIPTION : Writes given instance to file INPUTS : 1) The logical name of the output 2) The instance to save RETURNS : Nothing useful SIDE EFFECTS : Instance written NOTES : None ***************************************************/ static void SaveSingleInstanceText( void *theEnv, void *vLogicalName, INSTANCE_TYPE *theInstance) { register unsigned i; INSTANCE_SLOT *sp; char *logicalName = (char *) vLogicalName; EnvPrintRouter(theEnv,logicalName,"(["); EnvPrintRouter(theEnv,logicalName,ValueToString(theInstance->name)); EnvPrintRouter(theEnv,logicalName,"] of "); EnvPrintRouter(theEnv,logicalName,ValueToString(theInstance->cls->header.name)); for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++) { sp = theInstance->slotAddresses[i]; EnvPrintRouter(theEnv,logicalName,"\n ("); EnvPrintRouter(theEnv,logicalName,ValueToString(sp->desc->slotName->name)); if (sp->type != MULTIFIELD) { EnvPrintRouter(theEnv,logicalName," "); PrintAtom(theEnv,logicalName,(int) sp->type,sp->value); } else if (GetInstanceSlotLength(sp) != 0) { EnvPrintRouter(theEnv,logicalName," "); PrintMultifield(theEnv,logicalName,(MULTIFIELD_PTR) sp->value,0, (long) (GetInstanceSlotLength(sp) - 1),FALSE); } EnvPrintRouter(theEnv,logicalName,")"); } EnvPrintRouter(theEnv,logicalName,")\n\n"); } #if BSAVE_INSTANCES /*************************************************** NAME : WriteBinaryHeader DESCRIPTION : Writes identifying string to instance binary file to assist in later verification INPUTS : The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Binary prefix headers written NOTES : None ***************************************************/ static void WriteBinaryHeader( void *theEnv, FILE *bsaveFP) { fwrite((void *) InstanceFileData(theEnv)->InstanceBinaryPrefixID, (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1),1,bsaveFP); fwrite((void *) InstanceFileData(theEnv)->InstanceBinaryVersionID, (STD_SIZE) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1),1,bsaveFP); } /*************************************************** NAME : MarkSingleInstance DESCRIPTION : Marks all the atoms needed in the slot values of an instance INPUTS : 1) The output (ignored) 2) The instance RETURNS : Nothing useful SIDE EFFECTS : Instance slot value atoms marked NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void MarkSingleInstance( void *theEnv, void *theOutput, INSTANCE_TYPE *theInstance) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theOutput) #endif INSTANCE_SLOT *sp; register unsigned i,j; InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) (sizeof(long) * 2); theInstance->name->neededSymbol = TRUE; theInstance->cls->header.name->neededSymbol = TRUE; InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) ((sizeof(long) * 2) + (sizeof(struct bsaveSlotValue) * theInstance->cls->instanceSlotCount) + sizeof(unsigned long) + sizeof(unsigned)); for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++) { sp = theInstance->slotAddresses[i]; sp->desc->slotName->name->neededSymbol = TRUE; if (sp->desc->multiple) { for (j = 1 ; j <= GetInstanceSlotLength(sp) ; j++) MarkNeededAtom(theEnv,GetMFType(sp->value,j),GetMFValue(sp->value,j)); } else MarkNeededAtom(theEnv,(int) sp->type,sp->value); } } /*************************************************** NAME : MarkNeededAtom DESCRIPTION : Marks an integer/float/symbol as being need by a set of instances INPUTS : 1) The type of atom 2) The value of the atom RETURNS : Nothing useful SIDE EFFECTS : Atom marked for saving NOTES : None ***************************************************/ static void MarkNeededAtom( void *theEnv, int type, void *value) { InstanceFileData(theEnv)->BinaryInstanceFileSize += (unsigned long) sizeof(struct bsaveSlotValueAtom); /* ===================================== Assumes slot value atoms can only be floats, integers, symbols, strings, instance-names, instance-addresses, fact-addresses or external-addresses ===================================== */ switch (type) { case SYMBOL: case STRING: case INSTANCE_NAME: ((SYMBOL_HN *) value)->neededSymbol = TRUE; break; case FLOAT: ((FLOAT_HN *) value)->neededFloat = TRUE; break; case INTEGER: ((INTEGER_HN *) value)->neededInteger = TRUE; break; case INSTANCE_ADDRESS: GetFullInstanceName(theEnv,(INSTANCE_TYPE *) value)->neededSymbol = TRUE; break; } } /**************************************************** NAME : SaveSingleInstanceBinary DESCRIPTION : Writes given instance to binary file INPUTS : 1) Binary file pointer 2) The instance to save RETURNS : Nothing useful SIDE EFFECTS : Instance written NOTES : None ****************************************************/ static void SaveSingleInstanceBinary( void *theEnv, void *vBsaveFP, INSTANCE_TYPE *theInstance) { long nameIndex; register unsigned i,j; INSTANCE_SLOT *sp; FILE *bsaveFP = (FILE *) vBsaveFP; struct bsaveSlotValue bs; unsigned long totalValueCount = 0L; unsigned slotLen; /* =========================== Write out the instance name =========================== */ nameIndex = (long) theInstance->name->bucket; fwrite((void *) &nameIndex,(int) sizeof(long),1,bsaveFP); /* ======================== Write out the class name ======================== */ nameIndex = (long) theInstance->cls->header.name->bucket; fwrite((void *) &nameIndex,(int) sizeof(long),1,bsaveFP); /* ====================================== Write out the number of slot-overrides ====================================== */ fwrite((void *) &theInstance->cls->instanceSlotCount, (int) sizeof(unsigned),1,bsaveFP); /* ========================================= Write out the slot names and value counts ========================================= */ for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++) { sp = theInstance->slotAddresses[i]; /* =============================================== Write out the number of atoms in the slot value =============================================== */ bs.slotName = (long) sp->desc->slotName->name->bucket; bs.valueCount = sp->desc->multiple ? GetInstanceSlotLength(sp) : 1; fwrite((void *) &bs,(int) sizeof(struct bsaveSlotValue),1,bsaveFP); totalValueCount += (unsigned long) bs.valueCount; } /* ================================== Write out the number of slot value atoms for the whole instance ================================== */ if (totalValueCount != 0L) fwrite((void *) &totalValueCount,(int) sizeof(unsigned long),1,bsaveFP); /* ============================== Write out the slot value atoms ============================== */ for (i = 0 ; i < theInstance->cls->instanceSlotCount ; i++) { sp = theInstance->slotAddresses[i]; slotLen = sp->desc->multiple ? GetInstanceSlotLength(sp) : 1; /* ========================================= Write out the type and index of each atom ========================================= */ if (sp->desc->multiple) { for (j = 1 ; j <= slotLen ; j++) SaveAtomBinary(theEnv,GetMFType(sp->value,j),GetMFValue(sp->value,j),bsaveFP); } else SaveAtomBinary(theEnv,(unsigned short) sp->type,sp->value,bsaveFP); } } /*************************************************** NAME : SaveAtomBinary DESCRIPTION : Writes out an instance slot value atom to the binary file INPUTS : 1) The atom type 2) The atom value 3) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : atom written NOTES : ***************************************************/ static void SaveAtomBinary( void *theEnv, unsigned short type, void *value, FILE *bsaveFP) { struct bsaveSlotValueAtom bsa; /* ===================================== Assumes slot value atoms can only be floats, integers, symbols, strings, instance-names, instance-addresses, fact-addresses or external-addresses ===================================== */ bsa.type = type; switch (type) { case SYMBOL: case STRING: case INSTANCE_NAME: bsa.value = (long) ((SYMBOL_HN *) value)->bucket; break; case FLOAT: bsa.value = (long) ((FLOAT_HN *) value)->bucket; break; case INTEGER: bsa.value = (long) ((INTEGER_HN *) value)->bucket; break; case INSTANCE_ADDRESS: bsa.type = INSTANCE_NAME; bsa.value = (long) GetFullInstanceName(theEnv,(INSTANCE_TYPE *) value)->bucket; break; default: bsa.value = -1L; } fwrite((void *) &bsa,(int) sizeof(struct bsaveSlotValueAtom),1,bsaveFP); } #endif /********************************************************************** NAME : LoadOrRestoreInstances DESCRIPTION : Loads instances from named file INPUTS : 1) The name of the input file 2) An integer flag indicating whether or not to use message-passing to create the new instances and delete old versions 3) An integer flag indicating if arg #1 is a file name or the name of a string router RETURNS : The number of instances loaded/restored SIDE EFFECTS : Instances loaded from file NOTES : None **********************************************************************/ static long LoadOrRestoreInstances( void *theEnv, char *file, int usemsgs, int isFileName) { DATA_OBJECT temp; FILE *sfile = NULL,*svload = NULL; char *ilog; EXPRESSION *top; int svoverride; long instanceCount = 0L; if (isFileName) { if ((sfile = GenOpen(theEnv,file,"r")) == NULL) { SetEvaluationError(theEnv,TRUE); return(-1L); } svload = GetFastLoad(theEnv); ilog = (char *) sfile; SetFastLoad(theEnv,sfile); } else { ilog = file; } top = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"make-instance")); GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken); svoverride = InstanceData(theEnv)->MkInsMsgPass; InstanceData(theEnv)->MkInsMsgPass = usemsgs; while ((GetType(DefclassData(theEnv)->ObjectParseToken) != STOP) && (EvaluationData(theEnv)->HaltExecution != TRUE)) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,"instance definition"); rtn_struct(theEnv,expr,top); if (isFileName) { GenClose(theEnv,sfile); SetFastLoad(theEnv,svload); } SetEvaluationError(theEnv,TRUE); InstanceData(theEnv)->MkInsMsgPass = svoverride; return(instanceCount); } if (ParseSimpleInstance(theEnv,top,ilog) == NULL) { if (isFileName) { GenClose(theEnv,sfile); SetFastLoad(theEnv,svload); } InstanceData(theEnv)->MkInsMsgPass = svoverride; SetEvaluationError(theEnv,TRUE); return(instanceCount); } ExpressionInstall(theEnv,top); EvaluateExpression(theEnv,top,&temp); ExpressionDeinstall(theEnv,top); if (! EvaluationData(theEnv)->EvaluationError) instanceCount++; ReturnExpression(theEnv,top->argList); top->argList = NULL; GetToken(theEnv,ilog,&DefclassData(theEnv)->ObjectParseToken); } rtn_struct(theEnv,expr,top); if (isFileName) { GenClose(theEnv,sfile); SetFastLoad(theEnv,svload); } InstanceData(theEnv)->MkInsMsgPass = svoverride; return(instanceCount); } /*************************************************** NAME : ProcessFileErrorMessage DESCRIPTION : Prints an error message when a file containing text or binary instances cannot be processed. INPUTS : The name of the input file and the function which opened it. RETURNS : No value SIDE EFFECTS : None NOTES : None ***************************************************/ static void ProcessFileErrorMessage( void *theEnv, char *functionName, char *fileName) { PrintErrorID(theEnv,"INSFILE",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," could not completely process file "); EnvPrintRouter(theEnv,WERROR,fileName); EnvPrintRouter(theEnv,WERROR,".\n"); } #if BLOAD_INSTANCES /******************************************************* NAME : VerifyBinaryHeader DESCRIPTION : Reads the prefix and version headers from a file to verify that the input is a valid binary instances file INPUTS : The name of the file RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Input prefix and version read NOTES : Assumes file already open with GenOpenReadBinary *******************************************************/ static intBool VerifyBinaryHeader( void *theEnv, char *theFile) { char buf[20]; GenReadBinary(theEnv,(void *) buf,(unsigned long) (strlen(InstanceFileData(theEnv)->InstanceBinaryPrefixID) + 1)); if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryPrefixID) != 0) { PrintErrorID(theEnv,"INSFILE",2,FALSE); EnvPrintRouter(theEnv,WERROR,theFile); EnvPrintRouter(theEnv,WERROR," file is not a binary instances file.\n"); return(FALSE); } GenReadBinary(theEnv,(void *) buf,(unsigned long) (strlen(InstanceFileData(theEnv)->InstanceBinaryVersionID) + 1)); if (strcmp(buf,InstanceFileData(theEnv)->InstanceBinaryVersionID) != 0) { PrintErrorID(theEnv,"INSFILE",3,FALSE); EnvPrintRouter(theEnv,WERROR,theFile); EnvPrintRouter(theEnv,WERROR," file is not a compatible binary instances file.\n"); return(FALSE); } return(TRUE); } /*************************************************** NAME : LoadSingleBinaryInstance DESCRIPTION : Reads the binary data for a new instance and its slot values and creates/initializes the instance INPUTS : None RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Binary data read and instance created NOTES : Uses global GenReadBinary(theEnv,) ***************************************************/ static intBool LoadSingleBinaryInstance( void *theEnv) { SYMBOL_HN *instanceName, *className; unsigned slotCount; DEFCLASS *theDefclass; INSTANCE_TYPE *newInstance; struct bsaveSlotValue *bsArray; struct bsaveSlotValueAtom *bsaArray = NULL; long nameIndex; unsigned long totalValueCount; register unsigned i; unsigned long j; INSTANCE_SLOT *sp; DATA_OBJECT slotValue,junkValue; /* ===================== Get the instance name ===================== */ BufferedRead(theEnv,(void *) &nameIndex,(unsigned long) sizeof(long)); instanceName = SymbolPointer(nameIndex); /* ================== Get the class name ================== */ BufferedRead(theEnv,(void *) &nameIndex,(unsigned long) sizeof(long)); className = SymbolPointer(nameIndex); /* ================== Get the slot count ================== */ BufferedRead(theEnv,(void *) &slotCount,(unsigned long) sizeof(unsigned)); /* ============================= Make sure the defclass exists and check the slot count ============================= */ theDefclass = LookupDefclassInScope(theEnv,ValueToString(className)); if (theDefclass == NULL) { ClassExistError(theEnv,"bload-instances",ValueToString(className)); return(FALSE); } if (theDefclass->instanceSlotCount != slotCount) { BinaryLoadInstanceError(theEnv,instanceName,theDefclass); return(FALSE); } /* =================================== Create the new unitialized instance =================================== */ newInstance = BuildInstance(theEnv,instanceName,theDefclass,FALSE); if (newInstance == NULL) { BinaryLoadInstanceError(theEnv,instanceName,theDefclass); return(FALSE); } if (slotCount == 0) return(TRUE); /* ==================================== Read all slot override info and slot value atoms into big arrays ==================================== */ bsArray = (struct bsaveSlotValue *) gm2(theEnv,(sizeof(struct bsaveSlotValue) * slotCount)); BufferedRead(theEnv,(void *) bsArray,(unsigned long) (sizeof(struct bsaveSlotValue) * slotCount)); BufferedRead(theEnv,(void *) &totalValueCount,(unsigned long) sizeof(unsigned long)); if (totalValueCount != 0L) { bsaArray = (struct bsaveSlotValueAtom *) gm3(theEnv,(long) (totalValueCount * sizeof(struct bsaveSlotValueAtom))); BufferedRead(theEnv,(void *) bsaArray, (unsigned long) (totalValueCount * sizeof(struct bsaveSlotValueAtom))); } /* ========================= Insert the values for the slot overrides ========================= */ for (i = 0 , j = 0L ; i < slotCount ; i++) { /* =========================================================== Here is another check for the validity of the binary file - the order of the slots in the file should match the order in the class definition =========================================================== */ sp = newInstance->slotAddresses[i]; if (sp->desc->slotName->name != SymbolPointer(bsArray[i].slotName)) goto LoadError; CreateSlotValue(theEnv,&slotValue,(struct bsaveSlotValueAtom *) &bsaArray[j], bsArray[i].valueCount); if (PutSlotValue(theEnv,newInstance,sp,&slotValue,&junkValue,"bload-instances") == FALSE) goto LoadError; j += (unsigned long) bsArray[i].valueCount; } rm(theEnv,(void *) bsArray,(sizeof(struct bsaveSlotValue) * slotCount)); if (totalValueCount != 0L) rm3(theEnv,(void *) bsaArray, (long) (totalValueCount * sizeof(struct bsaveSlotValueAtom))); return(TRUE); LoadError: BinaryLoadInstanceError(theEnv,instanceName,theDefclass); QuashInstance(theEnv,newInstance); rm(theEnv,(void *) bsArray,(sizeof(struct bsaveSlotValue) * slotCount)); rm3(theEnv,(void *) bsaArray, (long) (totalValueCount * sizeof(struct bsaveSlotValueAtom))); return(FALSE); } /*************************************************** NAME : BinaryLoadInstanceError DESCRIPTION : Prints out an error message when an instance could not be successfully loaded from a binary file INPUTS : 1) The instance name 2) The defclass RETURNS : Nothing useful SIDE EFFECTS : Error message printed NOTES : None ***************************************************/ static void BinaryLoadInstanceError( void *theEnv, SYMBOL_HN *instanceName, DEFCLASS *theDefclass) { PrintErrorID(theEnv,"INSFILE",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Function bload-instances unable to load instance ["); EnvPrintRouter(theEnv,WERROR,ValueToString(instanceName)); EnvPrintRouter(theEnv,WERROR,"] of class "); PrintClassName(theEnv,WERROR,theDefclass,TRUE); } /*************************************************** NAME : CreateSlotValue DESCRIPTION : Creates a data object value from the binary slot value atom data INPUTS : 1) A data object buffer 2) The slot value atoms array 3) The number of values to put in the data object RETURNS : Nothing useful SIDE EFFECTS : Data object initialized (if more than one value, a multifield is created) NOTES : None ***************************************************/ static void CreateSlotValue( void *theEnv, DATA_OBJECT *result, struct bsaveSlotValueAtom *bsaValues, unsigned long valueCount) { register unsigned i; if (valueCount == 0) { result->type = MULTIFIELD; result->value = EnvCreateMultifield(theEnv,0L); result->begin = 0; result->end = -1; } else if (valueCount == 1) { result->type = bsaValues[0].type; result->value = GetBinaryAtomValue(theEnv,&bsaValues[0]); } else { result->type = MULTIFIELD; result->value = EnvCreateMultifield(theEnv,valueCount); result->begin = 0; SetpDOEnd(result,valueCount); for (i = 1 ; i <= valueCount ; i++) { SetMFType(result->value,i,(short) bsaValues[i-1].type); SetMFValue(result->value,i,GetBinaryAtomValue(theEnv,&bsaValues[i-1])); } } } /*************************************************** NAME : GetBinaryAtomValue DESCRIPTION : Uses the binary index of an atom to find the ephemeris value INPUTS : The binary type and index RETURNS : The symbol/etc. pointer SIDE EFFECTS : None NOTES : None ***************************************************/ static void *GetBinaryAtomValue( void *theEnv, struct bsaveSlotValueAtom *ba) { switch (ba->type) { case SYMBOL: case STRING: case INSTANCE_NAME: return((void *) SymbolPointer(ba->value)); case FLOAT: return((void *) FloatPointer(ba->value)); case INTEGER: return((void *) IntegerPointer(ba->value)); case FACT_ADDRESS: #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT return((void *) &FactData(theEnv)->DummyFact); #else return(NULL); #endif case EXTERNAL_ADDRESS: return(NULL); default: { SystemError(theEnv,"INSFILE",1); EnvExitRouter(theEnv,EXIT_FAILURE); } } return(NULL); } /*************************************************** NAME : BufferedRead DESCRIPTION : Reads data from binary file (Larger blocks than requested size may be read and buffered) INPUTS : 1) The buffer 2) The buffer size RETURNS : Nothing useful SIDE EFFECTS : Data stored in buffer NOTES : None ***************************************************/ static void BufferedRead( void *theEnv, void *buf, unsigned long bufsz) { unsigned long i,amountLeftToRead; if (InstanceFileData(theEnv)->CurrentReadBuffer != NULL) { amountLeftToRead = InstanceFileData(theEnv)->CurrentReadBufferSize - InstanceFileData(theEnv)->CurrentReadBufferOffset; if (bufsz <= amountLeftToRead) { for (i = 0L ; i < bufsz ; i++) ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i + InstanceFileData(theEnv)->CurrentReadBufferOffset]; InstanceFileData(theEnv)->CurrentReadBufferOffset += bufsz; if (InstanceFileData(theEnv)->CurrentReadBufferOffset == InstanceFileData(theEnv)->CurrentReadBufferSize) FreeReadBuffer(theEnv); } else { if (InstanceFileData(theEnv)->CurrentReadBufferOffset < InstanceFileData(theEnv)->CurrentReadBufferSize) { for (i = 0L ; i < amountLeftToRead ; i++) ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i + InstanceFileData(theEnv)->CurrentReadBufferOffset]; bufsz -= amountLeftToRead; buf = (void *) (((char *) buf) + amountLeftToRead); } FreeReadBuffer(theEnv); BufferedRead(theEnv,buf,bufsz); } } else { if (bufsz > MAX_BLOCK_SIZE) { InstanceFileData(theEnv)->CurrentReadBufferSize = bufsz; if (bufsz > (InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset)) { SystemError(theEnv,"INSFILE",2); EnvExitRouter(theEnv,EXIT_FAILURE); } } else if (MAX_BLOCK_SIZE > (InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset)) InstanceFileData(theEnv)->CurrentReadBufferSize = InstanceFileData(theEnv)->BinaryInstanceFileSize - InstanceFileData(theEnv)->BinaryInstanceFileOffset; else InstanceFileData(theEnv)->CurrentReadBufferSize = (unsigned long) MAX_BLOCK_SIZE; InstanceFileData(theEnv)->CurrentReadBuffer = (char *) genlongalloc(theEnv,InstanceFileData(theEnv)->CurrentReadBufferSize); GenReadBinary(theEnv,(void *) InstanceFileData(theEnv)->CurrentReadBuffer,InstanceFileData(theEnv)->CurrentReadBufferSize); for (i = 0L ; i < bufsz ; i++) ((char *) buf)[i] = InstanceFileData(theEnv)->CurrentReadBuffer[i]; InstanceFileData(theEnv)->CurrentReadBufferOffset = bufsz; InstanceFileData(theEnv)->BinaryInstanceFileOffset += InstanceFileData(theEnv)->CurrentReadBufferSize; } } /***************************************************** NAME : FreeReadBuffer DESCRIPTION : Deallocates buffer for binary reads INPUTS : None RETURNS : Nothing usefu SIDE EFFECTS : Binary global read buffer deallocated NOTES : None *****************************************************/ static void FreeReadBuffer( void *theEnv) { if (InstanceFileData(theEnv)->CurrentReadBufferSize != 0L) { genlongfree(theEnv,(void *) InstanceFileData(theEnv)->CurrentReadBuffer,InstanceFileData(theEnv)->CurrentReadBufferSize); InstanceFileData(theEnv)->CurrentReadBuffer = NULL; InstanceFileData(theEnv)->CurrentReadBufferSize = 0L; } } #endif #endif clips-6.24/clipssrc/tmpltbsc.h0000755000175000017500000000736510441151156014544 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.26 06/05/06 */ /* */ /* DEFTEMPLATE BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deftemplate */ /* construct such as clear, reset, save, undeftemplate, */ /* ppdeftemplate, list-deftemplates, and */ /* get-deftemplate-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_tmpltbsc #define _H_tmpltbsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetDeftemplateList(theEnv,a,b) EnvGetDeftemplateList(theEnv,a,b) #define ListDeftemplates(theEnv,a,b) EnvListDeftemplates(theEnv,a,b) #define Undeftemplate(theEnv,a) EnvUndeftemplate(theEnv,a) #define GetDeftemplateWatch(theEnv,a) EnvGetDeftemplateWatch(theEnv,a) #define SetDeftemplateWatch(theEnv,a,b) EnvSetDeftemplateWatch(theEnv,a,b) #else #define GetDeftemplateList(a,b) EnvGetDeftemplateList(GetCurrentEnvironment(),a,b) #define ListDeftemplates(a,b) EnvListDeftemplates(GetCurrentEnvironment(),a,b) #define Undeftemplate(a) EnvUndeftemplate(GetCurrentEnvironment(),a) #define GetDeftemplateWatch(a) EnvGetDeftemplateWatch(GetCurrentEnvironment(),a) #define SetDeftemplateWatch(a,b) EnvSetDeftemplateWatch(GetCurrentEnvironment(),a,b) #endif LOCALE void DeftemplateBasicCommands(void *); LOCALE void UndeftemplateCommand(void *); LOCALE intBool EnvUndeftemplate(void *,void *); LOCALE void GetDeftemplateListFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetDeftemplateList(void *,DATA_OBJECT_PTR,void *); LOCALE void *DeftemplateModuleFunction(void *); #if DEBUGGING_FUNCTIONS LOCALE void PPDeftemplateCommand(void *); LOCALE int PPDeftemplate(void *,char *,char *); LOCALE void ListDeftemplatesCommand(void *); LOCALE void EnvListDeftemplates(void *,char *,void *); LOCALE unsigned EnvGetDeftemplateWatch(void *,void *); LOCALE void EnvSetDeftemplateWatch(void *,unsigned,void *); LOCALE unsigned DeftemplateWatchAccess(void *,int,unsigned,struct expr *); LOCALE unsigned DeftemplateWatchPrint(void *,char *,int,struct expr *); #endif #endif clips-6.24/clipssrc/edterm.c0000755000175000017500000003657710441163316014177 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Corrected code generating compilation */ /* warnings. */ /* */ /*************************************************************/ #include "setup.h" #if EMACS_EDITOR && ! RUN_TIME #define _EDTERM_SOURCE_ #include "ed.h" #include #if ANSI static void ansimove(int,int); static void ansieeol(void); static void ansieeop(void); static void ansibeep(void); static void ansiparm(int); static void ansiopen(void); #endif #if VT52 static void vt52move(int,int); static void vt52eeol(void); static void vt52eeop(void); static void vt52beep(void); static void vt52parm(int); static void vt52open(void); #endif #if IBM_PC static void pc_open(void); static int scinit(int); static int getboard(void); static int pc_getc(void); static void pc_putc(int); static void pc_move(int,int); static void pc_eeol(void); static void pc_eeop(void); static void pc_beep(void); #endif #if TERMCAP #include /* extern int tgetent(char *,char *); extern char *tgoto(char *,int,int); extern int tputs(register char *,int,int (*)(int)); extern char *tgetstr(char *,char **); */ static void tcapmove(int,int); static void tcapeeol(void); static void tcapeeop(void); static void tcapbeep(void); static void tcapopen(void); static void putpad(char *); #endif /* ========================================================================== * ANSI Terminal * ========================================================================== */ #if ANSI /* * The routines in this section provide support for ANSI style terminals * over a serial line. The serial I/O services are provided by routines in * "termio.c". It compiles into nothing if not an ANSI device. */ #define NROW 23 /* Screen size. */ #define NCOL 77 /* Edit if you want to. */ #define BEL 0x07 /* BEL character. */ #define ESC 0x1B /* ESC character. */ /* * Standard terminal interface dispatch table. Most of the fields point into * "termio" code. */ TERM term = { NROW-1, NCOL, ansiopen, ttclose, ttgetc, ttputc, ttflush, ansimove, ansieeol, ansieeop, ansibeep }; static void ansimove( int row, int col) { ttputc(ESC); ttputc('['); ansiparm(row+1); ttputc(';'); ansiparm(col+1); ttputc('H'); } static void ansieeol() { ttputc(ESC); ttputc('['); ttputc('K'); } static void ansieeop() { ttputc(ESC); ttputc('['); ttputc('J'); } static void ansibeep() { ttputc(BEL); ttflush(); } static void ansiparm( int n) { register int q; q = n/10; if (q != 0) ansiparm(q); ttputc((n%10) + '0'); } static void ansiopen() { #if UNIX_7 || UNIX_V register char *cp; if ((cp = getenv("TERM")) == NULL) { puts("Shell variable TERM not defined!"); exit(1); } if (strcmp(cp, "vt100") != 0) { puts("Terminal type not 'vt100'!"); exit(1); } #endif ttopen(); } #endif /* ========================================================================== * VT52 Terminal * ========================================================================== */ #if VT52 /* * The routines in this section * provide support for VT52 style terminals * over a serial line. The serial I/O services are * provided by routines in "termio.c". It compiles * into nothing if not a VT52 style device. The * bell on the VT52 is terrible, so the "beep" * routine is conditionalized on defining BEL. */ #define NROW 24 /* Screen size. */ #define NCOL 80 /* Edit if you want to. */ #define BIAS 0x20 /* Origin 0 coordinate bias. */ #define ESC 0x1B /* ESC character. */ #define BEL 0x07 /* ascii bell character */ /* * Dispatch table. All the * hard fields just point into the * terminal I/O code. */ globle TERM term = { NROW-1, NCOL, vt52open, ttclose, ttgetc, ttputc, ttflush, vt52move, vt52eeol, vt52eeop, vt52beep }; static void vt52move( int row, int col) { ttputc(ESC); ttputc('Y'); ttputc(row+BIAS); ttputc(col+BIAS); } static void vt52eeol() { ttputc(ESC); ttputc('K'); } static void vt52eeop() { ttputc(ESC); ttputc('J'); } static void vt52beep() { #ifdef BEL ttputc(BEL); ttflush(); #endif } static void vt52open() { #if UNIX_7 || UNIX_V register char *cp; if ((cp = getenv("TERM")) == NULL) { puts("Shell variable TERM not defined!"); exit(1); } if (strcmp(cp, "vt52") != 0 && strcmp(cp, "z19") != 0) { puts("Terminal type not 'vt52'or 'z19' !"); exit(1); } #endif ttopen(); } #endif /* ========================================================================== * IBM PC Code * ========================================================================== */ #if IBM_PC /* Should be an IBM PC using */ /* the Microsoft C compiler */ /* or the Turbo C compiler */ /* or the Zortech C compiler */ /* or the Intel C Code builder */ #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_GCC #include #if IBM_MSC || IBM_ICB || IBM_GCC #include #endif #if IBM_ZTC #include #endif #define NROW 25 /* Screen size. rows */ #define NCOL 80 /* Columns */ #define BEL 0x07 /* BEL character. */ #define ESC 0x1B /* ESC character. */ #define SPACE 32 #if IBM_ICB #define SCADC 0xb8000 /* CGA address of screen RAM */ #define SCADM 0xb0000 /* MONO address of screen RAM */ #else #define SCADC 0xb8000000L /* CGA address of screen RAM */ #define SCADM 0xb0000000L /* MONO address of screen RAM */ #endif #define MONOCRSR 0x0B0D /* monochrome cursor */ #define CGACRSR 0x0607 /* CGA cursor */ #define CDCGA 0 /* color graphics card */ #define CDMONO 1 /* monochrome text card */ #define CDSENSE 9 /* detect the card type */ #define NDRIVE 3 /* number of screen drivers */ /* * Standard terminal interface dispatch table. Most of the fields point into * "termio" code. */ globle TERM term = { NROW-1, NCOL, pc_open, ttclose, pc_getc, pc_putc, ttflush, pc_move, pc_eeol, pc_eeop, pc_beep }; static int dtype = -1; /* current display type */ #if IBM_ICB static int scadd; /* address of screen ram */ static short *scptr[NROW]; /* pointer to screen lines */ static unsigned short sline[NCOL];/* screen line image */ #else static long scadd; /* address of screen ram */ static int *scptr[NROW]; /* pointer to screen lines */ static unsigned int sline[NCOL];/* screen line image */ #endif static union REGS rg; static void pc_open() { scinit(CDSENSE); ttopen(); } static int scinit( /* initialize the screen head pointers */ int type) /* type of adapter to init for */ { #if IBM_ICB union { int laddr; /* long form of address */ short *paddr; /* pointer form of address */ } addr; #else union { long laddr; /* long form of address */ int *paddr; /* pointer form of address */ } addr; #endif int i; #if IBM_ZTC disp_open(); #endif /* if asked...find out what display is connected */ if (type == CDSENSE) type = getboard(); /* if we have nothing to do....don't do it */ if (dtype == type) return(TRUE); switch (type) { case CDMONO: /* Monochrome adapter */ scadd = SCADM; break; case CDCGA: /* Color graphics adapter */ scadd = SCADC; break; } dtype = type; /* initialize the screen pointer array */ for (i = 0; i < NROW; i++) { #if IBM_ICB addr.laddr = scadd + (NCOL * i * 2); #else addr.laddr = scadd + (long)(NCOL * i * 2); #endif scptr[i] = addr.paddr; } return(TRUE); } /* getboard: Determine which type of display board is attached. Current known types include: CDMONO Monochrome graphics adapter CDCGA Color Graphics Adapter */ /* getbaord: Detect the current display adapter if MONO set to MONO CGA set to CGA */ static int getboard() { int type; /* board type to return */ type = CDCGA; int86(0x11, &rg, &rg); if ((((rg.x.ax >> 4) & 3) == 3)) type = CDMONO; return(type); } static int pc_getc() { int intrpt = 22; /* ROM-BIOS call for keyboard read */ rg.h.al = 0; /* Clear input registers */ rg.h.ah = 0; /* and set service to read */ int86(intrpt, &rg, &rg); if(rg.h.al != 0) /* If low byte is not clear */ return(rg.h.al); /* then return value */ else { /* else, */ switch(rg.h.ah) { /* check hi byte for code */ case 3 : return(COTL_AT_SIGN); case 71 : return(HOME_KEY); case 72 : return(UP_ARROW); case 73 : return(PGUP_KEY); case 75 : return(LEFT_ARROW); case 77 : return(RIGHT_ARROW); case 79 : return(END_KEY); case 80 : return(DOWN_ARROW); case 81 : return(PGDN_KEY); case 115 : return(COTL_LEFT_ARROW); case 116 : return(COTL_RIGHT_ARROW); default : return(BADKEY); } } } static void pc_putc( int c) { rg.h.ah = 14; /* write char to screen with current attrs */ rg.h.al = (unsigned char) c; rg.h.bh = 0; rg.h.bl = 0x07; int86(0x10, &rg, &rg); } static void pc_move( int row, int col) { rg.h.ah = 2; /* set cursor position function code */ rg.h.dl = (unsigned char) col; rg.h.dh = (unsigned char) row; rg.h.bh = 0; /* set screen page number */ int86(0x10, &rg, &rg); } static void pc_eeol() { unsigned int attr; /* attribute byte mask to place in RAM */ #if IBM_ICB unsigned short *lnptr; /* pointer to the destination line */ #else unsigned int *lnptr; /* pointer to the destination line */ #endif int i; int ccol; /* current column cursor lives */ int crow; /* row */ /* find the current cursor position */ rg.h.ah = 3; /* read cursor position function code */ rg.h.bh = 0; /* current video page */ int86(0x10, &rg, &rg); ccol = rg.h.dl; /* record current column */ crow = rg.h.dh; /* and row */ /* build the attribute byte and setup the screen pointer */ attr = 0x0700; lnptr = &sline[0]; for (i=0; i < term.t_ncol; i++) *lnptr++ = SPACE | attr; if (dtype == CDCGA) { /* wait for vertical retrace to be off */ while ((inp(0x3da) & 8)) ; /* and to be back on */ while ((inp(0x3da) & 8) == 0) ; } #if IBM_ZTC disp_move(crow,ccol); disp_flush(); disp_eeol(); #endif /* and send the string out */ #if (! IBM_ZTC) memmove(scptr[crow]+ccol, &sline[0], (term.t_ncol-ccol)*2); #endif } static void pc_eeop() { int attr; /* attribute to fill screen with */ rg.h.ah = 6; /* scroll page up function code */ rg.h.al = 0; /* # lines to scroll (clear it) */ rg.x.cx = 0; /* upper left corner of scroll */ rg.x.dx = (term.t_nrow << 8) | (term.t_ncol - 1); /* lower right corner of scroll */ attr = 0x07; rg.h.bh = (unsigned char) attr; int86(0x10, &rg, &rg); } static void pc_beep() { pc_putc(BEL); ttflush(); } #endif #endif /* ========================================================================== * Termcap Terminal * ========================================================================== */ #if TERMCAP /* * The routines in this section provide support for terminals supported * through the UNIX termcap capability. * * You need to include the termcap library at link time * or else most of the calls to t____ functions don't work */ #define NROW 24 #define NCOL 80 #define BEL 0x07 #define ESC 0x1B #define TCAPSLEN 315 static char tcapbuf[TCAPSLEN]; static char /*PC,*/ *CM, *CE, /* *UP, */ *CD; globle TERM term = { NROW-1, NCOL, tcapopen, ttclose, ttgetc, ttputc, ttflush, tcapmove, tcapeeol, tcapeeop, tcapbeep }; static void tcapopen() { char *t, *p; char tcbuf[1024]; char *tv_stype; char err_str[72]; if ((tv_stype = getenv("TERM")) == NULL) { puts("Environment variable TERM not defined!"); exit(1); } if((tgetent(tcbuf, tv_stype)) != 1) { sprintf(err_str, "Unknown terminal type %s!", tv_stype); puts(err_str); exit(1); } p = tcapbuf; t = tgetstr("pc", &p); if(t) PC = *t; CD = tgetstr("cd", &p); CM = tgetstr("cm", &p); CE = tgetstr("ce", &p); UP = tgetstr("up", &p); if(CD == NULL || CM == NULL || CE == NULL || UP == NULL) { puts("Incomplete termcap entry\n"); exit(1); } if (p >= &tcapbuf[TCAPSLEN]) { puts("Terminal description too big!\n"); exit(1); } ttopen(); } static void tcapmove( int row, int col) { putpad(tgoto(CM, col, row)); } static void tcapeeol() { putpad(CE); } static void tcapeeop() { putpad(CD); } static void tcapbeep() { ttputc(BEL); } static void putpad( char *str) { tputs(str, 1, (int (*)(int)) ttputc); } #endif #endif /* end original EMACS_EDITOR definition */ clips-6.24/clipssrc/factgen.c0000755000175000017500000014021707422635007014317 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT RETE FUNCTION GENERATION MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Creates expressions used by the fact pattern */ /* matcher and the join network. The expressions created */ /* are used to extract and compare values from facts as */ /* needed by the Rete pattern matching algorithm. These */ /* expressions are also used to extract values from facts */ /* needed by expressions on the RHS of a rule. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _FACTGEN_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT #include #define _STDIO_INCLUDED_ #include "constant.h" #include "memalloc.h" #include "router.h" #include "scanner.h" #include "exprnpsr.h" #include "constrct.h" #include "network.h" #include "reteutil.h" #include "factmch.h" #include "factrete.h" #include "factmngr.h" #include "pattern.h" #include "factprt.h" #include "envrnmnt.h" #include "tmpltdef.h" #include "tmpltlhs.h" #include "factgen.h" #define FACTGEN_DATA 2 struct factgenData { globle struct entityRecord FactJNGV1Info; globle struct entityRecord FactJNGV2Info; globle struct entityRecord FactJNGV3Info; globle struct entityRecord FactPNGV1Info; globle struct entityRecord FactPNGV2Info; globle struct entityRecord FactPNGV3Info; globle struct entityRecord FactJNCV1Info; globle struct entityRecord FactJNCV2Info; globle struct entityRecord FactPNCV1Info; globle struct entityRecord FactStoreMFInfo; globle struct entityRecord FactSlotLengthInfo; globle struct entityRecord FactPNConstant1Info; globle struct entityRecord FactPNConstant2Info; }; #define FactgenData(theEnv) ((struct factgenData *) GetEnvironmentData(theEnv,FACTGEN_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static void *FactGetVarJN1(void *,struct lhsParseNode *); static void *FactGetVarJN2(void *,struct lhsParseNode *); static void *FactGetVarJN3(void *,struct lhsParseNode *); static void *FactGetVarPN1(void *,struct lhsParseNode *); static void *FactGetVarPN2(void *,struct lhsParseNode *); static void *FactGetVarPN3(void *,struct lhsParseNode *); #endif /*******************************************************************/ /* InitializeFactReteFunctions: Installs the fact pattern matching */ /* and value access routines as primitive operations. */ /*******************************************************************/ globle void InitializeFactReteFunctions( void *theEnv) { #if DEFRULE_CONSTRUCT struct entityRecord factJNGV1Info = { "FACT_JN_VAR1", FACT_JN_VAR1,0,1,0, PrintFactJNGetVar1, PrintFactJNGetVar1,NULL, FactJNGetVar1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factJNGV2Info = { "FACT_JN_VAR2", FACT_JN_VAR2,0,1,0, PrintFactJNGetVar2, PrintFactJNGetVar2,NULL, FactJNGetVar2, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factJNGV3Info = { "FACT_JN_VAR3", FACT_JN_VAR3,0,1,0, PrintFactJNGetVar3, PrintFactJNGetVar3,NULL, FactJNGetVar3, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNGV1Info = { "FACT_PN_VAR1", FACT_PN_VAR1,0,1,0, PrintFactPNGetVar1, PrintFactPNGetVar1,NULL, FactPNGetVar1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNGV2Info = { "FACT_PN_VAR2", FACT_PN_VAR2,0,1,0, PrintFactPNGetVar2, PrintFactPNGetVar2,NULL, FactPNGetVar2, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNGV3Info = { "FACT_PN_VAR3", FACT_PN_VAR3,0,1,0, PrintFactPNGetVar3, PrintFactPNGetVar3,NULL, FactPNGetVar3, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factJNCV1Info = { "FACT_JN_CMP1", FACT_JN_CMP1,0,1,1, PrintFactJNCompVars1, PrintFactJNCompVars1,NULL, FactJNCompVars1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factJNCV2Info = { "FACT_JN_CMP2", FACT_JN_CMP2,0,1,1, PrintFactJNCompVars2, PrintFactJNCompVars2,NULL, FactJNCompVars2, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNCV1Info = { "FACT_PN_CMP1", FACT_PN_CMP1,0,1,1, PrintFactPNCompVars1, PrintFactPNCompVars1,NULL, FactPNCompVars1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factStoreMFInfo = { "FACT_STORE_MULTIFIELD", FACT_STORE_MULTIFIELD,0,1,0, NULL,NULL,NULL, FactStoreMultifield, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factSlotLengthInfo = { "FACT_SLOT_LENGTH", FACT_SLOT_LENGTH,0,1,0, PrintFactSlotLength, PrintFactSlotLength,NULL, FactSlotLength, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNConstant1Info = { "FACT_PN_CONSTANT1", FACT_PN_CONSTANT1,0,1,1, PrintFactPNConstant1, PrintFactPNConstant1,NULL, FactPNConstant1, NULL,NULL,NULL,NULL,NULL,NULL }; struct entityRecord factPNConstant2Info = { "FACT_PN_CONSTANT2", FACT_PN_CONSTANT2,0,1,1, PrintFactPNConstant2, PrintFactPNConstant2,NULL, FactPNConstant2, NULL,NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,FACTGEN_DATA,sizeof(struct factgenData),NULL); memcpy(&FactgenData(theEnv)->FactJNGV1Info,&factJNGV1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactJNGV2Info,&factJNGV2Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactJNGV3Info,&factJNGV3Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNGV1Info,&factPNGV1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNGV2Info,&factPNGV2Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNGV3Info,&factPNGV3Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactJNCV1Info,&factJNCV1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactJNCV2Info,&factJNCV2Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNCV1Info,&factPNCV1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactStoreMFInfo,&factStoreMFInfo,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactSlotLengthInfo,&factSlotLengthInfo,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNConstant1Info,&factPNConstant1Info,sizeof(struct entityRecord)); memcpy(&FactgenData(theEnv)->FactPNConstant2Info,&factPNConstant2Info,sizeof(struct entityRecord)); InstallPrimitive(theEnv,(ENTITY_RECORD_PTR) &FactData(theEnv)->FactInfo,FACT_ADDRESS); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNGV1Info,FACT_JN_VAR1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNGV2Info,FACT_JN_VAR2); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNGV3Info,FACT_JN_VAR3); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNGV1Info,FACT_PN_VAR1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNGV2Info,FACT_PN_VAR2); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNGV3Info,FACT_PN_VAR3); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNCV1Info,FACT_JN_CMP1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactJNCV2Info,FACT_JN_CMP2); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNCV1Info,FACT_PN_CMP1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactStoreMFInfo,FACT_STORE_MULTIFIELD); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactSlotLengthInfo,FACT_SLOT_LENGTH); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNConstant1Info,FACT_PN_CONSTANT1); InstallPrimitive(theEnv,&FactgenData(theEnv)->FactPNConstant2Info,FACT_PN_CONSTANT2); #endif } #if (! RUN_TIME) && (! BLOAD_ONLY) /******************************************************************/ /* FactGenPNConstant: Generates an expression for use in the fact */ /* pattern network that compares a field from a single field or */ /* multifield slot against a constant. */ /******************************************************************/ globle struct expr *FactGenPNConstant( void *theEnv, struct lhsParseNode *theField) { struct expr *top; unsigned short tempValue; struct factConstantPN1Call hack1; struct factConstantPN2Call hack2; /*=================================================================*/ /* If the value of a single field slot (or relation name) is being */ /* compared against a constant, then use specialized routines for */ /* doing the comparison. */ /*=================================================================*/ if (theField->withinMultifieldSlot == FALSE) { ClearBitString(&hack1,sizeof(struct factConstantPN1Call)); if (theField->negated) hack1.testForEquality = FALSE; else hack1.testForEquality = TRUE; hack1.whichSlot = theField->slotNumber - 1; top = GenConstant(theEnv,FACT_PN_CONSTANT1,AddBitMap(theEnv,&hack1,sizeof(struct factConstantPN1Call))); top->argList = GenConstant(theEnv,theField->type,theField->value); return(top); } /*=================================================================*/ /* If a constant comparison is being done within a multifield slot */ /* and the constant's position has no multifields to the left, */ /* then use the same routine used for the single field slot case, */ /* but include the offset from the beginning of the slot. */ /*=================================================================*/ else if ((theField->multiFieldsBefore == 0) || ((theField->multiFieldsBefore == 1) && (theField->multiFieldsAfter == 0))) { ClearBitString(&hack2,sizeof(struct factConstantPN2Call)); if (theField->negated) hack2.testForEquality = FALSE; else hack2.testForEquality = TRUE; hack2.whichSlot = theField->slotNumber - 1; if (theField->multiFieldsBefore == 0) { hack2.fromBeginning = TRUE; hack2.offset = theField->singleFieldsBefore; } else { hack2.fromBeginning = FALSE; hack2.offset = theField->singleFieldsAfter; } top = GenConstant(theEnv,FACT_PN_CONSTANT2,AddBitMap(theEnv,&hack2,sizeof(struct factConstantPN2Call))); top->argList = GenConstant(theEnv,theField->type,theField->value); return(top); } /*===============================================================*/ /* Otherwise, use the equality or inequality function to compare */ /* the constant against the value returned by the appropriate */ /* pattern network variable retrieval function call. */ /*===============================================================*/ else { if (theField->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } tempValue = theField->type; theField->type = SF_VARIABLE; top->argList = FactGenGetfield(theEnv,theField); theField->type = tempValue; top->argList->nextArg = GenConstant(theEnv,theField->type,theField->value); } /*===============================================================*/ /* Return the expression for performing the constant comparison. */ /*===============================================================*/ return(top); } /*******************************************************/ /* FactGenGetfield: Generates an expression for use in */ /* the fact pattern network that retrieves a value */ /* from a single or multifield slot. */ /*******************************************************/ globle struct expr *FactGenGetfield( void *theEnv, struct lhsParseNode *theNode) { /*===================================================*/ /* Generate call to retrieve single field slot value */ /* or the fact relation name. */ /*===================================================*/ if ((theNode->slotNumber > 0) && (theNode->withinMultifieldSlot == FALSE)) { return(GenConstant(theEnv,FACT_PN_VAR2,FactGetVarPN2(theEnv,theNode))); } /*=====================================================*/ /* Generate call to retrieve a value from a multifield */ /* slot that contains at most one multifield variable */ /* or contains no multifield variables before the */ /* value to be retrieved. */ /*=====================================================*/ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) && ((theNode->multiFieldsBefore == 0) || ((theNode->multiFieldsBefore == 1) && (theNode->multiFieldsAfter == 0)))) { return(GenConstant(theEnv,FACT_PN_VAR3,FactGetVarPN3(theEnv,theNode))); } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { return(GenConstant(theEnv,FACT_PN_VAR3,FactGetVarPN3(theEnv,theNode))); } /*=========================================*/ /* Generate call to retrieve a value using */ /* the most general retrieval function. */ /*=========================================*/ return(GenConstant(theEnv,FACT_PN_VAR1,FactGetVarPN1(theEnv,theNode))); } /**************************************************/ /* FactGenGetvar: Generates an expression for use */ /* in the join network that retrieves a value */ /* from a single or multifield slot of a fact. */ /**************************************************/ globle struct expr *FactGenGetvar( void *theEnv, struct lhsParseNode *theNode) { /*====================================================*/ /* Generate call to retrieve single field slot value. */ /*====================================================*/ if ((theNode->slotNumber > 0) && (theNode->withinMultifieldSlot == FALSE)) { return(GenConstant(theEnv,FACT_JN_VAR2,FactGetVarJN2(theEnv,theNode))); } /*=====================================================*/ /* Generate call to retrieve a value from a multifield */ /* slot that contains at most one multifield variable */ /* or contains no multifield variables before the */ /* value to be retrieved. */ /*=====================================================*/ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) && ((theNode->multiFieldsBefore == 0) || ((theNode->multiFieldsBefore == 1) && (theNode->multiFieldsAfter == 0)))) { return(GenConstant(theEnv,FACT_JN_VAR3,FactGetVarJN3(theEnv,theNode))); } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { return(GenConstant(theEnv,FACT_JN_VAR3,FactGetVarJN3(theEnv,theNode))); } /*=========================================*/ /* Generate call to retrieve a value using */ /* the most general retrieval function. */ /*=========================================*/ return(GenConstant(theEnv,FACT_JN_VAR1,FactGetVarJN1(theEnv,theNode))); } /**************************************************************/ /* FactGenCheckLength: Generates an expression for use in the */ /* fact pattern network that determines if the value of a */ /* multifield slot contains enough fields to satisfy the */ /* number of pattern matching constaints. For example, the */ /* slot constraints (foo ?x a $? ?y) couldn't be matched */ /* unless the foo slot contained at least 3 fields. */ /**************************************************************/ globle struct expr *FactGenCheckLength( void *theEnv, struct lhsParseNode *theNode) { struct factCheckLengthPNCall hack; /*===================================================*/ /* If the slot contains no single field constraints, */ /* then a length test is not necessary. */ /*===================================================*/ if ((theNode->singleFieldsAfter == 0) && (theNode->type != SF_VARIABLE) && (theNode->type != SF_WILDCARD)) { return(NULL); } /*=======================================*/ /* Initialize the length test arguments. */ /*=======================================*/ ClearBitString(&hack,sizeof(struct factCheckLengthPNCall)); hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); /*============================================*/ /* If the slot has no multifield constraints, */ /* then the length must match exactly. */ /*============================================*/ if ((theNode->type != MF_VARIABLE) && (theNode->type != MF_WILDCARD) && (theNode->multiFieldsAfter == 0)) { hack.exactly = 1; } else { hack.exactly = 0; } /*============================================*/ /* The minimum length is the number of single */ /* field constraints contained in the slot. */ /*============================================*/ if ((theNode->type == SF_VARIABLE) || (theNode->type == SF_WILDCARD)) { hack.minLength = (unsigned short) (1 + theNode->singleFieldsAfter); } else { hack.minLength = theNode->singleFieldsAfter; } /*========================================================*/ /* Generate call to test the length of a multifield slot. */ /*========================================================*/ return(GenConstant(theEnv,FACT_SLOT_LENGTH,AddBitMap(theEnv,&hack,sizeof(struct factCheckLengthPNCall)))); } /**************************************************************/ /* FactGenCheckZeroLength: Generates an expression for use in */ /* the fact pattern network that determines if the value of */ /* a multifield slot is a zero length multifield value. */ /**************************************************************/ globle struct expr *FactGenCheckZeroLength( void *theEnv, unsigned theSlot) { struct factCheckLengthPNCall hack; ClearBitString(&hack,sizeof(struct factCheckLengthPNCall)); hack.whichSlot = (unsigned short) (theSlot - 1); hack.exactly = 1; hack.minLength = 0; return(GenConstant(theEnv,FACT_SLOT_LENGTH,AddBitMap(theEnv,&hack,sizeof(struct factCheckLengthPNCall)))); } /*********************************************************************/ /* FactReplaceGetvar: Replaces a variable reference in an expression */ /* with a function call to retrieve the variable using the join */ /* network variable access functions for facts. */ /*********************************************************************/ globle void FactReplaceGetvar( void *theEnv, struct expr *theItem, struct lhsParseNode *theNode) { /*====================================================*/ /* Generate call to retrieve single field slot value. */ /*====================================================*/ if ((theNode->slotNumber > 0) && (theNode->withinMultifieldSlot == FALSE)) { theItem->type = FACT_JN_VAR2; theItem->value = FactGetVarJN2(theEnv,theNode); return; } /*=====================================================*/ /* Generate call to retrieve a value from a multifield */ /* slot that contains at most one multifield variable */ /* or contains no multifield variables before the */ /* value to be retrieved. */ /*=====================================================*/ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) && ((theNode->multiFieldsBefore == 0) || ((theNode->multiFieldsBefore == 1) && (theNode->multiFieldsAfter == 0)))) { theItem->type = FACT_JN_VAR3; theItem->value = FactGetVarJN3(theEnv,theNode); return; } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { theItem->type = FACT_JN_VAR3; theItem->value = FactGetVarJN3(theEnv,theNode); return; } /*=========================================*/ /* Generate call to retrieve a value using */ /* the most general retrieval function. */ /*=========================================*/ theItem->type = FACT_JN_VAR1; theItem->value = FactGetVarJN1(theEnv,theNode); } /***********************************************************************/ /* FactReplaceGetfield: Replaces a variable reference in an expression */ /* with a function call to retrieve the variable using the pattern */ /* network variable access functions for facts. */ /***********************************************************************/ globle void FactReplaceGetfield( void *theEnv, struct expr *theItem, struct lhsParseNode *theNode) { /*====================================================*/ /* Generate call to retrieve single field slot value. */ /*====================================================*/ if (theNode->withinMultifieldSlot == FALSE) { theItem->type = FACT_PN_VAR2; theItem->value = FactGetVarPN2(theEnv,theNode); return; } /*=====================================================*/ /* Generate call to retrieve a value from a multifield */ /* slot that contains at most one multifield variable */ /* or contains no multifield variables before the */ /* value to be retrieved. */ /*=====================================================*/ if (((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) && ((theNode->multiFieldsBefore == 0) || ((theNode->multiFieldsBefore == 1) && (theNode->multiFieldsAfter == 0)))) { theItem->type = FACT_PN_VAR3; theItem->value = FactGetVarPN3(theEnv,theNode); return; } if (((theNode->type == MF_WILDCARD) || (theNode->type == MF_VARIABLE)) && (theNode->multiFieldsBefore == 0) && (theNode->multiFieldsAfter == 0)) { theItem->type = FACT_PN_VAR3; theItem->value = FactGetVarPN3(theEnv,theNode); return; } /*=========================================*/ /* Generate call to retrieve a value using */ /* the most general retrieval function. */ /*=========================================*/ theItem->type = FACT_PN_VAR1; theItem->value = FactGetVarPN1(theEnv,theNode); } /*************************************************************/ /* FactGetVarJN1: Creates the arguments for the most general */ /* routine for retrieving a variable's value from the slot */ /* of a fact. The retrieval relies on information stored */ /* in a partial match, so this retrieval mechanism is used */ /* by expressions in the join network or from the RHS of a */ /* rule. */ /*************************************************************/ static void *FactGetVarJN1( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarJN1Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarJN1Call)); /*========================================*/ /* A slot value of zero indicates that we */ /* want the pattern address returned. */ /*========================================*/ if (theNode->slotNumber <= 0) { hack.factAddress = 1; hack.allFields = 0; hack.whichSlot = 0; hack.whichField = 0; } /*=====================================================*/ /* A slot value greater than zero and a field value of */ /* zero indicate that we want the entire contents of */ /* the slot whether it is a single field or multifield */ /* slot. */ /*=====================================================*/ else if (theNode->index <= 0) { hack.factAddress = 0; hack.allFields = 1; hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichField = 0; } /*=====================================================*/ /* A slot value, m, and a field value, n, both greater */ /* than zero indicate that we want the nth field of */ /* the mth slot. */ /*=====================================================*/ else { hack.factAddress = 0; hack.allFields = 0; hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichField = (unsigned short) (theNode->index - 1); } /*=========================================*/ /* Store the position in the partial match */ /* from which the fact will be retrieved. */ /*=========================================*/ hack.whichPattern = (unsigned short) (theNode->pattern - 1); /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(AddBitMap(theEnv,&hack,sizeof(struct factGetVarJN1Call))); } /**************************************************************/ /* FactGetVarJN2: Creates the arguments for the routine which */ /* retrieves a variable's value from a single field slot of */ /* a fact. The retrieval relies on information stored in a */ /* partial match, so this retrieval mechanism is used by */ /* expressions in the join network or from the RHS of a */ /* rule. */ /**************************************************************/ static void *FactGetVarJN2( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarJN2Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarJN2Call)); /*=====================================================*/ /* Store the position in the partial match from which */ /* the fact will be retrieved and the slot in the fact */ /* from which the value will be retrieved. */ /*=====================================================*/ hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichPattern = (unsigned short) (theNode->pattern - 1); /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(AddBitMap(theEnv,&hack,sizeof(struct factGetVarJN2Call))); } /*************************************************************/ /* FactGetVarJN3: Creates the arguments for the routine for */ /* retrieving a variable's value from a multifield slot of */ /* a fact. For this routine, the variable's value must be */ /* from a multifield slot that contains at most one */ /* multifield variable or contains no multifield variables */ /* before the variable's value to be retrieved. The */ /* retrieval relies on information stored in a partial */ /* match, so this retrieval mechanism is used by */ /* expressions in the join network or from the RHS of a */ /* rule. */ /*************************************************************/ static void *FactGetVarJN3( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarJN3Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarJN3Call)); /*=====================================================*/ /* Store the position in the partial match from which */ /* the fact will be retrieved and the slot in the fact */ /* from which the value will be retrieved. */ /*=====================================================*/ hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichPattern = (unsigned short) (theNode->pattern - 1); /*==============================================================*/ /* If a single field variable value is being retrieved, then... */ /*==============================================================*/ if ((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) { /*=========================================================*/ /* If no multifield values occur before the variable, then */ /* the variable's value can be retrieved based on its */ /* offset from the beginning of the slot's value */ /* regardless of the number of multifield variables or */ /* wildcards following the variable being retrieved. */ /*=========================================================*/ if (theNode->multiFieldsBefore == 0) { hack.fromBeginning = 1; hack.fromEnd = 0; hack.beginOffset = theNode->singleFieldsBefore; hack.endOffset = 0; } /*===============================================*/ /* Otherwise the variable is retrieved based its */ /* position relative to the end of the slot. */ /*===============================================*/ else { hack.fromBeginning = 0; hack.fromEnd = 1; hack.beginOffset = 0; hack.endOffset = theNode->singleFieldsAfter; } /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(AddBitMap(theEnv,&hack,sizeof(struct factGetVarJN3Call))); } /*============================================================*/ /* A multifield variable value is being retrieved. This means */ /* that there are no other multifield variables or wildcards */ /* in the slot. The multifield value is retrieved by storing */ /* the number of single field values which come before and */ /* after the multifield value. The multifield value can then */ /* be retrieved based on the length of the value in the slot */ /* and the number of single field values which must occur */ /* before and after the multifield value. */ /*============================================================*/ hack.fromBeginning = 1; hack.fromEnd = 1; hack.beginOffset = theNode->singleFieldsBefore; hack.endOffset = theNode->singleFieldsAfter; /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(AddBitMap(theEnv,&hack,sizeof(struct factGetVarJN3Call))); } /**************************************************************/ /* FactGetVarPN1: Creates the arguments for the most general */ /* routine for retrieving a variable's value from the slot */ /* of a fact. The retrieval relies on information stored */ /* during fact pattern matching, so this retrieval */ /* mechanism is only used by expressions in the pattern */ /* network. */ /**************************************************************/ static void *FactGetVarPN1( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarPN1Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarPN1Call)); /*========================================*/ /* A slot value of zero indicates that we */ /* want the pattern address returned. */ /*========================================*/ if (theNode->slotNumber <= 0) { hack.factAddress = 1; hack.allFields = 0; hack.whichSlot = 0; hack.whichField = 0; } /*=====================================================*/ /* A slot value greater than zero and a field value of */ /* zero indicate that we want the entire contents of */ /* the slot whether it is a single field or multifield */ /* slot. */ /*=====================================================*/ else if (theNode->index <= 0) { hack.factAddress = 0; hack.allFields = 1; hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichField = 0; } /*=============================================*/ /* A slot value, m, and a field value, n, both */ /* greater than zero indicate that we want the */ /* nth field of the mth slot. */ /*=============================================*/ else { hack.factAddress = 0; hack.allFields = 0; hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); hack.whichField = (unsigned short) (theNode->index - 1); } /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(AddBitMap(theEnv,&hack,sizeof(struct factGetVarPN1Call))); } /***************************************************************/ /* FactGetVarPN2: Creates the arguments for the routine which */ /* retrieves a variable's value from a single field slot of */ /* a fact. The retrieval relies on information stored during */ /* fact pattern matching, so this retrieval mechanism is */ /* only used by expressions in the pattern network. */ /***************************************************************/ static void *FactGetVarPN2( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarPN2Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarPN2Call)); /*=======================================*/ /* Store the slot in the fact from which */ /* the value will be retrieved. */ /*=======================================*/ hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(AddBitMap(theEnv,&hack,sizeof(struct factGetVarPN2Call))); } /*************************************************************/ /* FactGetVarPN3: Creates the arguments for the routine for */ /* retrieving a variable's value from a multifield slot of */ /* a fact. For this routine, the variable's value must be */ /* from a multifield slot that contains at most one */ /* multifield variable or contains no multifield variables */ /* before the variable's value to be retrieved. The */ /* retrieval relies on information stored during fact */ /* pattern matching, so this retrieval mechanism is only */ /* used by expressions in the pattern network. */ /*************************************************************/ static void *FactGetVarPN3( void *theEnv, struct lhsParseNode *theNode) { struct factGetVarPN3Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factGetVarPN3Call)); /*=======================================*/ /* Store the slot in the fact from which */ /* the value will be retrieved. */ /*=======================================*/ hack.whichSlot = (unsigned short) (theNode->slotNumber - 1); /*==============================================================*/ /* If a single field variable value is being retrieved, then... */ /*==============================================================*/ if ((theNode->type == SF_WILDCARD) || (theNode->type == SF_VARIABLE)) { /*=========================================================*/ /* If no multifield values occur before the variable, then */ /* the variable's value can be retrieved based on its */ /* offset from the beginning of the slot's value */ /* regardless of the number of multifield variables or */ /* wildcards following the variable being retrieved. */ /*=========================================================*/ if (theNode->multiFieldsBefore == 0) { hack.fromBeginning = 1; hack.fromEnd = 0; hack.beginOffset = theNode->singleFieldsBefore; hack.endOffset = 0; } /*===============================================*/ /* Otherwise the variable is retrieved based its */ /* position relative to the end of the slot. */ /*===============================================*/ else { hack.fromBeginning = 0; hack.fromEnd = 1; hack.beginOffset = 0; hack.endOffset = theNode->singleFieldsAfter; } return(AddBitMap(theEnv,&hack,sizeof(struct factGetVarPN3Call))); } /*============================================================*/ /* A multifield variable value is being retrieved. This means */ /* that there are no other multifield variables or wildcards */ /* in the slot. The multifield value is retrieved by storing */ /* the number of single field values which come before and */ /* after the multifield value. The multifield value can then */ /* be retrieved based on the length of the value in the slot */ /* and the number of single field values which must occur */ /* before and after the multifield value. */ /*============================================================*/ hack.fromBeginning = 1; hack.fromEnd = 1; hack.beginOffset = theNode->singleFieldsBefore; hack.endOffset = theNode->singleFieldsAfter; /*=============================*/ /* Return the argument bitmap. */ /*=============================*/ return(AddBitMap(theEnv,&hack,sizeof(struct factGetVarPN3Call))); } /*************************************************************/ /* FactPNVariableComparison: Generates an expression for use */ /* in the fact pattern network to compare two variables of */ /* the same name found in the same pattern. */ /*************************************************************/ globle struct expr *FactPNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { struct expr *top; struct factCompVarsPN1Call hack; /*===================================================*/ /* Clear the bitmap for storing the argument values. */ /*===================================================*/ ClearBitString(&hack,sizeof(struct factCompVarsPN1Call)); /*================================================================*/ /* If two single field slots of a deftemplate are being compared, */ /* then use the following specified variable comparison routine. */ /*================================================================*/ if ((selfNode->withinMultifieldSlot == FALSE) && (selfNode->slotNumber > 0) && (referringNode->withinMultifieldSlot == FALSE) && (referringNode->slotNumber > 0)) { hack.pass = 0; hack.fail = 0; hack.field1 = (unsigned int) selfNode->slotNumber - 1; hack.field2 = (unsigned int) referringNode->slotNumber - 1; if (selfNode->negated) hack.fail = 1; else hack.pass = 1; top = GenConstant(theEnv,FACT_PN_CMP1,AddBitMap(theEnv,&hack,sizeof(struct factCompVarsPN1Call))); } /*================================================================*/ /* Otherwise, use the eq function to compare the values retrieved */ /* by the appropriate get variable value functions. */ /*================================================================*/ else { if (selfNode->negated) top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); else top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); top->argList = FactGenGetfield(theEnv,selfNode); top->argList->nextArg = FactGenGetfield(theEnv,referringNode); } /*======================================*/ /* Return the expression for performing */ /* the variable comparison. */ /*======================================*/ return(top); } /*********************************************************/ /* FactJNVariableComparison: Generates an expression for */ /* use in the join network to compare two variables of */ /* the same name found in different patterns. */ /*********************************************************/ globle struct expr *FactJNVariableComparison( void *theEnv, struct lhsParseNode *selfNode, struct lhsParseNode *referringNode) { struct expr *top; struct factCompVarsJN1Call hack1; struct factCompVarsJN2Call hack2; /*================================================================*/ /* If two single field slots of a deftemplate are being compared, */ /* then use the following specified variable comparison routine. */ /*================================================================*/ if ((selfNode->withinMultifieldSlot == FALSE) && (selfNode->slotNumber > 0) && (referringNode->withinMultifieldSlot == FALSE) && (referringNode->slotNumber > 0)) { ClearBitString(&hack1,sizeof(struct factCompVarsJN1Call)); hack1.pass = 0; hack1.fail = 0; hack1.slot1 = (unsigned int) selfNode->slotNumber - 1; hack1.pattern2 = (unsigned int) referringNode->pattern; if (referringNode->index < 0) hack1.slot2 = 0; else hack1.slot2 = (unsigned int) referringNode->slotNumber - 1; if (selfNode->negated) hack1.fail = 1; else hack1.pass = 1; top = GenConstant(theEnv,FACT_JN_CMP1,AddBitMap(theEnv,&hack1,sizeof(struct factCompVarsJN1Call))); } /*===============================================================*/ /* If two single field values are compared and either or both of */ /* them are contained in multifield slots (and the value can be */ /* accessed relative to either the beginning or end of the slot */ /* with no intervening multifield variables), then use the */ /* following specified variable comparison routine. */ /*===============================================================*/ else if ((selfNode->slotNumber > 0) && (selfNode->type == SF_VARIABLE) && ((selfNode->multiFieldsBefore == 0) || ((selfNode->multiFieldsBefore == 1) && (selfNode->multiFieldsAfter == 0))) && (referringNode->slotNumber > 0) && (referringNode->type == SF_VARIABLE) && ((referringNode->multiFieldsBefore == 0) || (referringNode->multiFieldsAfter == 0))) { ClearBitString(&hack2,sizeof(struct factCompVarsJN2Call)); hack2.pass = 0; hack2.fail = 0; hack2.slot1 = (unsigned int) selfNode->slotNumber - 1; hack2.pattern2 = (unsigned int) referringNode->pattern; hack2.slot2 = (unsigned int) referringNode->slotNumber - 1; if (selfNode->multiFieldsBefore == 0) { hack2.fromBeginning1 = 1; hack2.offset1 = selfNode->singleFieldsBefore; } else { hack2.fromBeginning1 = 0; hack2.offset1 = selfNode->singleFieldsAfter; } if (referringNode->multiFieldsBefore == 0) { hack2.fromBeginning2 = 1; hack2.offset2 = referringNode->singleFieldsBefore; } else { hack2.fromBeginning2 = 0; hack2.offset2 = referringNode->singleFieldsAfter; } if (selfNode->negated) hack2.fail = 1; else hack2.pass = 1; top = GenConstant(theEnv,FACT_JN_CMP2,AddBitMap(theEnv,&hack2,sizeof(struct factCompVarsJN2Call))); } /*===============================================================*/ /* Otherwise, use the equality or inequality function to compare */ /* the values returned by the appropriate join network variable */ /* retrieval function call. */ /*===============================================================*/ else { if (selfNode->negated) { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); } else { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); } top->argList = FactGenGetvar(theEnv,selfNode); top->argList->nextArg = FactGenGetvar(theEnv,referringNode); } /*======================================*/ /* Return the expression for performing */ /* the variable comparison. */ /*======================================*/ return(top); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._prntutil.c0000400000175000017500000000075410441602272014763 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoFeVFeVĿ:8P8]4TTFL-FMPSRMWBBLclips-6.24/clipssrc/dffnxbin.c0000755000175000017500000004734710177533433014521 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions for Deffunctions */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "bsave.h" #include "memalloc.h" #include "cstrcbin.h" #include "envrnmnt.h" #include "modulbin.h" #define _DFFNXBIN_SOURCE_ #include "dffnxbin.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef struct bsaveDeffunctionModule { struct bsaveDefmoduleItemHeader header; } BSAVE_DEFFUNCTION_MODULE; typedef struct bsaveDeffunctionStruct { struct bsaveConstructHeader header; int minNumberOfParameters, maxNumberOfParameters, numberOfLocalVars; long name, code; } BSAVE_DEFFUNCTION; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveDeffunctionFind(void *); static void MarkDeffunctionItems(void *,struct constructHeader *,void *); static void BsaveDeffunctionExpressions(void *,FILE *); static void BsaveDeffunctionExpression(void *,struct constructHeader *,void *); static void BsaveStorageDeffunctions(void *,FILE *); static void BsaveDeffunctions(void *,FILE *); static void BsaveDeffunction(void *,struct constructHeader *,void *); #endif static void BloadStorageDeffunctions(void *); static void BloadDeffunctions(void *); static void UpdateDeffunctionModule(void *,void *,long); static void UpdateDeffunction(void *,void *,long); static void ClearDeffunctionBload(void *); static void DeallocateDeffunctionBloadData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupDeffunctionsBload DESCRIPTION : Initializes data structures and routines for binary loads of deffunctions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupDeffunctionsBload( void *theEnv) { AllocateEnvironmentData(theEnv,DFFNXBIN_DATA,sizeof(struct deffunctionBinaryData),DeallocateDeffunctionBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"deffunctions",0,BsaveDeffunctionFind,BsaveDeffunctionExpressions, BsaveStorageDeffunctions,BsaveDeffunctions, BloadStorageDeffunctions,BloadDeffunctions, ClearDeffunctionBload); #else AddBinaryItem(theEnv,"deffunctions",0,NULL,NULL,NULL,NULL, BloadStorageDeffunctions,BloadDeffunctions, ClearDeffunctionBload); #endif } /***********************************************************/ /* DeallocateDeffunctionBloadData: Deallocates environment */ /* data for the deffunction bsave functionality. */ /***********************************************************/ static void DeallocateDeffunctionBloadData( void *theEnv) { unsigned long space; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) space = DeffunctionBinaryData(theEnv)->DeffunctionCount * sizeof(struct deffunctionStruct); if (space != 0) genlongfree(theEnv,(void *) DeffunctionBinaryData(theEnv)->DeffunctionArray,space); space = DeffunctionBinaryData(theEnv)->ModuleCount * sizeof(struct deffunctionModule); if (space != 0) genlongfree(theEnv,(void *) DeffunctionBinaryData(theEnv)->ModuleArray,space); #endif } /*************************************************** NAME : BloadDeffunctionModuleReference DESCRIPTION : Returns a pointer to the appropriate deffunction module INPUTS : The index of the module RETURNS : A pointer to the module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *BloadDeffunctionModuleReference( void *theEnv, int theIndex) { return ((void *) &DeffunctionBinaryData(theEnv)->ModuleArray[theIndex]); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************************************** NAME : BsaveDeffunctionFind DESCRIPTION : For all deffunctions, this routine marks all the needed symbols. Also, it also counts the number of expression structures needed. Also, counts total number of deffunctions. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented for every expression needed Symbols are marked in their structures NOTES : Also sets bsaveIndex for each deffunction (assumes deffunctions will be bsaved in order of binary list) ***************************************************************************/ static void BsaveDeffunctionFind( void *theEnv) { SaveBloadCount(theEnv,DeffunctionBinaryData(theEnv)->ModuleCount); SaveBloadCount(theEnv,DeffunctionBinaryData(theEnv)->DeffunctionCount); DeffunctionBinaryData(theEnv)->DeffunctionCount = 0L; DeffunctionBinaryData(theEnv)->ModuleCount = DoForAllConstructs(theEnv,MarkDeffunctionItems,DeffunctionData(theEnv)->DeffunctionModuleIndex, FALSE,NULL); } /*************************************************** NAME : MarkDeffunctionItems DESCRIPTION : Marks the needed items for a deffunction bsave INPUTS : 1) The deffunction 2) User data buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Needed items marked NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void MarkDeffunctionItems( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(userBuffer) #endif MarkConstructHeaderNeededItems(theDeffunction,DeffunctionBinaryData(theEnv)->DeffunctionCount++); ExpressionData(theEnv)->ExpressionCount += ExpressionSize(((DEFFUNCTION *) theDeffunction)->code); MarkNeededItems(theEnv,((DEFFUNCTION *) theDeffunction)->code); } /*************************************************** NAME : BsaveDeffunctionExpressions DESCRIPTION : Writes out all expressions needed by deffunctyions INPUTS : The file pointer of the binary file RETURNS : Nothing useful SIDE EFFECTS : File updated NOTES : None ***************************************************/ static void BsaveDeffunctionExpressions( void *theEnv, FILE *fp) { DoForAllConstructs(theEnv,BsaveDeffunctionExpression,DeffunctionData(theEnv)->DeffunctionModuleIndex, FALSE,(void *) fp); } /*************************************************** NAME : BsaveDeffunctionExpression DESCRIPTION : Saves the needed expressions for a deffunction bsave INPUTS : 1) The deffunction 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Expressions saved NOTES : None ***************************************************/ static void BsaveDeffunctionExpression( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { BsaveExpression(theEnv,((DEFFUNCTION *) theDeffunction)->code,(FILE *) userBuffer); } /*********************************************************** NAME : BsaveStorageDeffunctions DESCRIPTION : Writes out number of each type of structure required for deffunctions Space required for counts (unsigned long) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None ***********************************************************/ static void BsaveStorageDeffunctions( void *theEnv, FILE *fp) { unsigned long space; space = sizeof(unsigned long) * 2; GenWrite((void *) &space,(unsigned long) sizeof(unsigned long),fp); GenWrite((void *) &DeffunctionBinaryData(theEnv)->ModuleCount,(unsigned long) sizeof(long),fp); GenWrite((void *) &DeffunctionBinaryData(theEnv)->DeffunctionCount,(unsigned long) sizeof(long),fp); } /************************************************************************************* NAME : BsaveDeffunctions DESCRIPTION : Writes out deffunction in binary format Space required (unsigned long) All deffunctions (sizeof(DEFFUNCTION) * Number of deffunctions) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None *************************************************************************************/ static void BsaveDeffunctions( void *theEnv, FILE *fp) { unsigned long space; struct defmodule *theModule; DEFFUNCTION_MODULE *theModuleItem; BSAVE_DEFFUNCTION_MODULE dummy_mitem; space = (unsigned long) ((sizeof(BSAVE_DEFFUNCTION_MODULE) * DeffunctionBinaryData(theEnv)->ModuleCount) + (sizeof(BSAVE_DEFFUNCTION) * DeffunctionBinaryData(theEnv)->DeffunctionCount)); GenWrite((void *) &space,(unsigned long) sizeof(unsigned long),fp); /* ================================= Write out each deffunction module ================================= */ DeffunctionBinaryData(theEnv)->DeffunctionCount = 0L; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { theModuleItem = (DEFFUNCTION_MODULE *) GetModuleItem(theEnv,theModule,FindModuleItem(theEnv,"deffunction")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&dummy_mitem.header,&theModuleItem->header); GenWrite((void *) &dummy_mitem,(unsigned long) sizeof(BSAVE_DEFFUNCTION_MODULE),fp); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } /* ========================== Write out each deffunction ========================== */ DoForAllConstructs(theEnv,BsaveDeffunction,DeffunctionData(theEnv)->DeffunctionModuleIndex, FALSE,(void *) fp); RestoreBloadCount(theEnv,&DeffunctionBinaryData(theEnv)->ModuleCount); RestoreBloadCount(theEnv,&DeffunctionBinaryData(theEnv)->DeffunctionCount); } /*************************************************** NAME : BsaveDeffunction DESCRIPTION : Bsaves a deffunction INPUTS : 1) The deffunction 2) Output data file pointer RETURNS : Nothing useful SIDE EFFECTS : Deffunction saved NOTES : None ***************************************************/ static void BsaveDeffunction( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { DEFFUNCTION *dptr = (DEFFUNCTION *) theDeffunction; BSAVE_DEFFUNCTION dummy_df; AssignBsaveConstructHeaderVals(&dummy_df.header,&dptr->header); dummy_df.minNumberOfParameters = dptr->minNumberOfParameters; dummy_df.maxNumberOfParameters = dptr->maxNumberOfParameters; dummy_df.numberOfLocalVars = dptr->numberOfLocalVars; if (dptr->code != NULL) { dummy_df.code = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(dptr->code); } else dummy_df.code = -1L; GenWrite((void *) &dummy_df,(unsigned long) sizeof(BSAVE_DEFFUNCTION),(FILE *) userBuffer); } #endif /*********************************************************************** NAME : BloadStorageDeffunctions DESCRIPTION : This routine space required for deffunction structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageDeffunctions( void *theEnv) { unsigned long space; GenReadBinary(theEnv,(void *) &space,(unsigned long) sizeof(unsigned long)); if (space == 0L) return; GenReadBinary(theEnv,(void *) &DeffunctionBinaryData(theEnv)->ModuleCount,(unsigned long) sizeof(unsigned long)); GenReadBinary(theEnv,(void *) &DeffunctionBinaryData(theEnv)->DeffunctionCount,(unsigned long) sizeof(unsigned long)); if (DeffunctionBinaryData(theEnv)->ModuleCount == 0L) { DeffunctionBinaryData(theEnv)->ModuleArray = NULL; DeffunctionBinaryData(theEnv)->DeffunctionArray = NULL; return; } space = (unsigned long) (DeffunctionBinaryData(theEnv)->ModuleCount * sizeof(DEFFUNCTION_MODULE)); DeffunctionBinaryData(theEnv)->ModuleArray = (DEFFUNCTION_MODULE *) genlongalloc(theEnv,space); if (DeffunctionBinaryData(theEnv)->DeffunctionCount == 0L) { DeffunctionBinaryData(theEnv)->DeffunctionArray = NULL; return; } space = (unsigned long) (DeffunctionBinaryData(theEnv)->DeffunctionCount * sizeof(DEFFUNCTION)); DeffunctionBinaryData(theEnv)->DeffunctionArray = (DEFFUNCTION *) genlongalloc(theEnv,space); } /********************************************************************* NAME : BloadDeffunctions DESCRIPTION : This routine reads deffunction information from a binary file This routine moves through the deffunction binary array updating pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pointers reset from array indices NOTES : Assumes all loading is finished ********************************************************************/ static void BloadDeffunctions( void *theEnv) { unsigned long space; GenReadBinary(theEnv,(void *) &space,(unsigned long) sizeof(unsigned long)); BloadandRefresh(theEnv,DeffunctionBinaryData(theEnv)->ModuleCount,sizeof(BSAVE_DEFFUNCTION_MODULE),UpdateDeffunctionModule); BloadandRefresh(theEnv,DeffunctionBinaryData(theEnv)->DeffunctionCount,sizeof(BSAVE_DEFFUNCTION),UpdateDeffunction); } /******************************************************* NAME : UpdateDeffunctionModule DESCRIPTION : Updates deffunction module with binary load data - sets pointers from offset information INPUTS : 1) A pointer to the bloaded data 2) The index of the binary array element to update RETURNS : Nothing useful SIDE EFFECTS : Deffunction moudle pointers updated NOTES : None *******************************************************/ static void UpdateDeffunctionModule( void *theEnv, void *buf, long obji) { BSAVE_DEFFUNCTION_MODULE *bdptr; bdptr = (BSAVE_DEFFUNCTION_MODULE *) buf; UpdateDefmoduleItemHeader(theEnv,&bdptr->header,&DeffunctionBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(DEFFUNCTION),(void *) DeffunctionBinaryData(theEnv)->DeffunctionArray); } /*************************************************** NAME : UpdateDeffunction DESCRIPTION : Updates deffunction with binary load data - sets pointers from offset information INPUTS : 1) A pointer to the bloaded data 2) The index of the binary array element to update RETURNS : Nothing useful SIDE EFFECTS : Deffunction pointers upadted NOTES : None ***************************************************/ static void UpdateDeffunction( void *theEnv, void *buf, long obji) { BSAVE_DEFFUNCTION *bdptr; DEFFUNCTION *dptr; bdptr = (BSAVE_DEFFUNCTION *) buf; dptr = (DEFFUNCTION *) &DeffunctionBinaryData(theEnv)->DeffunctionArray[obji]; UpdateConstructHeader(theEnv,&bdptr->header,&dptr->header, (int) sizeof(DEFFUNCTION_MODULE),(void *) DeffunctionBinaryData(theEnv)->ModuleArray, (int) sizeof(DEFFUNCTION),(void *) DeffunctionBinaryData(theEnv)->DeffunctionArray); dptr->code = ExpressionPointer(bdptr->code); dptr->busy = 0; dptr->executing = 0; #if DEBUGGING_FUNCTIONS dptr->trace = (unsigned short) DeffunctionData(theEnv)->WatchDeffunctions; #endif dptr->minNumberOfParameters = bdptr->minNumberOfParameters; dptr->maxNumberOfParameters = bdptr->maxNumberOfParameters; dptr->numberOfLocalVars = bdptr->numberOfLocalVars; } /*************************************************************** NAME : ClearDeffunctionBload DESCRIPTION : Release all binary-loaded deffunction structure arrays Resets deffunction list to NULL INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : Deffunction name symbol counts decremented ***************************************************************/ static void ClearDeffunctionBload( void *theEnv) { register long i; unsigned long space; space = (unsigned long) (sizeof(DEFFUNCTION_MODULE) * DeffunctionBinaryData(theEnv)->ModuleCount); if (space == 0L) return; genlongfree(theEnv,(void *) DeffunctionBinaryData(theEnv)->ModuleArray,space); DeffunctionBinaryData(theEnv)->ModuleArray = NULL; DeffunctionBinaryData(theEnv)->ModuleCount = 0L; for (i = 0L ; i < DeffunctionBinaryData(theEnv)->DeffunctionCount ; i++) UnmarkConstructHeader(theEnv,&DeffunctionBinaryData(theEnv)->DeffunctionArray[i].header); space = (unsigned long) (sizeof(DEFFUNCTION) * DeffunctionBinaryData(theEnv)->DeffunctionCount); if (space == 0L) return; genlongfree(theEnv,(void *) DeffunctionBinaryData(theEnv)->DeffunctionArray,space); DeffunctionBinaryData(theEnv)->DeffunctionArray = NULL; DeffunctionBinaryData(theEnv)->DeffunctionCount = 0L; } #endif clips-6.24/clipssrc/._genrccmp.h0000400000175000017500000000012207422634612014702 0ustar jfsjfsMac OS X  2 RTEXT????aclips-6.24/clipssrc/globlpsr.c0000755000175000017500000004044310441602223014521 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFGLOBAL PARSER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Parses the defglobal construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Made the construct redefinition message more */ /* prominent. */ /* */ /*************************************************************/ #define _GLOBLPSR_SOURCE_ #include "setup.h" #if DEFGLOBAL_CONSTRUCT #include #include "pprint.h" #include "router.h" #include "memalloc.h" #include "scanner.h" #include "evaluatn.h" #include "exprnpsr.h" #include "constrct.h" #include "multifld.h" #include "watch.h" #include "modulutl.h" #include "modulpsr.h" #include "cstrcpsr.h" #include "globldef.h" #include "globlbsc.h" #include "envrnmnt.h" #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE #include "bload.h" #endif #include "globlpsr.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if (! RUN_TIME) && (! BLOAD_ONLY) static intBool GetVariableDefinition(void *,char *,int *,int,struct token *); static void AddDefglobal(void *,SYMBOL_HN *,DATA_OBJECT_PTR,struct expr *); #endif /*********************************************************************/ /* ParseDefglobal: Coordinates all actions necessary for the parsing */ /* and creation of a defglobal into the current environment. */ /*********************************************************************/ globle intBool ParseDefglobal( void *theEnv, char *readSource) { int defglobalError = FALSE; #if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,readSource) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) struct token theToken; int tokenRead = TRUE; struct defmodule *theModule; /*=====================================*/ /* Pretty print buffer initialization. */ /*=====================================*/ SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defglobal "); /*=================================================*/ /* Individual defglobal constructs can't be parsed */ /* while a binary load is in effect. */ /*=================================================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defglobal"); return(TRUE); } #endif /*===========================*/ /* Look for the module name. */ /*===========================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type == SYMBOL) { /*=================================================*/ /* The optional module name can't contain a module */ /* separator like other constructs. For example, */ /* (defrule X::foo is OK for rules, but the right */ /* syntax for defglobals is (defglobal X ?*foo*. */ /*=================================================*/ tokenRead = FALSE; if (FindModuleSeparator(ValueToString(theToken.value))) { SyntaxErrorMessage(theEnv,"defglobal"); return(TRUE); } /*=================================*/ /* Determine if the module exists. */ /*=================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value)); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken.value)); return(TRUE); } /*=========================================*/ /* If the module name was OK, then set the */ /* current module to the specified module. */ /*=========================================*/ SavePPBuffer(theEnv," "); EnvSetCurrentModule(theEnv,(void *) theModule); } /*===========================================*/ /* If the module name wasn't specified, then */ /* use the current module's name in the */ /* defglobal's pretty print representation. */ /*===========================================*/ else { PPBackup(theEnv); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)))); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); } /*======================*/ /* Parse the variables. */ /*======================*/ while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken)) { tokenRead = FALSE; FlushPPBuffer(theEnv); SavePPBuffer(theEnv,"(defglobal "); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)))); SavePPBuffer(theEnv," "); } #endif /*==================================*/ /* Return the parsing error status. */ /*==================================*/ return(defglobalError); } #if (! RUN_TIME) && (! BLOAD_ONLY) /***************************************************************/ /* GetVariableDefinition: Parses and evaluates a single global */ /* variable in a defglobal construct. Returns TRUE if the */ /* variable was successfully parsed and FALSE if a right */ /* parenthesis is encountered (signifying the end of the */ /* defglobal construct) or an error occurs. The error status */ /* flag is also set if an error occurs. */ /***************************************************************/ static intBool GetVariableDefinition( void *theEnv, char *readSource, int *defglobalError, int tokenRead, struct token *theToken) { SYMBOL_HN *variableName; struct expr *assignPtr; DATA_OBJECT assignValue; /*========================================*/ /* Get next token, which should either be */ /* a closing parenthesis or a variable. */ /*========================================*/ if (! tokenRead) GetToken(theEnv,readSource,theToken); if (theToken->type == RPAREN) return(FALSE); if (theToken->type == SF_VARIABLE) { SyntaxErrorMessage(theEnv,"defglobal"); *defglobalError = TRUE; return(FALSE); } else if (theToken->type != GBL_VARIABLE) { SyntaxErrorMessage(theEnv,"defglobal"); *defglobalError = TRUE; return(FALSE); } variableName = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv," "); /*================================*/ /* Print out compilation message. */ /*================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == ON) && GetPrintWhileLoading(theEnv)) { if (QFindDefglobal(theEnv,variableName) != NULL) { PrintWarningID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WDIALOG,"Redefining defglobal: "); } else EnvPrintRouter(theEnv,WDIALOG,"Defining defglobal: "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(variableName)); EnvPrintRouter(theEnv,WDIALOG,"\n"); } else #endif { if (GetPrintWhileLoading(theEnv)) EnvPrintRouter(theEnv,WDIALOG,":"); } /*==================================================================*/ /* Check for import/export conflicts from the construct definition. */ /*==================================================================*/ #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,"defglobal",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(variableName))) { ImportExportConflictMessage(theEnv,"defglobal",ValueToString(variableName),NULL,NULL); *defglobalError = TRUE; return(FALSE); } #endif /*==============================*/ /* The next token must be an =. */ /*==============================*/ GetToken(theEnv,readSource,theToken); if (strcmp(theToken->printForm,"=") != 0) { SyntaxErrorMessage(theEnv,"defglobal"); *defglobalError = TRUE; return(FALSE); } SavePPBuffer(theEnv," "); /*======================================================*/ /* Parse the expression to be assigned to the variable. */ /*======================================================*/ assignPtr = ParseAtomOrExpression(theEnv,readSource,NULL); if (assignPtr == NULL) { *defglobalError = TRUE; return(FALSE); } /*==========================*/ /* Evaluate the expression. */ /*==========================*/ if (! ConstructData(theEnv)->CheckSyntaxMode) { SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,assignPtr,&assignValue)) { ReturnExpression(theEnv,assignPtr); *defglobalError = TRUE; return(FALSE); } } else { ReturnExpression(theEnv,assignPtr); } SavePPBuffer(theEnv,")"); /*======================================*/ /* Add the variable to the global list. */ /*======================================*/ if (! ConstructData(theEnv)->CheckSyntaxMode) { AddDefglobal(theEnv,variableName,&assignValue,assignPtr); } /*==================================================*/ /* Return TRUE to indicate that the global variable */ /* definition was successfully parsed. */ /*==================================================*/ return(TRUE); } /*********************************************************/ /* AddDefglobal: Adds a defglobal to the current module. */ /*********************************************************/ 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); } /*****************************************************************/ /* ReplaceGlobalVariable: Replaces a global variable found in an */ /* expression with the appropriate primitive data type which */ /* can later be used to retrieve the global variable's value. */ /*****************************************************************/ globle intBool ReplaceGlobalVariable( void *theEnv, struct expr *ePtr) { struct defglobal *theGlobal; int count; /*=================================*/ /* Search for the global variable. */ /*=================================*/ theGlobal = (struct defglobal *) FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(ePtr->value), &count,TRUE,NULL); /*=============================================*/ /* If it wasn't found, print an error message. */ /*=============================================*/ if (theGlobal == NULL) { GlobalReferenceErrorMessage(theEnv,ValueToString(ePtr->value)); return(FALSE); } /*========================================================*/ /* The current implementation of the defmodules shouldn't */ /* allow a construct to be defined which would cause an */ /* ambiguous reference, but we'll check for it anyway. */ /*========================================================*/ if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"defglobal",ValueToString(ePtr->value)); return(FALSE); } /*==============================================*/ /* Replace the symbolic reference of the global */ /* variable with a direct pointer reference. */ /*==============================================*/ ePtr->type = DEFGLOBAL_PTR; ePtr->value = (void *) theGlobal; return(TRUE); } /*****************************************************************/ /* GlobalReferenceErrorMessage: Prints an error message when a */ /* symbolic reference to a global variable cannot be resolved. */ /*****************************************************************/ globle void GlobalReferenceErrorMessage( void *theEnv, char *variableName) { PrintErrorID(theEnv,"GLOBLPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"\nGlobal variable ?*"); EnvPrintRouter(theEnv,WERROR,variableName); EnvPrintRouter(theEnv,WERROR,"* was referenced, but is not defined.\n"); } #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ #endif /* DEFGLOBAL_CONSTRUCT */ clips-6.24/clipssrc/bload.h0000755000175000017500000000642610441127731013774 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* BLOAD HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_bload #define _H_bload #ifndef _H_utility #include "utility.h" #endif #ifndef _H_extnfunc #include "extnfunc.h" #endif #ifndef _H_exprnbin #include "exprnbin.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_sysdep #include "sysdep.h" #endif #ifndef _H_symblbin #include "symblbin.h" #endif #define BLOAD_DATA 38 struct bloadData { char *BinaryPrefixID; char *BinaryVersionID; struct FunctionDefinition **FunctionArray; int BloadActive; struct callFunctionItem *BeforeBloadFunctions; struct callFunctionItem *AfterBloadFunctions; struct callFunctionItem *ClearBloadReadyFunctions; struct callFunctionItem *AbortBloadFunctions; }; #define BloadData(theEnv) ((struct bloadData *) GetEnvironmentData(theEnv,BLOAD_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _BLOAD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #define FunctionPointer(i) ((struct FunctionDefinition *) (((i) == -1L) ? NULL : BloadData(theEnv)->FunctionArray[i])) #if ENVIRONMENT_API_ONLY #define Bload(theEnv,a) EnvBload(theEnv,a) #else #define Bload(a) EnvBload(GetCurrentEnvironment(),a) #endif LOCALE void InitializeBloadData(void *); LOCALE int BloadCommand(void *); LOCALE intBool EnvBload(void *,char *); LOCALE void BloadandRefresh(void *,long,unsigned,void (*)(void *,void *,long)); LOCALE intBool Bloaded(void *); LOCALE void AddBeforeBloadFunction(void *,char *,void (*)(void *),int); LOCALE void AddAfterBloadFunction(void *,char *,void (*)(void *),int); LOCALE void AddBloadReadyFunction(void *,char *,int (*)(void),int); LOCALE void AddClearBloadReadyFunction(void *,char *,int (*)(void *),int); LOCALE void AddAbortBloadFunction(void *,char *,void (*)(void *),int); LOCALE void CannotLoadWithBloadMessage(void *,char *); #endif clips-6.24/clipssrc/._rulecstr.h0000400000175000017500000000075410441151053014746 0ustar jfsjfsMac OS X  2 RTEXT????aTTFH Monaco0z0z<[=TTFS FMWBBMPSRclips-6.24/clipssrc/._facthsh.c0000400000175000017500000000075410441143344014522 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z199TTFS FMWBBMPSRclips-6.24/clipssrc/watch.h0000755000175000017500000000720510443631632014017 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* WATCH HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Support functions for the watch and unwatch */ /* commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EnvSetWatchItem function. */ /* */ /*************************************************************/ #ifndef _H_watch #define _H_watch #ifndef _H_expressn #include "expressn.h" #endif #define WATCH_DATA 54 struct watchItem { char *name; unsigned *flag; int code,priority; unsigned (*accessFunc)(void *,int,unsigned,struct expr *); unsigned (*printFunc)(void *,char *,int,struct expr *); struct watchItem *next; }; struct watchData { struct watchItem *ListOfWatchItems; }; #define WatchData(theEnv) ((struct watchData *) GetEnvironmentData(theEnv,WATCH_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _WATCH_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetWatchItem(theEnv,a) EnvGetWatchItem(theEnv,a) #define SetWatchItem(theEnv,a,b) EnvSetWatchItem(theEnv,a,b) #define Watch(theEnv,a) EnvWatch(theEnv,a) #define Unwatch(theEnv,a) EnvUnwatch(theEnv,a) #else #define GetWatchItem(a) EnvGetWatchItem(GetCurrentEnvironment(),a) #define SetWatchItem(a,b) EnvSetWatchItem(GetCurrentEnvironment(),a,b) #define Watch(a) EnvWatch(GetCurrentEnvironment(),a) #define Unwatch(a) EnvUnwatch(GetCurrentEnvironment(),a) #endif LOCALE void InitializeWatchData(void *); LOCALE int EnvSetWatchItem(void *,char *,unsigned,struct expr *); LOCALE int EnvGetWatchItem(void *,char *); LOCALE intBool AddWatchItem(void *,char *,int,unsigned *,int, unsigned (*)(void *,int,unsigned,struct expr *), unsigned (*)(void *,char *,int,struct expr *)); LOCALE char *GetNthWatchName(void *,int); LOCALE int GetNthWatchValue(void *,int); LOCALE void WatchCommand(void *); LOCALE void UnwatchCommand(void *); LOCALE void ListWatchItemsCommand(void *); LOCALE void WatchFunctionDefinitions(void *); LOCALE intBool EnvWatch(void *,char *); LOCALE intBool EnvUnwatch(void *,char *); LOCALE int GetWatchItemCommand(void *); #endif clips-6.24/clipssrc/msgfun.h0000755000175000017500000000727010441150101014173 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Message-passing support functions */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_msgfun #define _H_msgfun typedef struct handlerSlotReference { unsigned short classID; unsigned slotID; } HANDLER_SLOT_REFERENCE; #ifndef _H_object #include "object.h" #endif #include "msgpass.h" #define BEGIN_TRACE ">>" #define END_TRACE "<<" /* ================================================================================= Message-handler types - don't change these values: a string array depends on them ================================================================================= */ #define MAROUND 0 #define MBEFORE 1 #define MPRIMARY 2 #define MAFTER 3 #define MERROR 4 #define LOOKUP_HANDLER_INDEX 0 #define LOOKUP_HANDLER_ADDRESS 1 #ifdef LOCALE #undef LOCALE #endif #ifdef _MSGFUN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void UnboundHandlerErr(void *); LOCALE void PrintNoHandlerError(void *,char *); LOCALE int CheckHandlerArgCount(void *); LOCALE void SlotAccessViolationError(void *,char *,intBool,void *); LOCALE void SlotVisibilityViolationError(void *,SLOT_DESC *,DEFCLASS *); #if ! RUN_TIME LOCALE void NewSystemHandler(void *,char *,char *,char *,int); LOCALE HANDLER *InsertHandlerHeader(void *,DEFCLASS *,SYMBOL_HN *,int); #endif #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE HANDLER *NewHandler(void); LOCALE int HandlersExecuting(DEFCLASS *); LOCALE int DeleteHandler(void *,DEFCLASS *,SYMBOL_HN *,int,int); LOCALE void DeallocateMarkedHandlers(void *,DEFCLASS *); #endif LOCALE unsigned HandlerType(void *,char *,char *); LOCALE int CheckCurrentMessage(void *,char *,int); LOCALE void PrintHandler(void *,char *,HANDLER *,int); LOCALE HANDLER *FindHandlerByAddress(DEFCLASS *,SYMBOL_HN *,unsigned); LOCALE int FindHandlerByIndex(DEFCLASS *,SYMBOL_HN *,unsigned); LOCALE int FindHandlerNameGroup(DEFCLASS *,SYMBOL_HN *); LOCALE void HandlerDeleteError(void *,char *); #if DEBUGGING_FUNCTIONS LOCALE void DisplayCore(void *,char *,HANDLER_LINK *,int); LOCALE HANDLER_LINK *FindPreviewApplicableHandlers(void *,DEFCLASS *,SYMBOL_HN *); LOCALE void WatchMessage(void *,char *,char *); LOCALE void WatchHandler(void *,char *,HANDLER_LINK *,char *); #endif #endif clips-6.24/clipssrc/cstrccmp.h0000755000175000017500000000320607422634570014533 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* CONSTRUCT CONSTRUCTS-TO-C HEADER */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* Support functions for the constructs-to-c of */ /* construct headers and related items. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrccmp #define _H_cstrccmp #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRCCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif #if ANSI_COMPILER LOCALE void MarkConstructHeaders(int); #else LOCALE void MarkConstructHeaders(); #endif #endif clips-6.24/clipssrc/._textpro.c0000400000175000017500000000075410443575746014630 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH MonacoO<dO<dfݏݐTTF FMWBBMPSRclips-6.24/clipssrc/._exprnbin.c0000400000175000017500000000075410176264521014735 0ustar jfsjfsMac OS X  2 RTEXT????TTFH MonacoTaTaqllTTFUBDAFMPSRMWBBLclips-6.24/clipssrc/._factprt.c0000400000175000017500000000075410177533440014553 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z$@774kTTFT#9FMWBBMPSRclips-6.24/clipssrc/exprnbin.c0000755000175000017500000004076110176264521014537 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.23 01/31/05 */ /* */ /* EXPRESSION BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* expression data structure. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _EXPRNBIN_SOURCE_ #include "setup.h" #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "dffctdef.h" #include "moduldef.h" #include "constrct.h" #include "extnfunc.h" #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #if DEFRULE_CONSTRUCT #include "network.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrcbin.h" #endif #if DEFFUNCTION_CONSTRUCT #include "dffnxbin.h" #endif #if DEFTEMPLATE_CONSTRUCT #include "tmpltbin.h" #endif #if DEFGLOBAL_CONSTRUCT #include "globlbin.h" #endif #if OBJECT_SYSTEM #include "objbin.h" #include "insfun.h" #include "inscom.h" #endif #include "exprnbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void UpdateExpression(void *,void *,long); /***********************************************************/ /* AllocateExpressions: Determines the amount of space */ /* required for loading the binary image of expressions */ /* and allocates that amount of space. */ /***********************************************************/ globle void AllocateExpressions( void *theEnv) { unsigned long space; GenReadBinary(theEnv,(void *) &ExpressionData(theEnv)->NumberOfExpressions,(unsigned long) sizeof(long)); if (ExpressionData(theEnv)->NumberOfExpressions == 0L) ExpressionData(theEnv)->ExpressionArray = NULL; else { space = ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr); ExpressionData(theEnv)->ExpressionArray = (struct expr *) genlongalloc(theEnv,space); } } /**********************************************/ /* RefreshExpressions: Refreshes the pointers */ /* used by the expression binary image. */ /**********************************************/ globle void RefreshExpressions( void *theEnv) { if (ExpressionData(theEnv)->ExpressionArray == NULL) return; BloadandRefresh(theEnv,ExpressionData(theEnv)->NumberOfExpressions, (unsigned) sizeof(BSAVE_EXPRESSION),UpdateExpression); } /********************************************************* NAME : UpdateExpression DESCRIPTION : Given a bloaded expression buffer, this routine refreshes the pointers in the expression array INPUTS : 1) a bloaded expression buffer 2) the index of the expression to refresh RETURNS : Nothing useful SIDE EFFECTS : Expression updated NOTES : None *********************************************************/ static void UpdateExpression( void *theEnv, void *buf, long obji) { BSAVE_EXPRESSION *bexp; long theIndex; bexp = (BSAVE_EXPRESSION *) buf; ExpressionData(theEnv)->ExpressionArray[obji].type = bexp->type; switch(bexp->type) { case FCALL: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) BloadData(theEnv)->FunctionArray[bexp->value]; break; case GCALL: #if DEFGENERIC_CONSTRUCT ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) GenericPointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case PCALL: #if DEFFUNCTION_CONSTRUCT ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) DeffunctionPointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case DEFTEMPLATE_PTR: #if DEFTEMPLATE_CONSTRUCT ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) DeftemplatePointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case DEFCLASS_PTR: #if OBJECT_SYSTEM ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) DefclassPointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case DEFGLOBAL_PTR: #if DEFGLOBAL_CONSTRUCT ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) DefglobalPointer(bexp->value); #else ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; #endif break; case INTEGER: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) SymbolData(theEnv)->IntegerArray[bexp->value]; IncrementIntegerCount((INTEGER_HN *) ExpressionData(theEnv)->ExpressionArray[obji].value); break; case FLOAT: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) SymbolData(theEnv)->FloatArray[bexp->value]; IncrementFloatCount((FLOAT_HN *) ExpressionData(theEnv)->ExpressionArray[obji].value); break; case INSTANCE_NAME: #if ! OBJECT_SYSTEM ExpressionData(theEnv)->ExpressionArray[obji].type = SYMBOL; #endif case GBL_VARIABLE: case SYMBOL: case STRING: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) SymbolData(theEnv)->SymbolArray[bexp->value]; IncrementSymbolCount((SYMBOL_HN *) ExpressionData(theEnv)->ExpressionArray[obji].value); break; #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) &FactData(theEnv)->DummyFact; EnvIncrementFactCount(theEnv,ExpressionData(theEnv)->ExpressionArray[obji].value); break; #endif #if OBJECT_SYSTEM case INSTANCE_ADDRESS: ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) &InstanceData(theEnv)->DummyInstance; EnvIncrementInstanceCount(theEnv,ExpressionData(theEnv)->ExpressionArray[obji].value); break; #endif case EXTERNAL_ADDRESS: ExpressionData(theEnv)->ExpressionArray[obji].value = NULL; break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[bexp->type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[bexp->type]->bitMap) { ExpressionData(theEnv)->ExpressionArray[obji].value = (void *) SymbolData(theEnv)->BitMapArray[bexp->value]; IncrementBitMapCount((BITMAP_HN *) ExpressionData(theEnv)->ExpressionArray[obji].value); } break; } theIndex = (long int) bexp->nextArg; if (theIndex == -1L) { ExpressionData(theEnv)->ExpressionArray[obji].nextArg = NULL; } else { ExpressionData(theEnv)->ExpressionArray[obji].nextArg = (struct expr *) &ExpressionData(theEnv)->ExpressionArray[theIndex]; } theIndex = (long int) bexp->argList; if (theIndex == -1L) { ExpressionData(theEnv)->ExpressionArray[obji].argList = NULL; } else { ExpressionData(theEnv)->ExpressionArray[obji].argList = (struct expr *) &ExpressionData(theEnv)->ExpressionArray[theIndex]; } } /*********************************************/ /* ClearBloadedExpressions: Clears the space */ /* utilized by an expression binary image. */ /*********************************************/ globle void ClearBloadedExpressions( void *theEnv) { unsigned long int i, space; /*===============================================*/ /* Update the busy counts of atomic data values. */ /*===============================================*/ for (i = 0; i < (unsigned long) ExpressionData(theEnv)->NumberOfExpressions; i++) { switch (ExpressionData(theEnv)->ExpressionArray[i].type) { case SYMBOL : case STRING : case INSTANCE_NAME : case GBL_VARIABLE : DecrementSymbolCount(theEnv,(SYMBOL_HN *) ExpressionData(theEnv)->ExpressionArray[i].value); break; case FLOAT : DecrementFloatCount(theEnv,(FLOAT_HN *) ExpressionData(theEnv)->ExpressionArray[i].value); break; case INTEGER : DecrementIntegerCount(theEnv,(INTEGER_HN *) ExpressionData(theEnv)->ExpressionArray[i].value); break; #if DEFTEMPLATE_CONSTRUCT case FACT_ADDRESS : EnvDecrementFactCount(theEnv,ExpressionData(theEnv)->ExpressionArray[i].value); break; #endif #if OBJECT_SYSTEM case INSTANCE_ADDRESS : EnvDecrementInstanceCount(theEnv,ExpressionData(theEnv)->ExpressionArray[i].value); break; #endif case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[ExpressionData(theEnv)->ExpressionArray[i].type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[ExpressionData(theEnv)->ExpressionArray[i].type]->bitMap) { DecrementBitMapCount(theEnv,(BITMAP_HN *) ExpressionData(theEnv)->ExpressionArray[i].value); } break; } } /*===================================*/ /* Free the binary expression array. */ /*===================================*/ space = ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr); if (space != 0) genlongfree(theEnv,(void *) ExpressionData(theEnv)->ExpressionArray,space); ExpressionData(theEnv)->ExpressionArray = 0; } #if BLOAD_AND_BSAVE /*************************************************** NAME : FindHashedExpressions DESCRIPTION : Sets the bsave expression array indices for hashed expression nodes and marks the items needed by these expressions INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Atoms marked and ids set NOTES : None ***************************************************/ globle void FindHashedExpressions( void *theEnv) { register unsigned i; EXPRESSION_HN *exphash; for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++) for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i] ; exphash != NULL ; exphash = exphash->next) { MarkNeededItems(theEnv,exphash->exp); exphash->bsaveID = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(exphash->exp); } } /*************************************************** NAME : BsaveHashedExpressions DESCRIPTION : Writes out hashed expressions INPUTS : Bsave file stream pointer RETURNS : Nothing useful SIDE EFFECTS : Expressions written NOTES : None ***************************************************/ globle void BsaveHashedExpressions( void *theEnv, FILE *fp) { register unsigned i; EXPRESSION_HN *exphash; for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++) for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i] ; exphash != NULL ; exphash = exphash->next) BsaveExpression(theEnv,exphash->exp,fp); } /***************************************************************/ /* BsaveConstructExpressions: Writes all expression needed by */ /* constructs for this binary image to the binary save file. */ /***************************************************************/ globle void BsaveConstructExpressions( void *theEnv, FILE *fp) { struct BinaryItem *biPtr; for (biPtr = BsaveData(theEnv)->ListOfBinaryItems; biPtr != NULL; biPtr = biPtr->next) { if (biPtr->expressionFunction != NULL) { (*biPtr->expressionFunction)(theEnv,fp); } } } /***************************************/ /* BsaveExpression: Recursively saves */ /* an expression to the binary file. */ /***************************************/ globle void BsaveExpression( void *theEnv, struct expr *testPtr, FILE *fp) { BSAVE_EXPRESSION newTest; long int newIndex; while (testPtr != NULL) { ExpressionData(theEnv)->ExpressionCount++; /*================*/ /* Copy the type. */ /*================*/ newTest.type = testPtr->type; /*=======================================*/ /* Convert the argList slot to an index. */ /*=======================================*/ if (testPtr->argList == NULL) { newTest.argList = -1L; } else { newTest.argList = ExpressionData(theEnv)->ExpressionCount; } /*========================================*/ /* Convert the nextArg slot to an index. */ /*========================================*/ if (testPtr->nextArg == NULL) { newTest.nextArg = -1L; } else { newIndex = ExpressionData(theEnv)->ExpressionCount + ExpressionSize(testPtr->argList); newTest.nextArg = newIndex; } /*=========================*/ /* Convert the value slot. */ /*=========================*/ switch(testPtr->type) { case FLOAT: newTest.value = (long) ((FLOAT_HN *) testPtr->value)->bucket; break; case INTEGER: newTest.value = (long) ((INTEGER_HN *) testPtr->value)->bucket; break; case FCALL: newTest.value = (long) ((struct FunctionDefinition *) testPtr->value)->bsaveIndex; break; case GCALL: #if DEFGENERIC_CONSTRUCT if (testPtr->value != NULL) newTest.value = ((struct constructHeader *) testPtr->value)->bsaveID; else #endif newTest.value = -1L; break; case PCALL: #if DEFFUNCTION_CONSTRUCT if (testPtr->value != NULL) newTest.value = ((struct constructHeader *) testPtr->value)->bsaveID; else #endif newTest.value = -1L; break; case DEFTEMPLATE_PTR: #if DEFTEMPLATE_CONSTRUCT if (testPtr->value != NULL) newTest.value = ((struct constructHeader *) testPtr->value)->bsaveID; else #endif newTest.value = -1L; break; case DEFCLASS_PTR: #if OBJECT_SYSTEM if (testPtr->value != NULL) newTest.value = ((struct constructHeader *) testPtr->value)->bsaveID; else #endif newTest.value = -1L; break; case DEFGLOBAL_PTR: #if DEFGLOBAL_CONSTRUCT if (testPtr->value != NULL) newTest.value = ((struct defglobal *) testPtr->value)->header.bsaveID; else #endif newTest.value = -1L; break; #if OBJECT_SYSTEM case INSTANCE_NAME: #endif case SYMBOL: case GBL_VARIABLE: case STRING: newTest.value = (long) ((SYMBOL_HN *) testPtr->value)->bucket; break; case FACT_ADDRESS: case INSTANCE_ADDRESS: case EXTERNAL_ADDRESS: newTest.value = -1L; break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[testPtr->type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[testPtr->type]->bitMap) { newTest.value = (long) ((BITMAP_HN *) testPtr->value)->bucket; } break; } /*===========================*/ /* Write out the expression. */ /*===========================*/ GenWrite(&newTest,(unsigned long) sizeof(BSAVE_EXPRESSION),fp); /*==========================*/ /* Write out argument list. */ /*==========================*/ if (testPtr->argList != NULL) { BsaveExpression(theEnv,testPtr->argList,fp); } testPtr = testPtr->nextArg; } } #endif /* BLOAD_AND_BSAVE */ #endif /* (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) */ clips-6.24/clipssrc/factfun.c0000755000175000017500000005135010443377305014336 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* FACT FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* */ /* (fact-existp ) */ /* Returns TRUE if the fact exists, otherwise FALSE is */ /* returned. */ /* */ /* (fact-relation ) */ /* Returns the deftemplate name of the fact. Returns */ /* False if the specified fact doesn't exist. */ /* */ /* (fact-slot-value ) */ /* Returns the contents of a slot (use the slot name */ /* implied for the implied multifield slot of an ordered */ /* fact). Returns the value FALSE if the slot name is */ /* invalid or the fact doesn't exist. */ /* */ /* (fact-slot-names ) */ /* Returns the slot names associated with a fact in a */ /* multifield value. Returns FALSE if the fact doesn't */ /* exist. */ /* */ /* (get-fact-list []) */ /* Returns the list of facts visible to the specified */ /* module or to the current module if none is specified. */ /* If * is specified then all facts are returned. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Added ppfact function. */ /* */ /*************************************************************/ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFTEMPLATE_CONSTRUCT #define _FACTFUN_SOURCE_ #include "extnfunc.h" #include "envrnmnt.h" #include "argacces.h" #include "prntutil.h" #include "tmpltutl.h" #include "router.h" #include "factfun.h" /****************************************************/ /* FactFunctionDefinitions: Defines fact functions. */ /****************************************************/ globle void FactFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"fact-existp", 'b', PTIEF FactExistpFunction, "FactExistpFunction", "11z"); EnvDefineFunction2(theEnv,"fact-relation",'w', PTIEF FactRelationFunction,"FactRelationFunction", "11z"); EnvDefineFunction2(theEnv,"fact-slot-value",'u', PTIEF FactSlotValueFunction,"FactSlotValueFunction", "22*zw"); EnvDefineFunction2(theEnv,"fact-slot-names",'u', PTIEF FactSlotNamesFunction,"FactSlotNamesFunction", "11z"); EnvDefineFunction2(theEnv,"get-fact-list",'m',PTIEF GetFactListFunction,"GetFactListFunction","01w"); EnvDefineFunction2(theEnv,"ppfact",'v',PTIEF PPFactFunction,"PPFactFunction","13*z"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /**********************************************/ /* FactRelationFunction: H/L access routine */ /* for the fact-relation function. */ /**********************************************/ globle void *FactRelationFunction( void *theEnv) { struct fact *theFact; if (EnvArgCountCheck(theEnv,"fact-relation",EXACTLY,1) == -1) return(EnvFalseSymbol(theEnv)); theFact = GetFactAddressOrIndexArgument(theEnv,"fact-relation",1,FALSE); if (theFact == NULL) return(EnvFalseSymbol(theEnv)); return(FactRelation(theFact)); } /**************************************/ /* FactRelation: C access routine for */ /* the fact-relation function. */ /**************************************/ globle void *FactRelation( void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; return((void *) theFact->whichDeftemplate->header.name); } /****************************************/ /* EnvFactDeftemplate: C access routine */ /* to retrieve a fact's deftemplate. */ /****************************************/ #if IBM_TBC #pragma argsused #endif globle void *EnvFactDeftemplate( void *theEnv, void *vTheFact) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif struct fact *theFact = (struct fact *) vTheFact; return((void *) theFact->whichDeftemplate); } /********************************************/ /* FactExistpFunction: H/L access routine */ /* for the fact-existp function. */ /********************************************/ globle int FactExistpFunction( void *theEnv) { struct fact *theFact; if (EnvArgCountCheck(theEnv,"fact-existp",EXACTLY,1) == -1) return(-1L); theFact = GetFactAddressOrIndexArgument(theEnv,"fact-existp",1,FALSE); return(EnvFactExistp(theEnv,theFact)); } /***********************************/ /* EnvFactExistp: C access routine */ /* for the fact-existp function. */ /***********************************/ #if IBM_TBC #pragma argsused #endif globle int EnvFactExistp( void *theEnv, void *vTheFact) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif struct fact *theFact = (struct fact *) vTheFact; if (theFact == NULL) return(FALSE); if (theFact->garbage) return(FALSE); return(TRUE); } /***********************************************/ /* FactSlotValueFunction: H/L access routine */ /* for the fact-slot-value function. */ /***********************************************/ globle void FactSlotValueFunction( void *theEnv, DATA_OBJECT *returnValue) { struct fact *theFact; DATA_OBJECT theValue; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"fact-slot-value",EXACTLY,2) == -1) return; /*================================*/ /* Get the reference to the fact. */ /*================================*/ theFact = GetFactAddressOrIndexArgument(theEnv,"fact-slot-value",1,TRUE); if (theFact == NULL) return; /*===========================*/ /* Get the name of the slot. */ /*===========================*/ if (EnvArgTypeCheck(theEnv,"fact-slot-value",2,SYMBOL,&theValue) == FALSE) { return; } /*=======================*/ /* Get the slot's value. */ /*=======================*/ FactSlotValue(theEnv,theFact,DOToString(theValue),returnValue); } /***************************************/ /* FactSlotValue: C access routine for */ /* the fact-slot-value function. */ /***************************************/ globle void FactSlotValue( void *theEnv, void *vTheFact, char *theSlotName, DATA_OBJECT *returnValue) { struct fact *theFact = (struct fact *) vTheFact; short position; /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theFact->whichDeftemplate->implied) { if (strcmp(theSlotName,"implied") != 0) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,theSlotName, ValueToString(theFact->whichDeftemplate->header.name),FALSE); return; } } else if (FindSlot(theFact->whichDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,theSlotName),&position) == NULL) { SetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,theSlotName, ValueToString(theFact->whichDeftemplate->header.name),FALSE); return; } /*==========================*/ /* Return the slot's value. */ /*==========================*/ if (theFact->whichDeftemplate->implied) { EnvGetFactSlot(theEnv,theFact,NULL,returnValue); } else { EnvGetFactSlot(theEnv,theFact,theSlotName,returnValue); } } /***********************************************/ /* FactSlotNamesFunction: H/L access routine */ /* for the fact-slot-names function. */ /***********************************************/ globle void FactSlotNamesFunction( void *theEnv, DATA_OBJECT *returnValue) { struct fact *theFact; /*=============================================*/ /* Set up the default return value for errors. */ /*=============================================*/ returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"fact-slot-names",EXACTLY,1) == -1) return; /*================================*/ /* Get the reference to the fact. */ /*================================*/ theFact = GetFactAddressOrIndexArgument(theEnv,"fact-slot-names",1,TRUE); if (theFact == NULL) return; /*=====================*/ /* Get the slot names. */ /*=====================*/ EnvFactSlotNames(theEnv,theFact,returnValue); } /***************************************/ /* EnvFactSlotNames: C access routine */ /* for the fact-slot-names function. */ /***************************************/ globle void EnvFactSlotNames( void *theEnv, void *vTheFact, DATA_OBJECT *returnValue) { struct fact *theFact = (struct fact *) vTheFact; struct multifield *theList; struct templateSlot *theSlot; unsigned long count; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theFact->whichDeftemplate->implied) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,1); theList = (struct multifield *) EnvCreateMultifield(theEnv,(int) 1); SetMFType(theList,1,SYMBOL); SetMFValue(theList,1,EnvAddSymbol(theEnv,"implied")); SetpValue(returnValue,(void *) theList); return; } /*=================================*/ /* Count the number of slot names. */ /*=================================*/ for (count = 0, theSlot = theFact->whichDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { /* Do Nothing */ } /*=============================================================*/ /* Create a multifield value in which to store the slot names. */ /*=============================================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*===============================================*/ /* Store the slot names in the multifield value. */ /*===============================================*/ for (count = 1, theSlot = theFact->whichDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,theSlot->slotName); } } /*********************************************/ /* GetFactListFunction: H/L access routine */ /* for the get-fact-list function. */ /*********************************************/ globle void GetFactListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct defmodule *theModule; DATA_OBJECT result; int numArgs; /*===========================================*/ /* Determine if a module name was specified. */ /*===========================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"get-fact-list",NO_MORE_THAN,1)) == -1) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } if (numArgs == 1) { EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name"); return; } if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name"); return; } theModule = NULL; } } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*=====================*/ /* Get the constructs. */ /*=====================*/ EnvGetFactList(theEnv,returnValue,theModule); } /*************************************/ /* EnvGetFactList: C access routine */ /* for the get-fact-list function. */ /*************************************/ globle void EnvGetFactList( void *theEnv, DATA_OBJECT_PTR returnValue, void *vTheModule) { struct fact *theFact; unsigned long count; struct multifield *theList; struct defmodule *theModule = (struct defmodule *) vTheModule; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*============================================*/ /* Count the number of facts to be retrieved. */ /*============================================*/ if (theModule == NULL) { for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 0; theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++) { /* Do Nothing */ } } else { EnvSetCurrentModule(theEnv,(void *) theModule); UpdateDeftemplateScope(theEnv); for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 0; theFact != NULL; theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++) { /* Do Nothing */ } } /*===========================================================*/ /* Create the multifield value to store the construct names. */ /*===========================================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*==================================================*/ /* Store the fact pointers in the multifield value. */ /*==================================================*/ if (theModule == NULL) { for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 1; theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++) { SetMFType(theList,count,FACT_ADDRESS); SetMFValue(theList,count,(void *) theFact); } } else { for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 1; theFact != NULL; theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++) { SetMFType(theList,count,FACT_ADDRESS); SetMFValue(theList,count,(void *) theFact); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); UpdateDeftemplateScope(theEnv); } /**************************************/ /* PPFactFunction: H/L access routine */ /* for the ppfact function. */ /**************************************/ globle void PPFactFunction( void *theEnv) { struct fact *theFact; int numberOfArguments; #if IBM_TBC char *logicalName; /* Avoids warning */ #else char *logicalName = NULL; /* Avoids warning */ #endif int ignoreDefaults = FALSE; DATA_OBJECT theArg; if ((numberOfArguments = EnvArgRangeCheck(theEnv,"ppfact",1,3)) == -1) return; theFact = GetFactAddressOrIndexArgument(theEnv,"ppfact",1,TRUE); if (theFact == NULL) return; /*===============================================================*/ /* Determine the logical name to which the fact will be printed. */ /*===============================================================*/ if (numberOfArguments == 1) { logicalName = "stdout"; } else { logicalName = GetLogicalName(theEnv,2,"stdout"); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"ppfact"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } } /*=========================================*/ /* Should slot values be printed if they */ /* are the same as the default slot value. */ /*=========================================*/ if (numberOfArguments == 3) { EnvRtnUnknown(theEnv,3,&theArg); if ((theArg.value == EnvFalseSymbol(theEnv)) && (theArg.type == SYMBOL)) { ignoreDefaults = FALSE; } else { ignoreDefaults = TRUE; } } /*============================================================*/ /* Determine if any router recognizes the output destination. */ /*============================================================*/ if (strcmp(logicalName,"nil") == 0) { return; } else if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); return; } EnvPPFact(theEnv,theFact,logicalName,ignoreDefaults); } /*******************************/ /* EnvPPFact: C access routine */ /* for the ppfact function. */ /*******************************/ #if IBM_TBC #pragma argsused #endif globle void EnvPPFact( void *theEnv, void *vTheFact, char *logicalName, int ignoreDefaults) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif struct fact *theFact = (struct fact *) vTheFact; if (theFact == NULL) return; if (theFact->garbage) return; PrintFact(theEnv,logicalName,theFact,TRUE,ignoreDefaults); EnvPrintRouter(theEnv,logicalName,"\n"); } /**************************************************************/ /* GetFactAddressOrIndexArgument: Retrieves an argument for a */ /* function which should be a reference to a valid fact. */ /**************************************************************/ globle struct fact *GetFactAddressOrIndexArgument( void *theEnv, char *theFunction, int position, int noFactError) { DATA_OBJECT item; long factIndex; struct fact *theFact; char tempBuffer[20]; EnvRtnUnknown(theEnv,position,&item); if (GetType(item) == FACT_ADDRESS) { if (((struct fact *) GetValue(item))->garbage) return(NULL); else return (((struct fact *) GetValue(item))); } else if (GetType(item) == INTEGER) { factIndex = ValueToLong(item.value); if (factIndex < 0) { ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index"); return(NULL); } theFact = FindIndexedFact(theEnv,factIndex); if ((theFact == NULL) && noFactError) { sprintf(tempBuffer,"f-%ld",factIndex); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); return(NULL); } return(theFact); } ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index"); return(NULL); } #endif /* DEFTEMPLATE_CONSTRUCT */ clips-6.24/clipssrc/emathfun.c0000755000175000017500000006643110177533435014527 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* EXTENDED MATH FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for numerous extended math */ /* functions including cos, sin, tan, sec, csc, cot, acos, */ /* asin, atan, asec, acsc, acot, cosh, sinh, tanh, sech, */ /* csch, coth, acosh, asinh, atanh, asech, acsch, acoth, */ /* mod, exp, log, log10, sqrt, pi, deg-rad, rad-deg, */ /* deg-grad, grad-deg, **, and round. */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* Gary D. Riley */ /* */ /* Revision History: */ /* */ /*************************************************************/ #include "setup.h" #include "argacces.h" #include "envrnmnt.h" #include "extnfunc.h" #include "router.h" #include "emathfun.h" #if EX_MATH #include /***************/ /* DEFINITIONS */ /***************/ #ifndef PI #define PI 3.14159265358979323846 #endif #ifndef PID2 #define PID2 1.57079632679489661923 /* PI divided by 2 */ #endif #define SMALLEST_ALLOWED_NUMBER 1e-15 #define dtrunc(x) (((x) < 0.0) ? ceil(x) : floor(x)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static int SingleNumberCheck(void *,char *,double *); static int TestProximity(double,double); static void DomainErrorMessage(void *,char *); static void ArgumentOverflowErrorMessage(void *,char *); static void SingularityErrorMessage(void *,char *); static double genacosh(double); static double genasinh(double); static double genatanh(double); static double genasech(double); static double genacsch(double); static double genacoth(double); /************************************************/ /* ExtendedMathFunctionDefinitions: Initializes */ /* the extended math functions. */ /************************************************/ globle void ExtendedMathFunctionDefinitions( void *theEnv) { #if ! RUN_TIME EnvDefineFunction2(theEnv,"cos", 'd', PTIEF CosFunction, "CosFunction", "11n"); EnvDefineFunction2(theEnv,"sin", 'd', PTIEF SinFunction, "SinFunction", "11n"); EnvDefineFunction2(theEnv,"tan", 'd', PTIEF TanFunction, "TanFunction", "11n"); EnvDefineFunction2(theEnv,"sec", 'd', PTIEF SecFunction, "SecFunction", "11n"); EnvDefineFunction2(theEnv,"csc", 'd', PTIEF CscFunction, "CscFunction", "11n"); EnvDefineFunction2(theEnv,"cot", 'd', PTIEF CotFunction, "CotFunction", "11n"); EnvDefineFunction2(theEnv,"acos", 'd', PTIEF AcosFunction, "AcosFunction", "11n"); EnvDefineFunction2(theEnv,"asin", 'd', PTIEF AsinFunction, "AsinFunction", "11n"); EnvDefineFunction2(theEnv,"atan", 'd', PTIEF AtanFunction, "AtanFunction", "11n"); EnvDefineFunction2(theEnv,"asec", 'd', PTIEF AsecFunction, "AsecFunction", "11n"); EnvDefineFunction2(theEnv,"acsc", 'd', PTIEF AcscFunction, "AcscFunction", "11n"); EnvDefineFunction2(theEnv,"acot", 'd', PTIEF AcotFunction, "AcotFunction", "11n"); EnvDefineFunction2(theEnv,"cosh", 'd', PTIEF CoshFunction, "CoshFunction", "11n"); EnvDefineFunction2(theEnv,"sinh", 'd', PTIEF SinhFunction, "SinhFunction", "11n"); EnvDefineFunction2(theEnv,"tanh", 'd', PTIEF TanhFunction, "TanhFunction", "11n"); EnvDefineFunction2(theEnv,"sech", 'd', PTIEF SechFunction, "SechFunction", "11n"); EnvDefineFunction2(theEnv,"csch", 'd', PTIEF CschFunction, "CschFunction", "11n"); EnvDefineFunction2(theEnv,"coth", 'd', PTIEF CothFunction, "CothFunction", "11n"); EnvDefineFunction2(theEnv,"acosh", 'd', PTIEF AcoshFunction, "AcoshFunction", "11n"); EnvDefineFunction2(theEnv,"asinh", 'd', PTIEF AsinhFunction, "AsinhFunction", "11n"); EnvDefineFunction2(theEnv,"atanh", 'd', PTIEF AtanhFunction, "AtanhFunction", "11n"); EnvDefineFunction2(theEnv,"asech", 'd', PTIEF AsechFunction, "AsechFunction", "11n"); EnvDefineFunction2(theEnv,"acsch", 'd', PTIEF AcschFunction, "AcschFunction", "11n"); EnvDefineFunction2(theEnv,"acoth", 'd', PTIEF AcothFunction, "AcothFunction", "11n"); EnvDefineFunction2(theEnv,"mod", 'n', PTIEF ModFunction, "ModFunction", "22n"); EnvDefineFunction2(theEnv,"exp", 'd', PTIEF ExpFunction, "ExpFunction", "11n"); EnvDefineFunction2(theEnv,"log", 'd', PTIEF LogFunction, "LogFunction", "11n"); EnvDefineFunction2(theEnv,"log10", 'd', PTIEF Log10Function, "Log10Function", "11n"); EnvDefineFunction2(theEnv,"sqrt", 'd', PTIEF SqrtFunction, "SqrtFunction", "11n"); EnvDefineFunction2(theEnv,"pi", 'd', PTIEF PiFunction, "PiFunction", "00"); EnvDefineFunction2(theEnv,"deg-rad", 'd', PTIEF DegRadFunction, "DegRadFunction", "11n"); EnvDefineFunction2(theEnv,"rad-deg", 'd', PTIEF RadDegFunction, "RadDegFunction", "11n"); EnvDefineFunction2(theEnv,"deg-grad", 'd', PTIEF DegGradFunction, "DegGradFunction", "11n"); EnvDefineFunction2(theEnv,"grad-deg", 'd', PTIEF GradDegFunction, "GradDegFunction", "11n"); EnvDefineFunction2(theEnv,"**", 'd', PTIEF PowFunction, "PowFunction", "22n"); EnvDefineFunction2(theEnv,"round", 'l', PTIEF RoundFunction, "RoundFunction", "11n"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif } /************************************************************/ /* SingleNumberCheck: Retrieves the numeric argument for */ /* extended math functions which expect a single floating */ /* point argument. */ /************************************************************/ static int SingleNumberCheck( void *theEnv, char *functionName, double *theNumber) { DATA_OBJECT theValue; if (EnvArgCountCheck(theEnv,functionName,EXACTLY,1) == -1) return(FALSE); if (EnvArgTypeCheck(theEnv,functionName,1,FLOAT,&theValue) == FALSE) return(FALSE); *theNumber = DOToDouble(theValue); return(TRUE); } /**************************************************************/ /* TestProximity: Returns TRUE if the specified number falls */ /* within the specified range, otherwise FALSE is returned. */ /**************************************************************/ static int TestProximity( double theNumber, double range) { if ((theNumber >= (- range)) && (theNumber <= range)) return TRUE; else return FALSE; } /********************************************************/ /* DomainErrorMessage: Generic error message used when */ /* a domain error is detected during a call to one of */ /* the extended math functions. */ /********************************************************/ static void DomainErrorMessage( void *theEnv, char *functionName) { PrintErrorID(theEnv,"EMATHFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Domain error for "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); } /************************************************************/ /* ArgumentOverflowErrorMessage: Generic error message used */ /* when an argument overflow is detected during a call to */ /* one of the extended math functions. */ /************************************************************/ static void ArgumentOverflowErrorMessage( void *theEnv, char *functionName) { PrintErrorID(theEnv,"EMATHFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Argument overflow for "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); } /************************************************************/ /* SingularityErrorMessage: Generic error message used when */ /* a singularity is detected during a call to one of the */ /* extended math functions. */ /************************************************************/ static void SingularityErrorMessage( void *theEnv, char *functionName) { PrintErrorID(theEnv,"EMATHFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Singularity at asymptote in "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); } /*************************************/ /* CosFunction: H/L access routine */ /* for the cos function. */ /*************************************/ globle double CosFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"cos",&num) == FALSE) return(0.0); return(cos(num)); } /*************************************/ /* SinFunction: H/L access routine */ /* for the sin function. */ /*************************************/ globle double SinFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"sin",&num) == FALSE) return(0.0); return(sin(num)); } /*************************************/ /* TanFunction: H/L access routine */ /* for the tan function. */ /*************************************/ globle double TanFunction( void *theEnv) { double num, tv; if (SingleNumberCheck(theEnv,"tan",&num) == FALSE) return (0.0); tv = cos(num); if ((tv < SMALLEST_ALLOWED_NUMBER) && (tv > -SMALLEST_ALLOWED_NUMBER)) { SingularityErrorMessage(theEnv,"tan"); return(0.0); } return(sin(num) / tv); } /*************************************/ /* SecFunction: H/L access routine */ /* for the sec function. */ /*************************************/ globle double SecFunction( void *theEnv) { double num, tv; if (SingleNumberCheck(theEnv,"sec",&num) == FALSE) return(0.0); tv = cos(num); if ((tv < SMALLEST_ALLOWED_NUMBER) && (tv > -SMALLEST_ALLOWED_NUMBER)) { SingularityErrorMessage(theEnv,"sec"); return(0.0); } return(1.0 / tv); } /*************************************/ /* CscFunction: H/L access routine */ /* for the csc function. */ /*************************************/ globle double CscFunction( void *theEnv) { double num, tv; if (SingleNumberCheck(theEnv,"csc",&num) == FALSE) return(0.0); tv = sin(num); if ((tv < SMALLEST_ALLOWED_NUMBER) && (tv > -SMALLEST_ALLOWED_NUMBER)) { SingularityErrorMessage(theEnv,"csc"); return(0.0); } return(1.0 / tv); } /*************************************/ /* CotFunction: H/L access routine */ /* for the cot function. */ /*************************************/ globle double CotFunction( void *theEnv) { double num, tv; if (SingleNumberCheck(theEnv,"cot",&num) == FALSE) return(0.0); tv = sin(num); if ((tv < SMALLEST_ALLOWED_NUMBER) && (tv > -SMALLEST_ALLOWED_NUMBER)) { SingularityErrorMessage(theEnv,"cot"); return(0.0); } return(cos(num) / tv); } /**************************************/ /* AcosFunction: H/L access routine */ /* for the acos function. */ /**************************************/ globle double AcosFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acos",&num) == FALSE) return(0.0); if ((num > 1.0) || (num < -1.0)) { DomainErrorMessage(theEnv,"acos"); return(0.0); } return(acos(num)); } /**************************************/ /* AsinFunction: H/L access routine */ /* for the asin function. */ /**************************************/ globle double AsinFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"asin",&num) == FALSE) return(0.0); if ((num > 1.0) || (num < -1.0)) { DomainErrorMessage(theEnv,"asin"); return(0.0); } return(asin(num)); } /**************************************/ /* AtanFunction: H/L access routine */ /* for the atan function. */ /**************************************/ globle double AtanFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"atan",&num) == FALSE) return(0.0); return(atan(num)); } /**************************************/ /* AsecFunction: H/L access routine */ /* for the asec function. */ /**************************************/ globle double AsecFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"asec",&num) == FALSE) return(0.0); if ((num < 1.0) && (num > -1.0)) { DomainErrorMessage(theEnv,"asec"); return(0.0); } num = 1.0 / num; return(acos(num)); } /**************************************/ /* AcscFunction: H/L access routine */ /* for the acsc function. */ /**************************************/ globle double AcscFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acsc",&num) == FALSE) return(0.0); if ((num < 1.0) && (num > -1.0)) { DomainErrorMessage(theEnv,"acsc"); return(0.0); } num = 1.0 / num; return(asin(num)); } /**************************************/ /* AcotFunction: H/L access routine */ /* for the acot function. */ /**************************************/ globle double AcotFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acot",&num) == FALSE) return(0.0); if (TestProximity(num,1e-25) == TRUE) return(PID2); num = 1.0 / num; return(atan(num)); } /**************************************/ /* CoshFunction: H/L access routine */ /* for the cosh function. */ /**************************************/ globle double CoshFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"cosh",&num) == FALSE) return(0.0); return(cosh(num)); } /**************************************/ /* SinhFunction: H/L access routine */ /* for the sinh function. */ /**************************************/ globle double SinhFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"sinh",&num) == FALSE) return(0.0); return(sinh(num)); } /**************************************/ /* TanhFunction: H/L access routine */ /* for the tanh function. */ /**************************************/ globle double TanhFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"tanh",&num) == FALSE) return(0.0); return(tanh(num)); } /**************************************/ /* SechFunction: H/L access routine */ /* for the sech function. */ /**************************************/ globle double SechFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"sech",&num) == FALSE) return(0.0); return(1.0 / cosh(num)); } /**************************************/ /* CschFunction: H/L access routine */ /* for the csch function. */ /**************************************/ globle double CschFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"csch",&num) == FALSE) return(0.0); if (num == 0.0) { SingularityErrorMessage(theEnv,"csch"); return(0.0); } else if (TestProximity(num,1e-25) == TRUE) { ArgumentOverflowErrorMessage(theEnv,"csch"); return(0.0); } return(1.0 / sinh(num)); } /**************************************/ /* CothFunction: H/L access routine */ /* for the coth function. */ /**************************************/ globle double CothFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"coth",&num) == FALSE) return(0.0); if (num == 0.0) { SingularityErrorMessage(theEnv,"coth"); return(0.0); } else if (TestProximity(num,1e-25) == TRUE) { ArgumentOverflowErrorMessage(theEnv,"coth"); return(0.0); } return(1.0 / tanh(num)); } /***************************************/ /* AcoshFunction: H/L access routine */ /* for the acosh function. */ /***************************************/ globle double AcoshFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acosh",&num) == FALSE) return(0.0); if (num < 1.0) { DomainErrorMessage(theEnv,"acosh"); return(0.0); } return(genacosh(num)); } /***************************************/ /* AsinhFunction: H/L access routine */ /* for the asinh function. */ /***************************************/ globle double AsinhFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"asinh",&num) == FALSE) return(0.0); return(genasinh(num)); } /***************************************/ /* AtanhFunction: H/L access routine */ /* for the atanh function. */ /***************************************/ globle double AtanhFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"atanh",&num) == FALSE) return(0.0); if ((num >= 1.0) || (num <= -1.0)) { DomainErrorMessage(theEnv,"atanh"); return(0.0); } return(genatanh(num)); } /***************************************/ /* AsechFunction: H/L access routine */ /* for the asech function. */ /***************************************/ globle double AsechFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"asech",&num) == FALSE) return(0.0); if ((num > 1.0) || (num <= 0.0)) { DomainErrorMessage(theEnv,"asech"); return(0.0); } return(genasech(num)); } /***************************************/ /* AcschFunction: H/L access routine */ /* for the acsch function. */ /***************************************/ globle double AcschFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acsch",&num) == FALSE) return(0.0); if (num == 0.0) { DomainErrorMessage(theEnv,"acsch"); return(0.0); } return(genacsch(num)); } /***************************************/ /* AcothFunction: H/L access routine */ /* for the acoth function. */ /***************************************/ globle double AcothFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"acoth",&num) == FALSE) return(0.0); if ((num <= 1.0) && (num >= -1.0)) { DomainErrorMessage(theEnv,"acoth"); return(0.0); } return(genacoth(num)); } /*************************************/ /* ExpFunction: H/L access routine */ /* for the exp function. */ /*************************************/ globle double ExpFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"exp",&num) == FALSE) return(0.0); return(exp(num)); } /*************************************/ /* LogFunction: H/L access routine */ /* for the log function. */ /*************************************/ globle double LogFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"log",&num) == FALSE) return(0.0); if (num < 0.0) { DomainErrorMessage(theEnv,"log"); return(0.0); } else if (num == 0.0) { ArgumentOverflowErrorMessage(theEnv,"log"); return(0.0); } return(log(num)); } /***************************************/ /* Log10Function: H/L access routine */ /* for the log10 function. */ /***************************************/ globle double Log10Function( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"log10",&num) == FALSE) return(0.0); if (num < 0.0) { DomainErrorMessage(theEnv,"log10"); return(0.0); } else if (num == 0.0) { ArgumentOverflowErrorMessage(theEnv,"log10"); return(0.0); } return(log10(num)); } /**************************************/ /* SqrtFunction: H/L access routine */ /* for the sqrt function. */ /**************************************/ globle double SqrtFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"sqrt",&num) == FALSE) return(0.0); if (num < 0.00000) { DomainErrorMessage(theEnv,"sqrt"); return(0.0); } return(sqrt(num)); } /*************************************/ /* PowFunction: H/L access routine */ /* for the pow function. */ /*************************************/ globle double PowFunction( void *theEnv) { DATA_OBJECT value1, value2; if (EnvArgCountCheck(theEnv,"**",EXACTLY,2) == -1) return(0.0); if (EnvArgTypeCheck(theEnv,"**",1,FLOAT,&value1) == FALSE) return(0.0); if (EnvArgTypeCheck(theEnv,"**",2,FLOAT,&value2) == FALSE) return(0.0); if (((DOToDouble(value1) == 0.0) && (DOToDouble(value2) <= 0.0)) || ((DOToDouble(value1) < 0.0) && (dtrunc((double) DOToDouble(value2)) != DOToDouble(value2)))) { DomainErrorMessage(theEnv,"**"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(0.0); } return (pow(DOToDouble(value1),DOToDouble(value2))); } /*************************************/ /* ModFunction: H/L access routine */ /* for the mod function. */ /*************************************/ globle void ModFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT item1, item2; double fnum1, fnum2; long lnum1, lnum2; if (EnvArgCountCheck(theEnv,"mod",EXACTLY,2) == -1) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (EnvArgTypeCheck(theEnv,"mod",1,INTEGER_OR_FLOAT,&item1) == FALSE) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (EnvArgTypeCheck(theEnv,"mod",2,INTEGER_OR_FLOAT,&item2) == FALSE) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (((item2.type == INTEGER) ? (ValueToLong(item2.value) == 0L) : FALSE) || ((item2.type == FLOAT) ? ValueToDouble(item2.value) == 0.0 : FALSE)) { DivideByZeroErrorMessage(theEnv,"mod"); SetEvaluationError(theEnv,TRUE); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if ((item1.type == FLOAT) || (item2.type == FLOAT)) { fnum1 = CoerceToDouble(item1.type,item1.value); fnum2 = CoerceToDouble(item2.type,item2.value); result->type = FLOAT; result->value = (void *) EnvAddDouble(theEnv,fnum1 - (dtrunc(fnum1 / fnum2) * fnum2)); } else { lnum1 = DOToLong(item1); lnum2 = DOToLong(item2); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,lnum1 - (lnum1 / lnum2) * lnum2); } } /************************************/ /* PiFunction: H/L access routine */ /* for the pi function. */ /************************************/ globle double PiFunction( void *theEnv) { if (EnvArgCountCheck(theEnv,"pi",EXACTLY,0) == -1) return(acos(-1.0)); return(acos(-1.0)); } /****************************************/ /* DegRadFunction: H/L access routine */ /* for the deg-rad function. */ /****************************************/ globle double DegRadFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"deg-rad",&num) == FALSE) return(0.0); return(num * PI / 180.0); } /****************************************/ /* RadDegFunction: H/L access routine */ /* for the rad-deg function. */ /****************************************/ globle double RadDegFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"rad-deg",&num) == FALSE) return(0.0); return(num * 180.0 / PI); } /*****************************************/ /* DegGradFunction: H/L access routine */ /* for the deg-grad function. */ /*****************************************/ globle double DegGradFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"deg-grad",&num) == FALSE) return(0.0); return(num / 0.9); } /*****************************************/ /* GradDegFunction: H/L access routine */ /* for the grad-deg function. */ /*****************************************/ globle double GradDegFunction( void *theEnv) { double num; if (SingleNumberCheck(theEnv,"grad-deg",&num) == FALSE) return(0.0); return(num * 0.9); } /***************************************/ /* RoundFunction: H/L access routine */ /* for the round function. */ /***************************************/ globle long int RoundFunction( void *theEnv) { DATA_OBJECT result; if (EnvArgCountCheck(theEnv,"round",EXACTLY,1) == -1) { return(0L); } if (EnvArgTypeCheck(theEnv,"round",1,INTEGER_OR_FLOAT,&result) == FALSE) { return(0L); } if (result.type == INTEGER) { return(ValueToLong(result.value)); } else { return((long) ceil(ValueToDouble(result.value) - 0.5)); } } /*******************************************/ /* genacsch: Generic routine for computing */ /* the hyperbolic arccosine. */ /*******************************************/ static double genacosh( double num) { return(log(num + sqrt(num * num - 1.0))); } /*******************************************/ /* genacsch: Generic routine for computing */ /* the hyperbolic arcsine. */ /*******************************************/ static double genasinh( double num) { return(log(num + sqrt(num * num + 1.0))); } /*******************************************/ /* genatanh: Generic routine for computing */ /* the hyperbolic arctangent. */ /*******************************************/ static double genatanh( double num) { return((0.5) * log((1.0 + num) / (1.0 - num))); } /*******************************************/ /* genacsch: Generic routine for computing */ /* the hyperbolic arcsecant. */ /*******************************************/ static double genasech( double num) { return(log(1.0 / num + sqrt(1.0 / (num * num) - 1.0))); } /*******************************************/ /* genacsch: Generic routine for computing */ /* the hyperbolic arccosecant. */ /*******************************************/ static double genacsch( double num) { return(log(1.0 / num + sqrt(1.0 / (num * num) + 1.0))); } /*******************************************/ /* genacoth: Generic routine for computing */ /* the hyperbolic arccotangent. */ /*******************************************/ static double genacoth( double num) { return((0.5) * log((num + 1.0) / (num - 1.0))); } #endif clips-6.24/clipssrc/dffnxpsr.c0000755000175000017500000004135310441602133014530 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Deffunction Parsing Routines */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* If the last construct in a loaded file is a */ /* deffunction or defmethod with no closing right */ /* parenthesis, an error should be issued, but is */ /* not. DR0872 */ /* */ /* Added pragmas to prevent unused variable */ /* warnings. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) #if BLOAD || BLOAD_AND_BSAVE #include "bload.h" #endif #if DEFRULE_CONSTRUCT #include "network.h" #endif #if DEFGENERIC_CONSTRUCT #include "genrccom.h" #endif #include "constant.h" #include "cstrcpsr.h" #include "constrct.h" #include "dffnxfun.h" #include "envrnmnt.h" #include "expressn.h" #include "exprnpsr.h" #include "extnfunc.h" #include "memalloc.h" #include "prccode.h" #include "router.h" #include "scanner.h" #include "symbol.h" #define _DFFNXPSR_SOURCE_ #include "dffnxpsr.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static intBool ValidDeffunctionName(void *,char *); static DEFFUNCTION *AddDeffunction(void *,SYMBOL_HN *,EXPRESSION *,int,int,int,int); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*************************************************************************** NAME : ParseDeffunction DESCRIPTION : Parses the deffunction construct INPUTS : The input logical name RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Creates valid deffunction definition NOTES : H/L Syntax : (deffunction [] (* []) *) ***************************************************************************/ globle intBool ParseDeffunction( void *theEnv, char *readSource) { SYMBOL_HN *deffunctionName; EXPRESSION *actions; EXPRESSION *parameterList; SYMBOL_HN *wildcard; int min,max,lvars,DeffunctionError = FALSE; short overwrite = FALSE, owMin = 0, owMax = 0; DEFFUNCTION *dptr; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(deffunction "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"deffunctions"); return(TRUE); } #endif /* ===================================================== Parse the name and comment fields of the deffunction. ===================================================== */ deffunctionName = GetConstructNameAndComment(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,"deffunction", EnvFindDeffunction,NULL, "!",TRUE,TRUE,TRUE); if (deffunctionName == NULL) return(TRUE); if (ValidDeffunctionName(theEnv,ValueToString(deffunctionName)) == FALSE) return(TRUE); /*==========================*/ /* Parse the argument list. */ /*==========================*/ parameterList = ParseProcParameters(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,NULL,&wildcard, &min,&max,&DeffunctionError,NULL); if (DeffunctionError) return(TRUE); /*===================================================================*/ /* Go ahead and add the deffunction so it can be recursively called. */ /*===================================================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { dptr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(deffunctionName)); if (dptr == NULL) { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); } else { overwrite = TRUE; owMin = (short) dptr->minNumberOfParameters; owMax = (short) dptr->maxNumberOfParameters; dptr->minNumberOfParameters = min; dptr->maxNumberOfParameters = max; } } else { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); } if (dptr == NULL) { ReturnExpression(theEnv,parameterList); return(TRUE); } /*==================================================*/ /* Parse the actions contained within the function. */ /*==================================================*/ PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"deffunction",readSource, &DeffunctionData(theEnv)->DFInputToken,parameterList,wildcard, NULL,NULL,&lvars,NULL); /*=============================================================*/ /* Check for the closing right parenthesis of the deffunction. */ /*=============================================================*/ if ((DeffunctionData(theEnv)->DFInputToken.type != RPAREN) && /* DR0872 */ (actions != NULL)) { SyntaxErrorMessage(theEnv,"deffunction"); ReturnExpression(theEnv,parameterList); ReturnPackedExpression(theEnv,actions); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } if ((dptr->busy == 0) && (! overwrite)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(TRUE); } if (actions == NULL) { ReturnExpression(theEnv,parameterList); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } if ((dptr->busy == 0) && (! overwrite)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(TRUE); } /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deffunction to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,parameterList); ReturnPackedExpression(theEnv,actions); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } else { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(FALSE); } /*=============================*/ /* Reformat the closing token. */ /*=============================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DeffunctionData(theEnv)->DFInputToken.printForm); SavePPBuffer(theEnv,"\n"); /*======================*/ /* Add the deffunction. */ /*======================*/ AddDeffunction(theEnv,deffunctionName,actions,min,max,lvars,FALSE); ReturnExpression(theEnv,parameterList); return(DeffunctionError); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************ NAME : ValidDeffunctionName DESCRIPTION : Determines if a new deffunction of the given name can be defined in the current module INPUTS : The new deffunction name RETURNS : TRUE if OK, FALSE otherwise SIDE EFFECTS : Error message printed if not OK NOTES : GetConstructNameAndComment() (called before this function) ensures that the deffunction name does not conflict with one from another module ************************************************************/ static intBool ValidDeffunctionName( void *theEnv, char *theDeffunctionName) { struct constructHeader *theDeffunction; #if DEFGENERIC_CONSTRUCT struct defmodule *theModule; struct constructHeader *theDefgeneric; #endif /* ============================================ A deffunction cannot be named the same as a construct type, e.g, defclass, defrule, etc. ============================================ */ if (FindConstruct(theEnv,theDeffunctionName) != NULL) { PrintErrorID(theEnv,"DFFNXPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n"); return(FALSE); } /* ============================================ A deffunction cannot be named the same as a pre-defined system function, e.g, watch, list-defrules, etc. ============================================ */ if (FindFunction(theEnv,theDeffunctionName) != NULL) { PrintErrorID(theEnv,"DFFNXPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n"); return(FALSE); } #if DEFGENERIC_CONSTRUCT /* ============================================ A deffunction cannot be named the same as a generic function (either in this module or imported from another) ============================================ */ theDefgeneric = (struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName); if (theDefgeneric != NULL) { theModule = GetConstructModuleItem(theDefgeneric)->theModule; if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { PrintErrorID(theEnv,"DFFNXPSR",5,FALSE); EnvPrintRouter(theEnv,WERROR,"Defgeneric "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric)); EnvPrintRouter(theEnv,WERROR," imported from module "); EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule)); EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n"); return(FALSE); } else { PrintErrorID(theEnv,"DFFNXPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n"); } return(FALSE); } #endif theDeffunction = (struct constructHeader *) EnvFindDeffunction(theEnv,theDeffunctionName); if (theDeffunction != NULL) { /* =========================================== And a deffunction in the current module can only be redefined if it is not executing. =========================================== */ if (((DEFFUNCTION *) theDeffunction)->executing) { PrintErrorID(theEnv,"DFNXPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Deffunction "); EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction)); EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n"); return(FALSE); } } return(TRUE); } /**************************************************** 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 ****************************************************/ #if IBM_TBC #pragma argsused #endif 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; #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(headerp) #endif #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); } #endif /* DEFFUNCTION_CONSTRUCT && (! BLOAD_ONLY) && (! RUN_TIME) */ clips-6.24/clipssrc/cstrcbin.h0000755000175000017500000000375407422634617014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrcbin #define _H_cstrcbin #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE struct bsaveConstructHeader { long name; long whichModule; long next; }; #ifndef _H_constrct #include "constrct.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRCBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if BLOAD_AND_BSAVE LOCALE void MarkConstructHeaderNeededItems(struct constructHeader *,long); LOCALE void AssignBsaveConstructHeaderVals(struct bsaveConstructHeader *, struct constructHeader *); #endif LOCALE void UpdateConstructHeader(void *, struct bsaveConstructHeader *, struct constructHeader *,int,void *,int,void *); LOCALE void UnmarkConstructHeader(void *,struct constructHeader *); #ifndef _CSTRCBIN_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/._rulebld.c0000400000175000017500000000452210441602323014525 0ustar jfsjfsMac OS X  2 R TEXTR*ch an rulebld.ctrol PanelTCmr.txt.docTEXTR*ch@ p)X " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco8Ja8JaPD66SnL0nGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/dffctbin.c0000755000175000017500000004631707673514761014510 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.21 06/15/03 */ /* */ /* DEFFACTS BSAVE/BLOAD MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the binary save/load feature for the */ /* deffacts construct. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _DFFCTBIN_SOURCE_ #include "setup.h" #if DEFFACTS_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) #include #define _STDIO_INCLUDED_ #include "memalloc.h" #include "dffctdef.h" #include "moduldef.h" #include "bload.h" #include "bsave.h" #include "envrnmnt.h" #include "dffctbin.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ #if BLOAD_AND_BSAVE static void BsaveFind(void *); static void BsaveExpressions(void *,FILE *); static void BsaveStorage(void *,FILE *); static void BsaveBinaryItem(void *,FILE *); #endif static void BloadStorage(void *); static void BloadBinaryItem(void *); static void UpdateDeffactsModule(void *,void *,long); static void UpdateDeffacts(void *,void *,long); static void ClearBload(void *); static void DeallocateDeffactsBloadData(void *); /********************************************/ /* DeffactsBinarySetup: Installs the binary */ /* save/load feature for deffacts. */ /********************************************/ globle void DeffactsBinarySetup( void *theEnv) { AllocateEnvironmentData(theEnv,DFFCTBIN_DATA,sizeof(struct deffactsBinaryData),DeallocateDeffactsBloadData); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"deffacts",0,BsaveFind,BsaveExpressions, BsaveStorage,BsaveBinaryItem, BloadStorage,BloadBinaryItem, ClearBload); #endif #if (BLOAD || BLOAD_ONLY) AddBinaryItem(theEnv,"deffacts",0,NULL,NULL,NULL,NULL, BloadStorage,BloadBinaryItem, ClearBload); #endif } /********************************************************/ /* DeallocateDeffactsBloadData: Deallocates environment */ /* data for the deffacts bsave functionality. */ /********************************************************/ static void DeallocateDeffactsBloadData( void *theEnv) { unsigned long space; space = DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct deffacts); if (space != 0) genlongfree(theEnv,(void *) DeffactsBinaryData(theEnv)->DeffactsArray,space); space = DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct deffactsModule); if (space != 0) genlongfree(theEnv,(void *) DeffactsBinaryData(theEnv)->ModuleArray,space); } #if BLOAD_AND_BSAVE /*********************************************************/ /* BsaveFind: Counts the number of data structures which */ /* must be saved in the binary image for the deffacts */ /* in the current environment. */ /*********************************************************/ static void BsaveFind( void *theEnv) { struct deffacts *theDeffacts; struct defmodule *theModule; /*=======================================================*/ /* If a binary image is already loaded, then temporarily */ /* save the count values since these will be overwritten */ /* in the process of saving the binary image. */ /*=======================================================*/ SaveBloadCount(theEnv,DeffactsBinaryData(theEnv)->NumberOfDeffactsModules); SaveBloadCount(theEnv,DeffactsBinaryData(theEnv)->NumberOfDeffacts); /*========================================*/ /* Set the count of deffacts and deffacts */ /* module data structures to zero. */ /*========================================*/ DeffactsBinaryData(theEnv)->NumberOfDeffacts = 0; DeffactsBinaryData(theEnv)->NumberOfDeffactsModules = 0; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*===============================================*/ /* Set the current module to the module being */ /* examined and increment the number of deffacts */ /* modules encountered. */ /*===============================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); DeffactsBinaryData(theEnv)->NumberOfDeffactsModules++; /*===================================================*/ /* Loop through each deffacts in the current module. */ /*===================================================*/ for (theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL); theDeffacts != NULL; theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,theDeffacts)) { /*======================================================*/ /* Initialize the construct header for the binary save. */ /*======================================================*/ MarkConstructHeaderNeededItems(&theDeffacts->header,DeffactsBinaryData(theEnv)->NumberOfDeffacts++); /*============================================================*/ /* Count the number of expressions contained in the deffacts' */ /* assertion list and mark any atomic values contained there */ /* as in use. */ /*============================================================*/ ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDeffacts->assertList); MarkNeededItems(theEnv,theDeffacts->assertList); } } } /************************************************/ /* BsaveExpressions: Saves the expressions used */ /* by deffacts to the binary save file. */ /************************************************/ static void BsaveExpressions( void *theEnv, FILE *fp) { struct deffacts *theDeffacts; struct defmodule *theModule; /*===========================*/ /* Loop through each module. */ /*===========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { /*======================================================*/ /* Set the current module to the module being examined. */ /*======================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); /*==================================================*/ /* Loop through each deffacts in the current module */ /* and save the assertion list expression. */ /*==================================================*/ for (theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL); theDeffacts != NULL; theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,theDeffacts)) { BsaveExpression(theEnv,theDeffacts->assertList,fp); } } } /******************************************************/ /* BsaveStorage: Writes out the storage requirements */ /* for all deffacts structures to the binary file. */ /******************************************************/ static void BsaveStorage( void *theEnv, FILE *fp) { unsigned long space; /*=================================================================*/ /* Only two data structures are saved as part of a deffacts binary */ /* image: the deffacts data structure and the deffactsModule data */ /* structure. The assertion list expressions are not save with the */ /* deffacts portion of the binary image. */ /*=================================================================*/ space = sizeof(long) * 2; GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); GenWrite(&DeffactsBinaryData(theEnv)->NumberOfDeffacts,(unsigned long) sizeof(long int),fp); GenWrite(&DeffactsBinaryData(theEnv)->NumberOfDeffactsModules,(unsigned long) sizeof(long int),fp); } /********************************************/ /* BsaveBinaryItem: Writes out all deffacts */ /* structures to the binary file. */ /********************************************/ static void BsaveBinaryItem( void *theEnv, FILE *fp) { unsigned long int space; struct deffacts *theDeffacts; struct bsaveDeffacts newDeffacts; struct defmodule *theModule; struct bsaveDeffactsModule tempDeffactsModule; struct deffactsModule *theModuleItem; /*=========================================================*/ /* Write out the amount of space taken up by the deffacts */ /* and deffactsModule data structures in the binary image. */ /*=========================================================*/ space = DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct bsaveDeffacts) + (DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct bsaveDeffactsModule)); GenWrite(&space,(unsigned long) sizeof(unsigned long int),fp); /*================================================*/ /* Write out each deffacts module data structure. */ /*================================================*/ DeffactsBinaryData(theEnv)->NumberOfDeffacts = 0; for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); theModuleItem = (struct deffactsModule *) GetModuleItem(theEnv,NULL,DeffactsData(theEnv)->DeffactsModuleIndex); AssignBsaveDefmdlItemHdrVals(&tempDeffactsModule.header,&theModuleItem->header); GenWrite(&tempDeffactsModule,(unsigned long) sizeof(struct bsaveDeffactsModule),fp); } /*==========================*/ /* Write out each deffacts. */ /*==========================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); for (theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,NULL); theDeffacts != NULL; theDeffacts = (struct deffacts *) EnvGetNextDeffacts(theEnv,theDeffacts)) { AssignBsaveConstructHeaderVals(&newDeffacts.header,&theDeffacts->header); if (theDeffacts->assertList != NULL) { newDeffacts.assertList = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(theDeffacts->assertList); } else { newDeffacts.assertList = -1L; } GenWrite(&newDeffacts,(unsigned long) sizeof(struct bsaveDeffacts),fp); } } /*=============================================================*/ /* If a binary image was already loaded when the bsave command */ /* was issued, then restore the counts indicating the number */ /* of deffacts and deffacts modules in the binary image (these */ /* were overwritten by the binary save). */ /*=============================================================*/ RestoreBloadCount(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffactsModules); RestoreBloadCount(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffacts); } #endif /* BLOAD_AND_BSAVE */ /****************************************************/ /* BloadStorage: Allocates storage requirements for */ /* the deffacts used by this binary image. */ /****************************************************/ static void BloadStorage( void *theEnv) { unsigned long int space; /*=====================================================*/ /* Determine the number of deffacts and deffactsModule */ /* data structures to be read. */ /*=====================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); GenReadBinary(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffacts,(unsigned long) sizeof(long int)); GenReadBinary(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffactsModules,(unsigned long) sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* deffactsModule data structures. */ /*===================================*/ if (DeffactsBinaryData(theEnv)->NumberOfDeffactsModules == 0) { DeffactsBinaryData(theEnv)->DeffactsArray = NULL; DeffactsBinaryData(theEnv)->ModuleArray = NULL; return; } space = DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct deffactsModule); DeffactsBinaryData(theEnv)->ModuleArray = (struct deffactsModule *) genlongalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* deffacts data structures. */ /*===================================*/ if (DeffactsBinaryData(theEnv)->NumberOfDeffacts == 0) { DeffactsBinaryData(theEnv)->DeffactsArray = NULL; return; } space = (unsigned long) (DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct deffacts)); DeffactsBinaryData(theEnv)->DeffactsArray = (struct deffacts *) genlongalloc(theEnv,space); } /*****************************************************/ /* BloadBinaryItem: Loads and refreshes the deffacts */ /* constructs used by this binary image. */ /*****************************************************/ static void BloadBinaryItem( void *theEnv) { unsigned long int space; /*======================================================*/ /* Read in the amount of space used by the binary image */ /* (this is used to skip the construct in the event it */ /* is not available in the version being run). */ /*======================================================*/ GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int)); /*============================================*/ /* Read in the deffactsModule data structures */ /* and refresh the pointers. */ /*============================================*/ BloadandRefresh(theEnv,DeffactsBinaryData(theEnv)->NumberOfDeffactsModules, (unsigned) sizeof(struct bsaveDeffactsModule), UpdateDeffactsModule); /*======================================*/ /* Read in the deffacts data structures */ /* and refresh the pointers. */ /*======================================*/ BloadandRefresh(theEnv,DeffactsBinaryData(theEnv)->NumberOfDeffacts, (unsigned) sizeof(struct bsaveDeffacts), UpdateDeffacts); } /***************************************************/ /* UpdateDeffactsModule: Bload refresh routine for */ /* deffacts module data structures. */ /***************************************************/ static void UpdateDeffactsModule( void *theEnv, void *buf, long obji) { struct bsaveDeffactsModule *bdmPtr; bdmPtr = (struct bsaveDeffactsModule *) buf; UpdateDefmoduleItemHeader(theEnv,&bdmPtr->header,&DeffactsBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(struct deffacts),(void *) DeffactsBinaryData(theEnv)->DeffactsArray); } /*********************************************/ /* UpdateDeffacts: Bload refresh routine for */ /* deffacts data structures. */ /*********************************************/ static void UpdateDeffacts( void *theEnv, void *buf, long obji) { struct bsaveDeffacts *bdp; bdp = (struct bsaveDeffacts *) buf; UpdateConstructHeader(theEnv,&bdp->header,&DeffactsBinaryData(theEnv)->DeffactsArray[obji].header, (int) sizeof(struct deffactsModule),(void *) DeffactsBinaryData(theEnv)->ModuleArray, (int) sizeof(struct deffacts),(void *) DeffactsBinaryData(theEnv)->DeffactsArray); DeffactsBinaryData(theEnv)->DeffactsArray[obji].assertList = ExpressionPointer(bdp->assertList); } /**************************************/ /* ClearBload: Deffacts clear routine */ /* when a binary load is in effect. */ /**************************************/ static void ClearBload( void *theEnv) { long i; unsigned long space; /*=============================================*/ /* Decrement in use counters for atomic values */ /* contained in the construct headers. */ /*=============================================*/ for (i = 0; i < DeffactsBinaryData(theEnv)->NumberOfDeffacts; i++) { UnmarkConstructHeader(theEnv,&DeffactsBinaryData(theEnv)->DeffactsArray[i].header); } /*=============================================================*/ /* Deallocate the space used for the deffacts data structures. */ /*=============================================================*/ space = DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct deffacts); if (space != 0) genlongfree(theEnv,(void *) DeffactsBinaryData(theEnv)->DeffactsArray,space); DeffactsBinaryData(theEnv)->NumberOfDeffacts = 0; /*====================================================================*/ /* Deallocate the space used for the deffacts module data structures. */ /*====================================================================*/ space = DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct deffactsModule); if (space != 0) genlongfree(theEnv,(void *) DeffactsBinaryData(theEnv)->ModuleArray,space); DeffactsBinaryData(theEnv)->NumberOfDeffactsModules = 0; } /******************************************************/ /* BloadDeffactsModuleReference: Returns the deffacts */ /* module pointer for use with the bload function. */ /******************************************************/ globle void *BloadDeffactsModuleReference( void *theEnv, int theIndex) { return ((void *) &DeffactsBinaryData(theEnv)->ModuleArray[theIndex]); } #endif /* DEFFACTS_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) */ clips-6.24/clipssrc/dffnxcmp.c0000755000175000017500000003144307422634773014526 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Generic Function Construct Compiler Code */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if DEFFUNCTION_CONSTRUCT && CONSTRUCT_COMPILER && (! RUN_TIME) #include "conscomp.h" #include "envrnmnt.h" #define _DFFNXCMP_SOURCE_ #include "dffnxcmp.h" /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static void ReadyDeffunctionsForCode(void *); static int DeffunctionsToCode(void *,char *,int,FILE *,int,int); static void CloseDeffunctionFiles(void *,FILE *,FILE *,int); static void DeffunctionModuleToCode(void *,FILE *,struct defmodule *,int,int); static void SingleDeffunctionToCode(void *,FILE *,DEFFUNCTION *,int,int,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 ***************************************************/ globle void SetupDeffunctionCompiler( void *theEnv) { DeffunctionData(theEnv)->DeffunctionCodeItem = AddCodeGeneratorItem(theEnv,"deffunctions",0,ReadyDeffunctionsForCode, NULL,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 ***************************************************/ globle void PrintDeffunctionReference( void *theEnv, FILE *fp, DEFFUNCTION *dfPtr, int imageID, int maxIndices) { if (dfPtr == NULL) fprintf(fp,"NULL"); else fprintf(fp,"&%s%d_%d[%d]",ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem),imageID, (int) ((dfPtr->header.bsaveID / maxIndices) + 1), (int) (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 ****************************************************/ globle void DeffunctionCModuleReference( void *theEnv, FILE *theFile, int count, int imageID, int maxIndices) { fprintf(theFile,"MIHS &%s%d_%d[%d]", 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( void *theEnv) { MarkConstructBsaveIDs(theEnv,DeffunctionData(theEnv)->DeffunctionModuleIndex); } /******************************************************* 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 : -1 if no deffunctions, 0 on errors, 1 if deffunctions written SIDE EFFECTS : Code written to files NOTES : None *******************************************************/ static int DeffunctionsToCode( void *theEnv, char *fileName, int fileID, FILE *headerFP, int imageID, int maxIndices) { int fileCount = 1; struct defmodule *theModule; DEFFUNCTION *theDeffunction; int moduleCount = 0, moduleArrayCount = 0, moduleArrayVersion = 1; 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 = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { EnvSetCurrentModule(theEnv,(void *) theModule); moduleFile = OpenFileIfNeeded(theEnv,moduleFile,fileName,fileID,imageID,&fileCount, moduleArrayVersion,headerFP, "DEFFUNCTION_MODULE",ModulePrefix(DeffunctionData(theEnv)->DeffunctionCodeItem), FALSE,NULL); if (moduleFile == NULL) { CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices); return(0); } DeffunctionModuleToCode(theEnv,moduleFile,theModule,imageID,maxIndices); moduleFile = CloseFileIfNeeded(theEnv,moduleFile,&moduleArrayCount,&moduleArrayVersion, maxIndices,NULL,NULL); theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL); while (theDeffunction != NULL) { deffunctionFile = OpenFileIfNeeded(theEnv,deffunctionFile,fileName,fileID,imageID,&fileCount, deffunctionArrayVersion,headerFP, "DEFFUNCTION",ConstructPrefix(DeffunctionData(theEnv)->DeffunctionCodeItem), FALSE,NULL); if (deffunctionFile == NULL) { CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices); return(0); } SingleDeffunctionToCode(theEnv,deffunctionFile,theDeffunction,imageID, maxIndices,moduleCount); deffunctionArrayCount++; deffunctionFile = CloseFileIfNeeded(theEnv,deffunctionFile,&deffunctionArrayCount, &deffunctionArrayVersion,maxIndices,NULL,NULL); theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,theDeffunction); } theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule); moduleCount++; moduleArrayCount++; } CloseDeffunctionFiles(theEnv,moduleFile,deffunctionFile,maxIndices); return(1); } /*************************************************** 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( void *theEnv, FILE *moduleFile, FILE *deffunctionFile, int maxIndices) { int count = maxIndices; 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( void *theEnv, FILE *theFile, struct defmodule *theModule, int imageID, 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( void *theEnv, FILE *theFile, DEFFUNCTION *theDeffunction, int imageID, int maxIndices, 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 /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips-6.24/clipssrc/._expressn.h0000400000175000017500000000075410441132010014742 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z8,,TTFS ~FMWBBMPSRclips-6.24/clipssrc/._crstrtgy.h0000400000175000017500000000075410441071550014767 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH Monaco Y YϾ j@TTFSlSFMPSRMWBBLclips-6.24/clipssrc/edmisc.c0000755000175000017500000015157510441163261014156 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Changed name of variable log to logName */ /* because of Unix compiler warnings of shadowed */ /* definitions. */ /* */ /* 6.24: Corrected code generating compilation */ /* warnings. */ /* */ /*************************************************************/ /* * This file contains the command processing functions for a number of * commands, including the search, spawn, and compile functions. */ #include "setup.h" #if EMACS_EDITOR && ! RUN_TIME #define _EDMISC_SOURCE_ #include "ed.h" #include "cstrcpsr.h" static int tabsize; /* Tab size (0: use real tabs) */ /* ----------------------------- * Spawn function setups * ----------------------------- */ #if VAX_VMS #define EFN 0 /* Event flag. */ #include /* Random headers. */ #include #include #include extern int oldmode[2]; /* In "termio.c" */ extern int newmode[2]; /* In "termio.c" */ extern short iochan; /* In "termio.c" */ #endif #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC #include #endif #if UNIX_7 || UNIX_V /* extern void sleep(int); */ #include #include #endif /* ========================================================================= * COMPILE CLIPS RULES FUNCTIONS * ========================================================================= */ #define MAX_COMPILE_LINE 161 static int cur_col; static long region_size; static LINE *linep; static int loffs; static int CompileSuccess = 1; static char CompileLine[MAX_COMPILE_LINE]; static int CompileLineIndex = 0; /********************************************************/ /* compile a region of a file */ /********************************************************/ #if IBM_TBC #pragma argsused #endif globle int compile_region( void *theEnv, int f, int n) { register int s; REGION region; if (curbp == CompileBufferp) { mlwrite("Cannot compile this region!"); return(0); } cur_col = 20; /* Mark the region */ if (( s = getregion(®ion)) != TRUE) return(s); if ((lastflag&CFKILL) == 0) kdelete(theEnv); thisflag |= CFKILL; linep = region.r_linep; loffs = region.r_offset; region_size = region.r_size; if (region_size == 0) { mlwrite(" Region is empty "); return(0); } mlwrite("Compiling Region..."); /* Create IO router for the region (CLIPS.C) */ EnvAddRouter(theEnv,"emacs_region",90,region_fnd, NULL,region_getc,region_ungetc,NULL); /* COMPILE */ if (get_compile(theEnv,"emacs_region","Emacs_region") == 0) mlwrite("Error while forming compilation buffer!"); else mlwrite("Compilation done."); return (TRUE); } /***************************************************** * This function will compile a file form emacs * *****************************************************/ #if IBM_TBC #pragma argsused #endif globle int compile_file( void *theEnv, int f, int n) { if (curbp == CompileBufferp) { mlwrite("Cannot compile this buffer!"); return(0); } cur_col = 27; mlwrite("Compiling Current Buffer..."); linep = lforw(curbp->b_linep); loffs = 0; /* Create a IO router for the file (CLIPS.C) */ EnvAddRouter(theEnv,"emacs_file",90,buffer_fnd, NULL,buffer_getc,buffer_ungetc,NULL); /* COMPILE */ if (get_compile(theEnv,"emacs_file","Emacs_buffer") == 0) mlwrite("Error while forming compilation buffer!"); else mlwrite("Compilation done."); return (TRUE); } /********************************************************** * Compiles the whole buffer or just a region of a buffer* **********************************************************/ globle int get_compile( void *theEnv, char *str1, char *str2) { #if (! RUN_TIME) && (! BLOAD_ONLY) register WINDOW *wp; register BUFFER *bp; CompileSuccess = 1; CompileBufferp->b_flag &= ~BFCHG; /* Don't complain! */ if (bclear(theEnv,CompileBufferp) != TRUE) /* Blow old text away */ return (0); CompileLineIndex = 0; CompileLine[0] = '\0'; EnvActivateRouter(theEnv,str1); EnvActivateRouter(theEnv,"cmp_router"); SetPrintWhileLoading(theEnv,TRUE); LoadConstructsFromLogicalName(theEnv,str2); DestroyPPBuffer(theEnv); /* Flush last diagnostic line (if any) to buffer */ if (CompileLineIndex != 0) addline(theEnv,CompileBufferp,CompileLine); EnvDeactivateRouter(theEnv,str1); EnvDeactivateRouter(theEnv,"cmp_router"); SetPrintWhileLoading(theEnv,FALSE); EnvDeleteRouter(theEnv,str1); strcpy(CompileBufferp->b_fname, ""); if (CompileBufferp->b_nwnd == 0) { /* Not on screen yet. */ if ((wp=wpopup(theEnv)) == NULL) return (0); bp = wp->w_bufp; if (--bp->b_nwnd == 0) { bp->b_dotp = wp->w_dotp; bp->b_doto = wp->w_doto; bp->b_markp = wp->w_markp; bp->b_marko = wp->w_marko; } wp->w_bufp = CompileBufferp; ++CompileBufferp->b_nwnd; } wp = wheadp; while (wp != NULL) { if (wp->w_bufp == CompileBufferp) { wp->w_linep = lforw(CompileBufferp->b_linep); wp->w_dotp = lforw(CompileBufferp->b_linep); wp->w_doto = 0; wp->w_markp = NULL; wp->w_marko = 0; wp->w_flag |= WFMODE|WFHARD; } wp = wp->w_wndp; } return(CompileSuccess); #else return(0); #endif } /**************************************************************** * This function will compare the logical name with names in * * the IO Router list * ****************************************************************/ globle int region_fnd( void *theEnv, char *log_name) { if (strcmp("Emacs_region",log_name)== 0) { return(TRUE); } return(FALSE); } /**************************************************************** * This function will return a character from the file which * * is referenced by the logical name * ****************************************************************/ #if IBM_TBC #pragma argsused #endif globle int region_getc( void *theEnv, char *log_name) { int c; if (region_size <= 0) /* If end of region then EXIT */ return(EOF); if (loffs == llength(linep)) /* End of line */ { c = '\n'; /* go to next line */ linep = lforw(linep); loffs = 0; } else c = lgetc(linep,loffs++); /* If everything is OK then get a character from the file */ region_size--; return(c); } /******************************************************* * This function will move the cursor back one charater* *******************************************************/ #if IBM_TBC #pragma argsused #endif globle int region_ungetc( void *theEnv, int c, char *log_name) { if (c == EOF) return(1); if (loffs <= 0) { linep = lback(linep); loffs = llength(linep); } else loffs--; region_size++; return(1); } /************************************************************** * this function will search through the IO router list and * * find a name that matches with the logical name,which * * represents the buffer to be compiled . * **************************************************************/ globle int buffer_fnd( void *theEnv, char *log_name) { if(strcmp("Emacs_buffer",log_name)== 0) return(TRUE); return(FALSE); } /**************************************************************** * This function will return a character from the file which * * is referred by the logical name * ****************************************************************/ #if IBM_TBC #pragma argsused #endif globle int buffer_getc( void *theEnv, char *log_name) { int c; if (linep == curbp->b_linep) /* End of file */ return(EOF); if (loffs == llength(linep)) /* End of line */ { linep = lforw(linep); /* Move to next line */ if (linep == curbp->b_linep) /* and if end of file then exit */ return(EOF); /* else reset the cursor */ loffs = 0; c = '\n'; } else c = lgetc(linep,loffs++); /* if everything is OK then get a character from the file */ return(c); } /************************************************************* * this function will move the cursor back to one character * *************************************************************/ #if IBM_TBC #pragma argsused #endif globle int buffer_ungetc( void *theEnv, int c, char *logical_name) { if (c == EOF) return(1); if (loffs == 0) { linep = lback(linep); loffs = llength(linep); } else loffs--; return(1); } globle int query_cmp( void *theEnv, char *logName) { if((strcmp(logName,"wdialog") == 0) || (strcmp(logName,"wtrace") == 0) || (strcmp(logName,"wwarning") == 0) || (strcmp(logName,"werror") == 0)) return(TRUE); else return(FALSE); } globle int print_cmp( void *theEnv, char *logName, char *str) { register int i; if (CompileSuccess == 0) return(1); for (i = 0 ; str[i] != '\0' ; i++) { if ((str[i] == '\n') || (str[i] == '\r')) { addline(theEnv,CompileBufferp,CompileLine); CompileLineIndex = 0; CompileLine[0] = '\0'; } else if (CompileLineIndex < (MAX_COMPILE_LINE-1)) { CompileLine[CompileLineIndex++] = str[i]; CompileLine[CompileLineIndex] = '\0'; } else { addline(theEnv,CompileBufferp,CompileLine); CompileLineIndex = 1; CompileLine[0] = str[i]; CompileLine[1] = '\0'; } } return(1); } globle void init_cmp_router( void *theEnv) { EnvAddRouter(theEnv,"cmp_router", 20, query_cmp, print_cmp, NULL, NULL, NULL ); } globle void kill_cmp_router( void *theEnv) { EnvDeleteRouter(theEnv,"cmp_router"); } /* ========================================================================= * MISC FUNCTIONS * ========================================================================= */ /* * Set fill column to n. */ #if IBM_TBC #pragma argsused #endif globle int setfillcol( void *theEnv, int f, int n) { fillcol = n; return(TRUE); } /* * Display the current position of the cursor; the current * column, the current line and the total number of lines in the file. * Bound to "C-X =". CJC, 8-1-86 */ #if IBM_TBC #pragma argsused #endif globle int showcpos( void *theEnv, int f, int n) { register int cline; register int col; register int tline; col = getccol(FALSE); /* Get real column. */ cline = getcline(); /* Get real line # */ tline = cntlines(); /* Get total # lines */ mlwrite("MicroEMACS Version %s col: %d line: %d of %d" ,VERSION_NUM, col+1, cline, tline); return (TRUE); } /* * Return current column. Stop at first non-blank given TRUE argument. */ globle int getccol( int bflg) { register int c, i, col; col = 0; for (i=0; i< curwp->w_doto; ++i) { c = lgetc(curwp->w_dotp, i); if (c!=' ' && c!='\t' && bflg) break; if (c == '\t') col |= 0x07; else if (c<0x20 || c==0x7F) ++col; ++col; } return(col); } /* * Return current line number in file */ globle int getcline() { int i; struct LINE *clp; i = 0; clp = curbp->b_linep; while(clp != curwp->w_dotp) { i++; clp = lforw(clp); } if (i == 0) return(cntlines()); return(i); } /* * Return total number of lines in file */ globle int cntlines() { int i; struct LINE *clp; i = 1; clp = lforw(curbp->b_linep); while( clp != curbp->b_linep) { i++; clp = lforw(clp); } return(i); } /* * Go to a specified line number */ #if IBM_TBC #pragma argsused #endif globle int gotoline( void *theEnv, int f, int n) { register int line; char buf[5]; register int i; register int s; struct LINE *clp; if ((s=mlreply(theEnv,"Goto line: ", buf, 5)) != TRUE) return (s); if((line = atoi(buf)) <= 0) { mlwrite("Invalid line number!"); return(FALSE); } else if(line > cntlines()) { mlwrite("Not that many lines in buffer!"); return(FALSE); } i = 0; clp = lforw(curbp->b_linep); while(i < line - 1) { i++; clp = lforw(clp); } curwp->w_dotp = clp; curwp->w_doto = 0; curwp->w_flag |= WFMOVE; return (TRUE); } /* * Twiddle the two characters on either side of dot. If dot is at the end of * the line twiddle the two characters before it. Return with an error if dot * is at the beginning of line; it seems to be a bit pointless to make this * work. This fixes up a very common typo with a single stroke. Normally bound * to "C-T". This always works within a line, so "WFEDIT" is good enough. */ #if IBM_TBC #pragma argsused #endif globle int twiddle( void *theEnv, int f, int n) { register LINE *dotp; register int doto; register int cl; register int cr; dotp = curwp->w_dotp; doto = curwp->w_doto; if (doto==llength(dotp) && --doto<0) return (FALSE); cr = lgetc(dotp, doto); if (--doto < 0) return (FALSE); cl = lgetc(dotp, doto); lputc(dotp, doto+0, cr); lputc(dotp, doto+1, cl); lchange(WFEDIT); return (TRUE); } /* * Quote the next character, and insert it into the buffer. All the characters * are taken literally, with the exception of the newline, which always has * its line splitting meaning. The character is always read, even if it is * inserted 0 times, for regularity. Bound to "M-Q" (for me) and "C-Q" (for * Rich, and only on terminals that don't need XON-XOFF). */ #if IBM_TBC #pragma argsused #endif globle int quote( void *theEnv, int f, int n) { register int s; register int c; c = (*term.t_getchar)(); if (n < 0) return (FALSE); if (n == 0) return (TRUE); if (c == '\n') { do { s = lnewline(theEnv); } while (s==TRUE && --n); return (s); } return (linsert(theEnv,n, c)); } /* * Set tab size if given non-default argument (n <> 1). Otherwise, insert a * tab into file. If given argument, n, of zero, change to true tabs. * If n > 1, simulate tab stop every n-characters using spaces. This has to be * done in this slightly funny way because the tab (in ASCII) has been turned * into "C-I" (in 10 bit code) already. Bound to "C-I". */ #if IBM_TBC #pragma argsused #endif globle int tab( void *theEnv, int f, int n) { if (n < 0) return (FALSE); if (n == 0 || n > 1) { tabsize = n; return(TRUE); } if (! tabsize) return(linsert(theEnv,1, '\t')); return(linsert(theEnv,tabsize - (getccol(FALSE) % tabsize), ' ')); } /* * Open up some blank space. The basic plan is to insert a bunch of newlines, * and then back up over them. Everything is done by the subcommand * procerssors. They even handle the looping. Normally this is bound to "C-O". */ #if IBM_TBC #pragma argsused #endif globle int openline( void *theEnv, int f, int n) { register int i; register int s; if (n < 0) return (FALSE); if (n == 0) return (TRUE); i = n; /* Insert newlines. */ do { s = lnewline(theEnv); } while (s==TRUE && --i); if (s == TRUE) /* Then back up overtop */ s = backchar(theEnv,f, n); /* of them all. */ return (s); } /* * Insert a newline. Bound to "C-M". If you are at the end of the line and the * next line is a blank line, just move into the blank line. This makes "C-O" * and "C-X C-O" work nicely, and reduces the ammount of screen update that * has to be done. This would not be as critical if screen update were a lot * more efficient. */ #if IBM_TBC #pragma argsused #endif globle int newline( void *theEnv, int f, int n) { register LINE *lp; register int s; if (n < 0) return (FALSE); while (n--) { lp = curwp->w_dotp; if (llength(lp) == curwp->w_doto && lp != curbp->b_linep && llength(lforw(lp)) == 0) { if ((s=forwchar(theEnv,FALSE, 1)) != TRUE) return (s); } else if ((s=lnewline(theEnv)) != TRUE) return (s); } return (TRUE); } /* * Delete blank lines around dot. What this command does depends if dot is * sitting on a blank line. If dot is sitting on a blank line, this command * deletes all the blank lines above and below the current line. If it is * sitting on a non blank line then it deletes all of the blank lines after * the line. Normally this command is bound to "C-X C-O". Any argument is * ignored. */ #if IBM_TBC #pragma argsused #endif globle int deblank( void *theEnv, int f, int n) { register LINE *lp1; register LINE *lp2; long nld; lp1 = curwp->w_dotp; while (llength(lp1)==0 && (lp2=lback(lp1))!=curbp->b_linep) lp1 = lp2; lp2 = lp1; nld = 0; while ((lp2=lforw(lp2))!=curbp->b_linep && llength(lp2)==0) ++nld; if (nld == 0) return (TRUE); curwp->w_dotp = lforw(lp1); curwp->w_doto = 0; return (ldelete(theEnv,nld,FALSE)); } /* * Insert a newline, then enough tabs and spaces to duplicate the indentation * of the previous line. Assumes tabs are every eight characters. Quite simple. * Figure out the indentation of the current line. Insert a newline by calling * the standard routine. Insert the indentation by inserting the right number * of tabs and spaces. Return TRUE if all ok. Return FALSE if one of the * subcomands failed. Normally bound to "C-J". */ #if IBM_TBC #pragma argsused #endif globle int indent( void *theEnv, int f, int n) { register int nicol; register int c; register int i; if (n < 0) return (FALSE); while (n--) { nicol = 0; for (i=0; iw_dotp); ++i) { c = lgetc(curwp->w_dotp, i); if (c!=' ' && c!='\t') break; if (c == '\t') nicol |= 0x07; ++nicol; } if (lnewline(theEnv) == FALSE || ((i=nicol/8)!=0 && linsert(theEnv,i, '\t')==FALSE) || ((i=nicol%8)!=0 && linsert(theEnv,i, ' ')==FALSE)) return (FALSE); } return (TRUE); } /* * Delete forward. This is real easy, because the basic delete routine does * all of the work. Watches for negative arguments, and does the right thing. * If any argument is present, it kills rather than deletes, to prevent loss * of text if typed with a big argument. Normally bound to "C-D". */ #if IBM_TBC #pragma argsused #endif globle int forwdel( void *theEnv, int f, int n) { if (n < 0) return (backdel(theEnv,f, -n)); if (f != FALSE) { /* Really a kill. */ if ((lastflag&CFKILL) == 0) kdelete(theEnv); thisflag |= CFKILL; } return (ldelete(theEnv,(long) n, f)); } /* * Delete backwards. This is quite easy too, because it's all done with other * functions. Just move the cursor back, and delete forwards. Like delete * forward, this actually does a kill if presented with an argument. Bound to * both "RUBOUT" and "C-H". */ #if IBM_TBC #pragma argsused #endif globle int backdel( void *theEnv, int f, int n) { register int s; if (n < 0) return (forwdel(theEnv,f, -n)); if (f != FALSE) { /* Really a kill. */ if ((lastflag&CFKILL) == 0) kdelete(theEnv); thisflag |= CFKILL; } if ((s=backchar(theEnv,f, n)) == TRUE) s = ldelete(theEnv,(long) n, f); return (s); } /* * Kill text. If called without an argument, it kills from dot to the end of * the line, unless it is at the end of the line, when it kills the newline. * If called with an argument of 0, it kills from the start of the line to dot. * If called with a positive argument, it kills from dot forward over that * number of newlines. If called with a negative argument it kills backwards * that number of newlines. Normally bound to "C-K". */ #if IBM_TBC #pragma argsused #endif globle int kill_fwd( void *theEnv, int f, int n) { register int chunk; register LINE *nextp; if ((lastflag&CFKILL) == 0) /* Clear kill buffer if */ kdelete(theEnv); /* last wasn't a kill. */ thisflag |= CFKILL; if (f == FALSE) { chunk = llength(curwp->w_dotp)-curwp->w_doto; if (chunk == 0) chunk = 1; } else if (n == 0) { chunk = curwp->w_doto; curwp->w_doto = 0; } else if (n > 0) { chunk = llength(curwp->w_dotp)-curwp->w_doto+1; nextp = lforw(curwp->w_dotp); while (--n) { if (nextp == curbp->b_linep) return (FALSE); chunk += llength(nextp)+1; nextp = lforw(nextp); } } else { mlwrite("neg kill"); return (FALSE); } return (ldelete(theEnv,(long) chunk, TRUE)); } /* * Yank text back from the kill buffer. This is really easy. All of the work * is done by the standard insert routines. All you do is run the loop, and * check for errors. Bound to "C-Y". The blank lines are inserted with a call * to "newline" instead of a call to "lnewline" so that the magic stuff that * happens when you type a carriage return also happens when a carriage return * is yanked back from the kill buffer. */ #if IBM_TBC #pragma argsused #endif globle int yank( void *theEnv, int f, int n) { register int c; register int i; if (n < 0) return (FALSE); while (n--) { i = 0; while ((c=kremove(i)) >= 0) { if (c == '\n') { if (newline(theEnv,FALSE, 1) == FALSE) return (FALSE); } else { if (linsert(theEnv,1, c) == FALSE) return (FALSE); } ++i; } } return (TRUE); } /* ========================================================================= * SEARCH FUNCTIONS * ========================================================================= */ /* * The functions in this section implement commands that search in the forward * and backward directions. There are no special characters in the search * strings. Probably should have a regular expression search, or something * like that. * * They also implement commands that do the followings * - Replaces all the occurences of a string, * from the current point of cursor to the end of file, * with a new string. * - search for matching bracket * * REVISION HISTORY: * * ? Steve Wilhite, 1-Dec-85 * - massive cleanup on code. * * Huyen_Anh Vu Ly, 16-Dec-86 * - extending the capability of Emacs included the followings: * -*- backward search and replace all the occurences of a string, * C-X R. * -*- backward search and replace some of te occurences of a string, * M-R. * -*- forward search and replace all the occurences of a string, * C-X S. * -*- forward search and replace some occurences of a string, * M-S. * -*- find the matching bracket for : (,),[,],{,}, * C-X M. */ /* * Search forward. Get a search string from the user, and search, beginning at * ".", for the string. If found, reset the "." to be just after the match * string, and [perhaps] repaint the display. Bound to "C-S". */ #if IBM_TBC #pragma argsused #endif globle int forwsearch( void *theEnv, int f, int n) { register LINE *clp; register int cbo; register LINE*tlp; register int tbo; register int c; register char *pp; register int s; if ((s = readpattern(theEnv,"Search")) != TRUE) return (s); clp = curwp->w_dotp; cbo = curwp->w_doto; while (clp != curbp->b_linep) { if (cbo == llength(clp)) { clp = lforw(clp); cbo = 0; c = '\n'; } else c = lgetc(clp, cbo++); if (c == pat[0]) { tlp = clp; tbo = cbo; pp = &pat[1]; while (*pp != 0) { if (tlp == curbp->b_linep) goto fail; if (tbo == llength(tlp)) { tlp = lforw(tlp); tbo = 0; c = '\n'; } else c = lgetc(tlp, tbo++); if (c != *pp++) goto fail; } curwp->w_dotp = tlp; curwp->w_doto = tbo; curwp->w_flag |= WFMOVE; return (TRUE); } fail:; } mlwrite("Not found"); return (FALSE); } /* * Reverse search. Get a search string from the user, and search, starting at * "." and proceeding toward the front of the buffer. If found "." is left * pointing at the first character of the pattern [the last character that was * matched. Bound to "C-R". */ #if IBM_TBC #pragma argsused #endif globle int backsearch( void *theEnv, int f, int n) { register LINE *clp; register int cbo; register LINE *tlp; register int tbo; register int c; register char *epp; register char *pp; register int s; if ((s = readpattern(theEnv,"Reverse search")) != TRUE) return (s); for (epp = &pat[0]; epp[1] != 0; ++epp) ; clp = curwp->w_dotp; cbo = curwp->w_doto; for (;;) { if (cbo == 0) { clp = lback(clp); if (clp == curbp->b_linep) { mlwrite("Not found"); return (FALSE); } cbo = llength(clp)+1; } if (--cbo == llength(clp)) c = '\n'; else c = lgetc(clp, cbo); if (c == *epp) { tlp = clp; tbo = cbo; pp = epp; while (pp != &pat[0]) { if (tbo == 0) { tlp = lback(tlp); if (tlp == curbp->b_linep) goto fail; tbo = llength(tlp)+1; } if (--tbo == llength(tlp)) c = '\n'; else c = lgetc(tlp, tbo); if (c != *--pp) goto fail; } curwp->w_dotp = tlp; curwp->w_doto = tbo; curwp->w_flag |= WFMOVE; return (TRUE); } fail:; } } /******************************************************** * This function will search backward through the file* * and replace all occurences of an old string by a * * new string. * ********************************************************/ #if IBM_TBC #pragma argsused #endif globle int bkwrdrpl( void *theEnv, int f, int n) { LINE *clp; int cbo; LINE *tlp; int tbo; int c,count = 0; char *epp,buf[40]; char *pp; char *pat2; int s; if ((s = readpattern(theEnv,"Rev. replace all occrs of")) != TRUE) return (s); pat2 = (char *) genalloc(theEnv,(unsigned) strlen (pat) + 1); /* Pat2 is first pattern */ strcpy(pat2,pat); if((s = mlreply(theEnv,"Replace with: ",pat,NPAT)) == ABORT) { genfree(theEnv,(void *) pat2, (unsigned) strlen(pat) + 1); return(s); } for (epp = &pat2[0];epp[1] != 0 ; ++epp); clp = curwp->w_dotp; cbo = curwp->w_doto; if (clp == curbp->b_linep) { clp = lback(clp); cbo = llength(clp) + 1; } while(clp != curbp->b_linep) { if (cbo <= 0) { clp = lback(clp); if (clp != curbp->b_linep) cbo = llength(clp) + 1; } if (clp == curbp->b_linep) break; if (--cbo == llength(clp)) c = '\n'; else c = lgetc(clp,cbo); if(c == *epp) { tbo = cbo; tlp = clp; pp = epp; while(pp != pat2) { if (tbo <= 0) { tlp = lback(tlp); if (tlp != curbp->b_linep) tbo = llength(tlp) + 1; } if ( tlp == curbp->b_linep) break; if(--tbo == llength(tlp)) c = '\n'; else c = lgetc(tlp,tbo); if (c != *--pp) break; } if ((pp == pat2)&&(c == *pp)) { curwp->w_dotp = clp; curwp->w_doto = tbo; count++; lreplace(theEnv,pat2); clp = curwp->w_dotp; cbo = curwp->w_doto - strlen(pat); } } } curwp->w_doto -= strlen(pat); curwp->w_flag |= WFMOVE; update(); sprintf(buf," %d Replacement[s] ",count); mlwrite(buf); return(TRUE); } /******************************************************************** * This function will search backward for the occurences of an old * * string and replace some of them with a new string. * ********************************************************************/ #if IBM_TBC #pragma argsused #endif globle int bkwrdcr( void *theEnv, int f, int n) { LINE *clp; int cbo; LINE *tlp; int tbo; int c; char *epp,*pp; char *pat2; int s; if ((s = readpattern(theEnv,"Rev. replace some occrs. of")) != TRUE) return (s); pat2 = (char *) genalloc(theEnv,(unsigned) strlen (pat) + 1); strcpy(pat2,pat); if((s = mlreply(theEnv,"Replace with: ",pat,NPAT)) == ABORT) { genfree(theEnv,(void *) pat2,(unsigned) strlen(pat) + 1); return(s); } for (epp = &pat2[0]; epp[1] != 0; ++epp) ; clp = curwp->w_dotp; cbo = curwp->w_doto; if (clp == curbp->b_linep) { clp = lback(clp); cbo = llength(clp) + 1; } while (clp != curbp->b_linep) { if (cbo <= 0) { clp = lback(clp); if (clp != curbp->b_linep) cbo = llength(clp)+1; } if (clp == curbp->b_linep) break; if (--cbo == llength(clp)) c = '\n'; else c = lgetc(clp, cbo); if (c == *epp) { tlp = clp; tbo = cbo; pp = epp; while (pp != &pat2[0]) { if (tbo <= 0) { tlp = lback(tlp); if (tlp != curbp->b_linep) tbo = llength(tlp)+1; } if (tlp == curbp->b_linep) break; if (--tbo == llength(tlp)) c = '\n'; else c = lgetc(tlp, tbo); if (c != *--pp) break; } if ((pp == pat2)&&(c == *pp)) { curwp->w_dotp = clp; curwp->w_doto = tbo; curwp->w_flag |= WFMOVE; /************************************************* * Read a character from standard i/o * * if charater is a blank(comparable to Zmacs) * * or 'y' or 'Y' the replacement will occur. * * Else if character is 'n' or 'N' it will skip * * and go to next occurence of string. * * Else exit the function * *************************************************/ mlwrite("Do you want to replace this? [y/n]"); update(); c = (*term.t_getchar)(); if((c ==' ')||(c == 'y')||(c == 'Y')) { lreplace(theEnv,pat2); clp = curwp->w_dotp; cbo = curwp->w_doto - strlen(pat); } else if ((c == 'n')||(c == 'N')) cbo = tbo; else return(TRUE); } } } curwp->w_flag |= WFMOVE; curwp->w_doto -= strlen(pat); update(); mlwrite("No more occurrences of [%s] in buffer",pat2); genfree(theEnv,(void *) pat2,(unsigned) strlen(pat) + 1); return(TRUE); } /****************************************************** * FORWARD * * Search all the occurences of a string and replace * * with a new string * ******************************************************/ #if IBM_TBC #pragma argsused #endif globle int frwsr( void *theEnv, int f, int n) { LINE *clp,*tlp; int cbo,tbo,c,s,count = 0 ; char *pp,buf[40]; char *pat2; /* Read the string to be replaced */ if((s = readpattern (theEnv,"Replace the occurences of?")) != TRUE) return (s); pat2 = (char *) genalloc (theEnv,(unsigned) strlen(pat) + 1); strcpy (pat2,pat); /* Read the string to replace with */ if((s = mlreply(theEnv,"Replace with: ",pat,NPAT)) == ABORT) { genfree(theEnv,(void *) pat2,(unsigned) strlen(pat) + 1); return(s); } clp = curwp->w_dotp; cbo = curwp->w_doto; while (clp != curbp->b_linep) /* While not eof ,search for string*/ { if(cbo >= llength(clp)) /* if end of line go to new line */ { clp = lforw(clp); cbo = 0; c = '\n'; } else /* else begin to read in a new character */ c = lgetc(clp,cbo++); if (c == pat2[0]) /* and compare it */ { /* to the string to be replaced */ tlp = clp; tbo = cbo; pp = &pat2[1]; while (*pp) { if(tlp == curbp->b_linep) break; if(tbo >= llength(tlp)) { tlp = lforw(tlp); tbo = 0; c = '\n'; } else c = lgetc(tlp,tbo++); if(c != *pp) break; pp++; } if(!(*pp)) /* if string is found replace it with new string */ { curwp->w_dotp = clp; curwp->w_doto = cbo - 1; count++; lreplace(theEnv,pat2); clp = curwp->w_dotp; cbo = curwp->w_doto; } } } curwp->w_doto -= strlen(pat); curwp->w_flag |= WFMOVE; update(); sprintf(buf,"%d replacement[s]",count); mlwrite(buf); return(TRUE); } /*************************************************** * Search all the occurences of a string and * * replace some of them * ***************************************************/ #if IBM_TBC #pragma argsused #endif globle int querysr( void *theEnv, int f, int n) { LINE *clp,*tlp; int cbo,tbo,c,s; char *pp; char *pat2; /* Read the string to be replaced */ if((s = readpattern (theEnv,"Query_replace ?")) != TRUE) return (s); pat2 = (char *) genalloc(theEnv,(unsigned) strlen(pat) + 1); strcpy (pat2,pat); /* Read the string to replace with */ if((s = mlreply(theEnv,"Replace with: ",pat,NPAT)) == ABORT) { genfree(theEnv,(void *) pat2,(unsigned) strlen(pat) + 1); return(s); } clp = curwp->w_dotp; cbo = curwp->w_doto; while (clp != curbp->b_linep) /* While not eof ,search for string*/ { if(cbo >= llength(clp)) /* if end of line go to new line */ { clp = lforw(clp); cbo = 0; c = '\n'; } else /* else begin to read in a new character */ c = lgetc(clp,cbo++); if (c == pat2[0]) /* and compare it */ { /* to the string to be replaced */ tlp = clp; tbo = cbo; pp = &pat2[1]; while (*pp) { if(tlp == curbp->b_linep) break; if(tbo >= llength(tlp)) { tlp = lforw(tlp); tbo = 0; c = '\n'; } else c = lgetc(tlp,tbo++); if(c != *pp) break; pp++; } if(!(*pp)) /* if string is found */ { curwp->w_dotp = clp; curwp->w_doto = cbo - 1; curwp->w_flag |= WFMOVE; /************************************************* * Read a character from standard i/o * * if charater is a blank(comparable to Zmacs) * * or 'y' or 'Y' the replacement will occur. * * Else if character is 'n' or 'N' it will skip * * and go to next occurence of string. * * Else exit the function * *************************************************/ mlwrite("Do you want to replace this? [y/n]"); update(); c = (*term.t_getchar)(); if((c ==' ')||(c == 'y')||(c == 'Y')) { lreplace(theEnv,pat2); clp = curwp->w_dotp; cbo = curwp->w_doto; } else if ((c == 'n')||(c == 'N')) cbo = tbo; else return(TRUE); } } } curwp->w_flag |= WFMOVE; curwp->w_doto -= strlen(pat); update(); mlwrite("No more occurrences of [%s] in buffer",pat2); genfree(theEnv,(void *) pat2,(unsigned) strlen(pat) + 1); return(TRUE); } /*************************************************** * Replace old string with new string * ***************************************************/ globle int lreplace( void *theEnv, char *pat2) { int doto; unsigned i; char *cp1,*cp2; LINE *lp1,*lp2; WINDOW *wp; lchange(WFEDIT); lp1 = curwp->w_dotp; doto = curwp->w_doto; if((lp2 =lalloc(theEnv,(int) (lp1->l_used - strlen(pat2) + strlen(pat) ))) == NULL) return(FALSE); cp1 = &lp1->l_text[0]; cp2 = &lp2->l_text[0]; /* Copy first part of line which is containing old string to new line */ while(cp1 != &lp1->l_text[doto]) *cp2++ = *cp1++; /* reseve space for new string in new line */ cp2 += strlen(pat); cp1 += strlen(pat2); /* Copy third part of line which is containing old string to new line */ while (cp1 != &lp1->l_text[lp1->l_used]) *cp2++ = *cp1++; *cp2 = *cp1; /* Rearrange pointer, insert new line and delete old line */ lp1->l_bp->l_fp = lp2; lp2->l_fp = lp1->l_fp; lp1->l_fp->l_bp = lp2; lp2->l_bp = lp1->l_bp; /* copy the new string in to new line */ for(i=0;il_text[doto + i] = pat[i]; /* Up-date current pointers and values */ curwp->w_doto += strlen(pat2); wp = wheadp; while (wp != NULL) { if (wp->w_linep == lp1) wp->w_linep = lp2; if(wp->w_dotp == lp1) wp->w_dotp = lp2; if (wp == curwp) wp->w_doto += (strlen(pat) - strlen(pat2)); if(wp->w_markp ==lp1) { wp->w_markp = lp2; wp->w_marko += (strlen(pat) - strlen(pat2)); } wp = wp->w_wndp; } genfree(theEnv,(void *) lp1,(unsigned) sizeof(LINE) + lp1->l_size); return(TRUE); } /******************************************************** * This function will search for the matching bracket * * of any bracket * * It is currently bounded to C-X-^ * ********************************************************/ #if IBM_TBC #pragma argsused #endif globle int smatchb( void *theEnv, int f, int n) { int cbo,c; LINE *clp; clp = curwp->w_dotp; cbo = curwp->w_doto; c = lgetc(clp,cbo); if((c == '{')||(c == '(')||(c=='[')) { /* search forward for matched closing bracket '}' */ if(searchcl(c) == FALSE) return(FALSE); } else if((c == '}')||(c == ')')||(c == ']')) { /* search backward for matched opening bracket '{'*/ if(searchop(c) == FALSE) return(FALSE); } else return(FALSE); curwp->w_flag |= WFMOVE; return(TRUE); } /*************************************************** * This function will search for closing bracket, * * including '}' , ')' , ']' * *************************************************** * The mechanism of this function is it will check * * every character of the file from the current * * position down and increase i by 1 every time it * * find an openning bracket and decrease i by 1 * * every time it find a closing bracket.When i = 0 * * the matching bracket is found. * ***************************************************/ globle int searchcl( int tempch) { LINE *lp; int tbo,c,i=1; lp = curwp->w_dotp; tbo = curwp->w_doto + 1; while(i > 0) { if(lp == curbp->b_linep) { mlwrite("Matched bracket is not found"); return(FALSE); } if(tbo== llength(lp)) { lp = lforw(lp); tbo = 0; c = '\n'; } else c = lgetc(lp,tbo++); switch(tempch) { case '{': if (c == '{') i++; else if (c =='}') i--; break; case '(': if (c == '(') i++; else if (c ==')') i--; break; case '[': if (c == '[') i++; else if (c ==']') i--; break; } } curwp->w_dotp = lp; curwp->w_doto = tbo - 1; return(TRUE); } /************************************************************** * This function will search backward for the opening bracket,* * including '{' , '(' , '[' . * ************************************************************** * The mechanism of this function is similiar to the searchcl,* * except that it will go through the file backward * **************************************************************/ globle int searchop( int tempch) { LINE *lp; int tbo,c,i=1; lp = curwp->w_dotp; tbo = curwp->w_doto; while(i>0) { if(tbo == 0) { lp = lback(lp); if(lp == curbp->b_linep) { mlwrite("matched bracket is not found"); return(FALSE); } tbo = llength(lp) + 1; } if(--tbo == llength(lp)) c = '\n'; else c = lgetc(lp,tbo); switch(tempch) { case '}': if(c == '}') i++; else if (c == '{') i--; break; case ')': if (c == ')') i++; else if (c =='(') i--; break; case ']': if (c == ']') i++; else if (c =='[') i--; break; } } curwp->w_dotp = lp; curwp->w_doto = tbo ; return(TRUE); } /* * Read a pattern. Stash it in the external variable "pat". The "pat" is not * updated if the user types in an empty line. If the user typed an empty line, * and there is no old pattern, it is an error. Display the old pattern, in the * style of Jeff Lomicka. There is some do-it-yourself control expansion. */ globle int readpattern( void *theEnv, char *prompt) { register char *cp1; register char *cp2; register int c; register int s; char tpat[NPAT+20]; cp1 = &tpat[0]; /* Copy prompt */ cp2 = prompt; while ((c = *cp2++) != '\0') *cp1++ = (char) c; if (pat[0] != '\0') /* Old pattern */ { *cp1++ = ' '; *cp1++ = '['; cp2 = &pat[0]; while ((c = *cp2++) != 0) { if (cp1 < &tpat[NPAT+20-6]) /* "??]: \0" */ { if (c<0x20 || c==0x7F) { *cp1++ = '^'; c ^= 0x40; } else if (c == '%') /* Map "%" to */ *cp1++ = (char) c; /* "%%". */ *cp1++ = (char) c; } } *cp1++ = ']'; } *cp1++ = ':'; /* Finish prompt */ *cp1++ = ' '; *cp1++ = '\0'; s = mlreply(theEnv,tpat, tpat, NPAT); /* Read pattern */ if (s == TRUE) /* Specified */ strcpy(pat, tpat); else if (s == FALSE && pat[0] != 0) /* CR, but old one */ s = TRUE; return (s); } /* ========================================================================= * SPAWN FUNCTIONS * ========================================================================= */ /* * The routines in this section are called to create a subjob running a * command interpreter. */ /* * Create a subjob with a copy of the command intrepreter in it. When the * command interpreter exits, mark the screen as garbage so that you do a full * repaint. Bound to "C-C". The message at the start in VMS puts out a newline. * Under some (unknown) condition, you don't get one free when DCL starts up. */ #if IBM_TBC #pragma argsused #endif globle int spawncli( void *theEnv, int f, int n) { #if UNIX_7 || UNIX_V || IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC register char *cp; #endif #if VAX_VMS movecursor(term.t_nrow, 0); /* In last line. */ mlputs("[Starting DCL]\r\n"); (*term.t_flush)(); /* Ignore "ttcol". */ sgarbf = TRUE; return (sys(NULL)); /* NULL => DCL. */ #endif #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC cp = getenv("COMSPEC"); if (cp == NULL) return(TRUE); movecursor(term.t_nrow, 0); /* Seek to last line. */ (*term.t_flush)(); system(cp); /* Run CLI. */ sgarbf = TRUE; return(TRUE); #endif #if UNIX_7 || UNIX_V movecursor(term.t_nrow, 0); /* Seek to last line. */ (*term.t_flush)(); ttclose(); /* stty to old settings */ if ((cp = getenv("SHELL")) != NULL && *cp != '\0') system(cp); else system("exec /bin/sh"); sgarbf = TRUE; sleep(2); ttopen(); return(TRUE); #endif } /* * Run a one-liner in a subjob. When the command returns, wait for a single * character to be typed, then mark the screen as garbage so a full repaint is * done. Bound to "C-X !". */ #if IBM_TBC #pragma argsused #endif globle int spawn( void *theEnv, int f, int n) { register int s; char line[NLINE]; #if VAX_VMS if ((s=mlreply(theEnv,"DCL command: ", line, NLINE)) != TRUE) return (s); (*term.t_putchar)('\n'); /* Already have '\r' */ (*term.t_flush)(); s = sys(line); /* Run the command. */ mlputs("\r\n\n[End]"); /* Pause. */ (*term.t_flush)(); while ((*term.t_getchar)() != '\r') ; sgarbf = TRUE; return (s); #endif #if IBM_MSC || IBM_TBC || IBM_ZTC || IBM_ICB || IBM_SC || IBM_GCC if ((s=mlreply(theEnv,"MS-DOS command: ", line, NLINE)) != TRUE) return (s); system(line); mlwrite("Hit any key to continue"); (*term.t_getchar)(); /* Pause. */ sgarbf = TRUE; return (TRUE); #endif #if UNIX_7 || UNIX_V if ((s=mlreply(theEnv,"! ", line, NLINE)) != TRUE) return (s); (*term.t_putchar)('\n'); /* Already have '\r' */ (*term.t_flush)(); ttclose(); /* stty to old modes */ system(line); sleep(2); ttopen(); mlputs("[End]"); /* Pause. */ (*term.t_flush)(); while ((s = (*term.t_getchar)()) != '\r' && s != ' ') ; sgarbf = TRUE; return (TRUE); #endif } #if VAX_VMS /* * Run a command. The "cmd" is a pointer to a command string, or NULL if you * want to run a copy of DCL in the subjob (this is how the standard routine * LIB$SPAWN works. You have to do wierd stuff with the terminal on the way in * and the way out, because DCL does not want the channel to be in raw mode. */ globle int sys( char *cmd) { struct dsc$descriptor cdsc; struct dsc$descriptor *cdscp; long status; long substatus; long iosb[2]; status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0, oldmode, sizeof(oldmode), 0, 0, 0, 0); if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL) return (FALSE); cdscp = NULL; /* Assume DCL. */ if (cmd != NULL) { /* Build descriptor. */ cdsc.dsc$a_pointer = cmd; cdsc.dsc$w_length = strlen(cmd); cdsc.dsc$b_dtype = DSC$K_DTYPE_T; cdsc.dsc$b_class = DSC$K_CLASS_S; cdscp = &cdsc; } status = LIB$SPAWN(cdscp, 0, 0, 0, 0, 0, &substatus, 0, 0, 0); if (status != SS$_NORMAL) substatus = status; status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0, newmode, sizeof(newmode), 0, 0, 0, 0); if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL) return (FALSE); if ((substatus&STS$M_SUCCESS) == 0) /* Command failed. */ return (FALSE); return (TRUE); } #endif #endif clips-6.24/clipssrc/._factqury.c0000400000175000017500000000075410441602207014736 0ustar jfsjfsMac OS X  2 RTEXTCWIETTFH MonacoNN!"*8*8%wTTFL+FMPSRMWBBLclips-6.24/clipssrc/._genrccom.h0000400000175000017500000000075410441143533014704 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z1,,TTFS FMWBBMPSRclips-6.24/clipssrc/objrtbld.h0000755000175000017500000000305610441073150014504 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* OBJECT PATTERN MATCHER MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /*************************************************************/ #ifndef _H_objrtbld #define _H_objrtbld #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTBLD_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupObjectPatternStuff(void *); #endif #endif clips-6.24/clipssrc/tmpltlhs.h0000755000175000017500000000272407422635011014557 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* DEFTEMPLATE LHS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_tmpltlhs #define _H_tmpltlhs #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_tmpltdef #include "tmpltdef.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _TMPLTLHS_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE struct lhsParseNode *DeftemplateLHSParse(void *,char *,struct deftemplate *); #endif clips-6.24/clipssrc/factbin.h0000755000175000017500000000347607422634767014344 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT BLOAD/BSAVE HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factbin #define _H_factbin #include "factbld.h" #define FACTBIN_DATA 62 struct factBinaryData { struct factPatternNode *FactPatternArray; long NumberOfPatterns; }; #define FactBinaryData(theEnv) ((struct factBinaryData *) GetEnvironmentData(theEnv,FACTBIN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FactBinarySetup(void *); #define BsaveFactPatternIndex(patPtr) ((patPtr == NULL) ? -1L : ((struct factPatternNode *) patPtr)->bsaveID) #define BloadFactPatternPointer(i) ((struct factPatternNode *) ((i == -1L) ? NULL : &FactBinaryData(theEnv)->FactPatternArray[i])) #endif clips-6.24/clipssrc/._objrtgen.c0000400000175000017500000000075410441150405014710 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z;5;;TTFS JFMWBBMPSRclips-6.24/clipssrc/._exprnpsr.h0000400000175000017500000000075410441132046014765 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0zVTTFS FMWBBMPSRclips-6.24/clipssrc/cmptblty.h0000755000175000017500000000777307422634640014566 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* COMPATIBILITY HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Use this file to enable the use of some old */ /* CLIPS macros and functions with version 6.0 of CLIPS. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _CMPTBLTY_HEADER_ #define _CMPTBLTY_HEADER_ #include "clips.h" #define DeleteDefrule(x) Undefrule(x) #define DeleteDeftemplate(x) Undeftemplate(x) #define DeleteDeffacts(x) Undeffacts(x) #define DeleteDefclass(c) Undefclass(c) #define DeleteDefinstances(d) Undefinstances(d) #define DeleteDefmessageHandler(c,h) UndefmessageHandler(c,h) #define DeleteDeffunction(d) Undeffunction(d) #define DeleteDefgeneric(g) Undefgeneric(g) #define DeleteDefmethod(g,m) Undefmethod(g,m) #define ListFacts() Facts(WDISPLAY,GetCurrentModule(),-1L,-1L,-1L) #define ListInstances(c,i) Instances(WDISPLAY,GetCurrentModule(),GetDefclassName(c),i) #define ResetCLIPS() Reset() #define LoadConstructs(x) Load(x) #define SaveConstructs(x) Save(x) #define ClearCLIPS() Clear() #define RunCLIPS(x) Run(x) #define OpenDribble(x) DribbleOn(x) #define CloseDribble() DribbleOff() #define AddFact(x) Assert(x) #define RetractFact(x) Retract(x) #define ListAgenda() Agenda(WDISPLAY,GetCurrentModule()) #define ListMatches(x) Matches(x) #define AddBreakpoint(x) SetBreak(x) #define RemoveBreakpoint(x) RemoveBreak(x) #define ListBreakpoints() ShowBreaks(WDISPLAY,GetCurrentModule()) #define RefreshDefrule(x) Refresh(x) #define MemoryUsed() MemUsed() #define MemoryRequests() MemRequests() #define ReleaseMemory() ReleaseMem() #define CLIPSTestSlot(i,s,0) SlotExistP(GetInstanceClass(i),s,TRUE) #define CLIPSTestSlot(i,s,1) TRUE #define CLIPSTestSlot(i,s,2) SlotWritableP(GetInstanceClass(i),s) #define CLIPSTestSlot(i,s,3) SlotInitableP(GetInstanceClass(i),s) #define CLIPSGetSlot(i,s,r) DirectGetSlot(i,s,r) #define CLIPSPutSlot(i,s,v) DirectPutSlot(i,s,r) #define PreviewMessage(c,m) PreviewSend(WDISPLAY,c,m) #define CLIPSSendMessage(d,m,a,r) Send(d,m,a,r) #define CLIPSUnmakeInstance(i) UnmakeInstance(i) #define CLIPSDeleteInstance(i) DeleteInstance(i) #define CLIPSMakeInstance(s) MakeInstance(s) #define BrowseClass(c) BrowseClasses(c) #define IsClassAbstract(c) ClassAbstractP(c) #define GetClassSuperclasses(c,r,i) ClassSuperclasses(c,r,i) #define GetClassSubclasses(c,r,i) ClassSubclasses(c,r,i) #define GetClassSlots(c,r,i) ClassSlots(c,r,i) #define GetClassMessageHandlers(c,r,i) GetDefmessageHandlerList(c,r,i) #define GetSlotFacets(c,s,r) SlotFacets(c,s,r) #define GetSlotSources(c,s,r) SlotSources(c,s,r) #endif clips-6.24/clipssrc/engine.c0000755000175000017500000012332410443656416014161 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* ENGINE MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides functionality primarily associated with */ /* the run and focus commands. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Bebe Ly */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Removed DYNAMIC_SALIENCE, INCREMENTAL_RESET, */ /* and LOGICAL_DEPENDENCIES compilation flags. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /* Added access functions to the HaltRules flag. */ /* */ /* Added EnvGetNextFocus, EnvGetFocusChanged, and */ /* EnvSetFocusChanged functions. */ /* */ /*************************************************************/ #define _ENGINE_SOURCE_ #include #define _STDIO_INCLUDED_ #include #include "setup.h" #if DEFRULE_CONSTRUCT #include "agenda.h" #include "argacces.h" #include "constant.h" #include "envrnmnt.h" #include "factmngr.h" #include "inscom.h" #include "memalloc.h" #include "modulutl.h" #include "prccode.h" #include "prcdrfun.h" #include "proflfun.h" #include "reteutil.h" #include "retract.h" #include "router.h" #include "ruledlt.h" #include "sysdep.h" #include "utility.h" #include "watch.h" #include "engine.h" /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static struct activation *NextActivationToFire(void *); static struct defmodule *RemoveFocus(void *,struct defmodule *); static void DeallocateEngineData(void *); /*****************************************************************************/ /* InitializeEngine: Initializes the activations and statistics watch items. */ /*****************************************************************************/ globle void InitializeEngine( void *theEnv) { AllocateEnvironmentData(theEnv,ENGINE_DATA,sizeof(struct engineData),DeallocateEngineData); EngineData(theEnv)->IncrementalResetFlag = TRUE; #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"statistics",0,&EngineData(theEnv)->WatchStatistics,20,NULL,NULL); AddWatchItem(theEnv,"focus",0,&EngineData(theEnv)->WatchFocus,0,NULL,NULL); #endif } /*************************************************/ /* DeallocateEngineData: Deallocates environment */ /* data for engine functionality. */ /*************************************************/ static void DeallocateEngineData( void *theEnv) { struct focus *tmpPtr, *nextPtr; DeallocateCallList(theEnv,EngineData(theEnv)->ListOfRunFunctions); tmpPtr = EngineData(theEnv)->CurrentFocus; while (tmpPtr != NULL) { nextPtr = tmpPtr->next; rtn_struct(theEnv,focus,tmpPtr); tmpPtr = nextPtr; } } /*************************************************/ /* EnvRun: C access routine for the run command. */ /*************************************************/ globle long int EnvRun( void *theEnv, long int runLimit) { long int rulesFired = 0; DATA_OBJECT result; struct callFunctionItem *theRunFunction; #if DEBUGGING_FUNCTIONS unsigned long maxActivations = 0, sumActivations = 0; #if DEFTEMPLATE_CONSTRUCT unsigned long maxFacts = 0, sumFacts = 0; #endif #if OBJECT_SYSTEM unsigned long maxInstances = 0, sumInstances = 0; #endif double endTime, startTime = 0.0; unsigned long tempValue; #endif unsigned int i; struct patternEntity *theMatchingItem; struct partialMatch *theBasis; ACTIVATION *theActivation; char *ruleFiring; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif /*=====================================================*/ /* Make sure the run command is not already executing. */ /*=====================================================*/ if (EngineData(theEnv)->AlreadyRunning) return(0); EngineData(theEnv)->AlreadyRunning = TRUE; /*================================*/ /* Set up statistics information. */ /*================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchStatistics) { #if DEFTEMPLATE_CONSTRUCT maxFacts = GetNumberOfFacts(theEnv); sumFacts = maxFacts; #endif #if OBJECT_SYSTEM maxInstances = GetGlobalNumberOfInstances(theEnv); sumInstances = maxInstances; #endif maxActivations = GetNumberOfActivations(theEnv); sumActivations = maxActivations; startTime = gentime(); } #endif /*=============================*/ /* Set up execution variables. */ /*=============================*/ if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE); EngineData(theEnv)->HaltRules = FALSE; /*=====================================================*/ /* Fire rules until the agenda is empty, the run limit */ /* has been reached, or a rule execution error occurs. */ /*=====================================================*/ theActivation = NextActivationToFire(theEnv); while ((theActivation != NULL) && (runLimit != 0) && (EvaluationData(theEnv)->HaltExecution == FALSE) && (EngineData(theEnv)->HaltRules == FALSE)) { /*===========================================*/ /* Detach the activation from the agenda and */ /* determine which rule is firing. */ /*===========================================*/ DetachActivation(theEnv,theActivation); ruleFiring = EnvGetActivationName(theEnv,theActivation); theBasis = (struct partialMatch *) GetActivationBasis(theActivation); EngineData(theEnv)->ExecutingRule = (struct defrule *) GetActivationRule(theActivation); /*=============================================*/ /* Update the number of rules that have fired. */ /*=============================================*/ rulesFired++; if (runLimit > 0) { runLimit--; } /*==================================*/ /* If rules are being watched, then */ /* print an information message. */ /*==================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->ExecutingRule->watchFiring) { char printSpace[60]; sprintf(printSpace,"FIRE %4ld ",rulesFired); EnvPrintRouter(theEnv,WTRACE,printSpace); EnvPrintRouter(theEnv,WTRACE,ruleFiring); EnvPrintRouter(theEnv,WTRACE,": "); PrintPartialMatch(theEnv,WTRACE,theBasis); EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*=================================================*/ /* Remove the link between the activation and the */ /* completed match for the rule. Set the busy flag */ /* for the completed match to TRUE (so the match */ /* upon which our RHS variables are dependent is */ /* not deleted while our rule is firing). Set up */ /* the global pointers to the completed match for */ /* routines which do variable extractions. */ /*=================================================*/ theBasis->binds[theBasis->bcount].gm.theValue = NULL; theBasis->busy = TRUE; EngineData(theEnv)->GlobalLHSBinds = theBasis; EngineData(theEnv)->GlobalRHSBinds = NULL; /*===================================================================*/ /* Increment the count for each of the facts/objects associated with */ /* the rule activation so that the facts/objects cannot be deleted */ /* by garbage collection while the rule is executing. */ /*===================================================================*/ for (i = 0; i < theBasis->bcount; i++) { theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem; if (theMatchingItem != NULL) { (*theMatchingItem->theInfo->incrementBasisCount)(theEnv,theMatchingItem); } } /*====================================================*/ /* Execute the rule's right hand side actions. If the */ /* rule has logical CEs, set up the pointer to the */ /* rules logical join so the assert command will */ /* attach the appropriate dependencies to the facts. */ /*====================================================*/ EngineData(theEnv)->TheLogicalJoin = EngineData(theEnv)->ExecutingRule->logicalJoin; EvaluationData(theEnv)->CurrentEvaluationDepth++; SetEvaluationError(theEnv,FALSE); EngineData(theEnv)->ExecutingRule->executing = TRUE; #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &EngineData(theEnv)->ExecutingRule->header.usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,EngineData(theEnv)->ExecutingRule->header.whichModule->theModule, EngineData(theEnv)->ExecutingRule->actions,EngineData(theEnv)->ExecutingRule->localVarCnt, &result,NULL); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif EngineData(theEnv)->ExecutingRule->executing = FALSE; SetEvaluationError(theEnv,FALSE); EvaluationData(theEnv)->CurrentEvaluationDepth--; EngineData(theEnv)->TheLogicalJoin = NULL; /*=====================================================*/ /* If rule execution was halted, then print a message. */ /*=====================================================*/ #if DEBUGGING_FUNCTIONS if ((EvaluationData(theEnv)->HaltExecution) || (EngineData(theEnv)->HaltRules && EngineData(theEnv)->ExecutingRule->watchFiring)) #else if ((EvaluationData(theEnv)->HaltExecution) || (EngineData(theEnv)->HaltRules)) #endif { PrintErrorID(theEnv,"PRCCODE",4,FALSE); EnvPrintRouter(theEnv,WERROR,"Execution halted during the actions of defrule "); EnvPrintRouter(theEnv,WERROR,ruleFiring); EnvPrintRouter(theEnv,WERROR,".\n"); } /*===================================================================*/ /* Decrement the count for each of the facts/objects associated with */ /* the rule activation. If the last match for the activation */ /* is from a not CE, then we need to make sure that the last */ /* match is an actual match for the CE and not a counter. */ /*===================================================================*/ theBasis->busy = FALSE; for (i = 0; i < (theBasis->bcount - 1); i++) { theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem; if (theMatchingItem != NULL) { (*theMatchingItem->theInfo->decrementBasisCount)(theEnv,theMatchingItem); } } i = (unsigned) (theBasis->bcount - 1); if (theBasis->counterf == FALSE) { theMatchingItem = theBasis->binds[i].gm.theMatch->matchingItem; if (theMatchingItem != NULL) { (*theMatchingItem->theInfo->decrementBasisCount)(theEnv,theMatchingItem); } } /*========================================*/ /* Return the agenda node to free memory. */ /*========================================*/ RemoveActivation(theEnv,theActivation,FALSE,FALSE); /*======================================*/ /* Get rid of partial matches discarded */ /* while executing the rule's RHS. */ /*======================================*/ FlushGarbagePartialMatches(theEnv); /*==================================*/ /* Get rid of other garbage created */ /* while executing the rule's RHS. */ /*==================================*/ PeriodicCleanup(theEnv,FALSE,TRUE); /*==========================*/ /* Keep up with statistics. */ /*==========================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchStatistics) { #if DEFTEMPLATE_CONSTRUCT tempValue = GetNumberOfFacts(theEnv); if (tempValue > maxFacts) maxFacts = tempValue; sumFacts += tempValue; #endif #if OBJECT_SYSTEM tempValue = GetGlobalNumberOfInstances(theEnv); if (tempValue > maxInstances) maxInstances = tempValue; sumInstances += tempValue; #endif tempValue = GetNumberOfActivations(theEnv); if (tempValue > maxActivations) maxActivations = tempValue; sumActivations += tempValue; } #endif /*==================================*/ /* Update saliences if appropriate. */ /*==================================*/ if (EnvGetSalienceEvaluation(theEnv) == EVERY_CYCLE) EnvRefreshAgenda(theEnv,NULL); /*========================================*/ /* Execute the list of functions that are */ /* to be called after each rule firing. */ /*========================================*/ for (theRunFunction = EngineData(theEnv)->ListOfRunFunctions; theRunFunction != NULL; theRunFunction = theRunFunction->next) { if (theRunFunction->environmentAware) { (*theRunFunction->func)(theEnv); } else { ((void (*)(void))(*theRunFunction->func))(); } } /*========================================*/ /* If a return was issued on the RHS of a */ /* rule, then remove *that* rule's module */ /* from the focus stack */ /*========================================*/ if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE) { RemoveFocus(theEnv,EngineData(theEnv)->ExecutingRule->header.whichModule->theModule); } ProcedureFunctionData(theEnv)->ReturnFlag = FALSE; /*========================================*/ /* Determine the next activation to fire. */ /*========================================*/ theActivation = (struct activation *) NextActivationToFire(theEnv); /*==============================*/ /* Check for a rule breakpoint. */ /*==============================*/ if (theActivation != NULL) { if (((struct defrule *) GetActivationRule(theActivation))->afterBreakpoint) { EngineData(theEnv)->HaltRules = TRUE; EnvPrintRouter(theEnv,WDIALOG,"Breaking on rule "); EnvPrintRouter(theEnv,WDIALOG,EnvGetActivationName(theEnv,theActivation)); EnvPrintRouter(theEnv,WDIALOG,".\n"); } } } /*=====================================================*/ /* Make sure run functions are executed at least once. */ /*=====================================================*/ if (rulesFired == 0) { for (theRunFunction = EngineData(theEnv)->ListOfRunFunctions; theRunFunction != NULL; theRunFunction = theRunFunction->next) { if (theRunFunction->environmentAware) { (*theRunFunction->func)(theEnv); } else { ((void (*)(void))(*theRunFunction->func))(); } } } /*======================================================*/ /* If rule execution was halted because the rule firing */ /* limit was reached, then print a message. */ /*======================================================*/ if (runLimit == rulesFired) { EnvPrintRouter(theEnv,WDIALOG,"rule firing limit reached\n"); } /*==============================*/ /* Restore execution variables. */ /*==============================*/ EngineData(theEnv)->ExecutingRule = NULL; EngineData(theEnv)->HaltRules = FALSE; /*=================================================*/ /* Print out statistics if they are being watched. */ /*=================================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchStatistics) { char printSpace[60]; endTime = gentime(); PrintLongInteger(theEnv,WDIALOG,rulesFired); EnvPrintRouter(theEnv,WDIALOG," rules fired"); #if (! GENERIC) if (startTime != endTime) { EnvPrintRouter(theEnv,WDIALOG," Run time is "); PrintFloat(theEnv,WDIALOG,endTime - startTime); EnvPrintRouter(theEnv,WDIALOG," seconds.\n"); PrintFloat(theEnv,WDIALOG,(double) rulesFired / (endTime - startTime)); EnvPrintRouter(theEnv,WDIALOG," rules per second.\n"); } else { EnvPrintRouter(theEnv,WDIALOG,"\n"); } #endif #if DEFTEMPLATE_CONSTRUCT sprintf(printSpace,"%ld mean number of facts (%ld maximum).\n", (long) (((double) sumFacts / (rulesFired + 1)) + 0.5), maxFacts); EnvPrintRouter(theEnv,WDIALOG,printSpace); #endif #if OBJECT_SYSTEM sprintf(printSpace,"%ld mean number of instances (%ld maximum).\n", (long) (((double) sumInstances / (rulesFired + 1)) + 0.5), maxInstances); EnvPrintRouter(theEnv,WDIALOG,printSpace); #endif sprintf(printSpace,"%ld mean number of activations (%ld maximum).\n", (long) (((double) sumActivations / (rulesFired + 1)) + 0.5), maxActivations); EnvPrintRouter(theEnv,WDIALOG,printSpace); } #endif /*==========================================*/ /* The current module should be the current */ /* focus when the run finishes. */ /*==========================================*/ if (EngineData(theEnv)->CurrentFocus != NULL) { if (EngineData(theEnv)->CurrentFocus->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) { EnvSetCurrentModule(theEnv,(void *) EngineData(theEnv)->CurrentFocus->theModule); } } /*===================================*/ /* Return the number of rules fired. */ /*===================================*/ EngineData(theEnv)->AlreadyRunning = FALSE; return(rulesFired); } /***********************************************************/ /* NextActivationToFire: Returns the next activation which */ /* should be executed based on the current focus. */ /***********************************************************/ static struct activation *NextActivationToFire( void *theEnv) { struct activation *theActivation; struct defmodule *theModule; /*====================================*/ /* If there is no current focus, then */ /* focus on the MAIN module. */ /*====================================*/ if (EngineData(theEnv)->CurrentFocus == NULL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,theModule); } /*===========================================================*/ /* Determine the top activation on the agenda of the current */ /* focus. If the current focus has no activations on its */ /* agenda, then pop the focus off the focus stack until */ /* a focus that has an activation on its agenda is found. */ /*===========================================================*/ theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda; while ((theActivation == NULL) && (EngineData(theEnv)->CurrentFocus != NULL)) { if (EngineData(theEnv)->CurrentFocus != NULL) EnvPopFocus(theEnv); if (EngineData(theEnv)->CurrentFocus != NULL) theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda; } /*=========================================*/ /* Return the next activation to be fired. */ /*=========================================*/ return(theActivation); } /***************************************************/ /* RemoveFocus: Removes the first occurence of the */ /* specified module from the focus stack. */ /***************************************************/ static struct defmodule *RemoveFocus( void *theEnv, struct defmodule *theModule) { struct focus *tempFocus,*prevFocus, *nextFocus; int found = FALSE; int currentFocusRemoved = FALSE; /*====================================*/ /* Return NULL if there is nothing on */ /* the focus stack to remove. */ /*====================================*/ if (EngineData(theEnv)->CurrentFocus == NULL) return(NULL); /*=============================================*/ /* Remove the first occurence of the specified */ /* module from the focus stack. */ /*=============================================*/ prevFocus = NULL; tempFocus = EngineData(theEnv)->CurrentFocus; while ((tempFocus != NULL) && (! found)) { if (tempFocus->theModule == theModule) { found = TRUE; nextFocus = tempFocus->next; rtn_struct(theEnv,focus,tempFocus); tempFocus = nextFocus; if (prevFocus == NULL) { currentFocusRemoved = TRUE; EngineData(theEnv)->CurrentFocus = tempFocus; } else { prevFocus->next = tempFocus; } } else { prevFocus = tempFocus; tempFocus = tempFocus->next; } } /*=========================================*/ /* If the given module is not in the focus */ /* stack, simply return the current focus */ /*=========================================*/ if (! found) return(EngineData(theEnv)->CurrentFocus->theModule); /*========================================*/ /* If the current focus is being watched, */ /* then print an informational message. */ /*========================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchFocus) { EnvPrintRouter(theEnv,WTRACE,"<== Focus "); EnvPrintRouter(theEnv,WTRACE,ValueToString(theModule->name)); if ((EngineData(theEnv)->CurrentFocus != NULL) && currentFocusRemoved) { EnvPrintRouter(theEnv,WTRACE," to "); EnvPrintRouter(theEnv,WTRACE,ValueToString(EngineData(theEnv)->CurrentFocus->theModule->name)); } EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*======================================================*/ /* Set the current module to the module associated with */ /* the current focus (if it changed) and set a boolean */ /* flag indicating that the focus has changed. */ /*======================================================*/ if ((EngineData(theEnv)->CurrentFocus != NULL) && currentFocusRemoved) { EnvSetCurrentModule(theEnv,(void *) EngineData(theEnv)->CurrentFocus->theModule); } EngineData(theEnv)->FocusChanged = TRUE; /*====================================*/ /* Return the module that was removed */ /* from the focus stack. */ /*====================================*/ return(theModule); } /*************************************************************/ /* EnvPopFocus: C access routine for the pop-focus function. */ /*************************************************************/ globle void *EnvPopFocus( void *theEnv) { if (EngineData(theEnv)->CurrentFocus == NULL) return(NULL); return((void *) RemoveFocus(theEnv,EngineData(theEnv)->CurrentFocus->theModule)); } /***************************************************************/ /* EnvGetNextFocus: Returns the next focus on the focus stack. */ /***************************************************************/ globle void *EnvGetNextFocus( void *theEnv, void *theFocus) { /*==================================================*/ /* If NULL is passed as an argument, return the top */ /* focus on the focus stack (the current focus). */ /*==================================================*/ if (theFocus == NULL) return((void *) EngineData(theEnv)->CurrentFocus); /*=======================================*/ /* Otherwise, return the focus following */ /* the focus passed as an argument. */ /*=======================================*/ return((void *) ((struct focus *) theFocus)->next); } /******************************************************/ /* EnvFocus: C access routine for the focus function. */ /******************************************************/ globle void EnvFocus( void *theEnv, void *vTheModule) { struct defmodule *theModule = (struct defmodule *) vTheModule; struct focus *tempFocus; /*==================================================*/ /* Make the specified module be the current module. */ /* If the specified module is the current focus, */ /* then no further action is needed. */ /*==================================================*/ EnvSetCurrentModule(theEnv,(void *) theModule); if (EngineData(theEnv)->CurrentFocus != NULL) { if (EngineData(theEnv)->CurrentFocus->theModule == theModule) return; } /*=====================================*/ /* If the focus is being watched, then */ /* print an information message. */ /*=====================================*/ #if DEBUGGING_FUNCTIONS if (EngineData(theEnv)->WatchFocus) { EnvPrintRouter(theEnv,WTRACE,"==> Focus "); EnvPrintRouter(theEnv,WTRACE,ValueToString(theModule->name)); if (EngineData(theEnv)->CurrentFocus != NULL) { EnvPrintRouter(theEnv,WTRACE," from "); EnvPrintRouter(theEnv,WTRACE,ValueToString(EngineData(theEnv)->CurrentFocus->theModule->name)); } EnvPrintRouter(theEnv,WTRACE,"\n"); } #endif /*=======================================*/ /* Add the new focus to the focus stack. */ /*=======================================*/ tempFocus = get_struct(theEnv,focus); tempFocus->theModule = theModule; tempFocus->theDefruleModule = GetDefruleModuleItem(theEnv,theModule); tempFocus->next = EngineData(theEnv)->CurrentFocus; EngineData(theEnv)->CurrentFocus = tempFocus; EngineData(theEnv)->FocusChanged = TRUE; } /************************************************/ /* ClearFocusStackCommand: H/L access routine */ /* for the clear-focus-stack command. */ /************************************************/ globle void ClearFocusStackCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"list-focus-stack",EXACTLY,0) == -1) return; EnvClearFocusStack(theEnv); } /****************************************/ /* EnvClearFocusStack: C access routine */ /* for the clear-focus-stack command. */ /****************************************/ globle void EnvClearFocusStack( void *theEnv) { while (EngineData(theEnv)->CurrentFocus != NULL) EnvPopFocus(theEnv); EngineData(theEnv)->FocusChanged = TRUE; } #if (! ENVIRONMENT_API_ONLY) && ALLOW_ENVIRONMENT_GLOBALS /***********************************/ /* AddRunFunction: Adds a function */ /* to the ListOfRunFunctions. */ /***********************************/ globle intBool AddRunFunction( char *name, void (*functionPtr)(void), int priority) { void *theEnv; theEnv = GetCurrentEnvironment(); EngineData(theEnv)->ListOfRunFunctions = AddFunctionToCallList(theEnv,name,priority,(void (*)(void *)) functionPtr, EngineData(theEnv)->ListOfRunFunctions,TRUE); return(1); } #endif /**************************************/ /* EnvAddRunFunction: Adds a function */ /* to the ListOfRunFunctions. */ /**************************************/ globle intBool EnvAddRunFunction( void *theEnv, char *name, void (*functionPtr)(void *), int priority) { EngineData(theEnv)->ListOfRunFunctions = AddFunctionToCallList(theEnv,name,priority, functionPtr, EngineData(theEnv)->ListOfRunFunctions,TRUE); return(1); } /********************************************/ /* EnvRemoveRunFunction: Removes a function */ /* from the ListOfRunFunctions. */ /********************************************/ globle intBool EnvRemoveRunFunction( void *theEnv, char *name) { int found; EngineData(theEnv)->ListOfRunFunctions = RemoveFunctionFromCallList(theEnv,name,EngineData(theEnv)->ListOfRunFunctions,&found); if (found) return(TRUE); return(FALSE); } /*********************************************************/ /* RunCommand: H/L access routine for the run command. */ /*********************************************************/ globle void RunCommand( void *theEnv) { int numArgs; long int runLimit = -1; DATA_OBJECT argPtr; if ((numArgs = EnvArgCountCheck(theEnv,"run",NO_MORE_THAN,1)) == -1) return; if (numArgs == 0) { runLimit = -1; } else if (numArgs == 1) { if (EnvArgTypeCheck(theEnv,"run",1,INTEGER,&argPtr) == FALSE) return; runLimit = DOToLong(argPtr); } EnvRun(theEnv,runLimit); return; } /***********************************************/ /* HaltCommand: Causes rule execution to halt. */ /***********************************************/ globle void HaltCommand( void *theEnv) { EnvArgCountCheck(theEnv,"halt",EXACTLY,0); EngineData(theEnv)->HaltRules = TRUE; } #if DEBUGGING_FUNCTIONS /*********************************/ /* EnvSetBreak: C access routine */ /* for the set-break command. */ /*********************************/ #if IBM_TBC #pragma argsused #endif globle void EnvSetBreak( void *theEnv, void *theRule) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif struct defrule *thePtr; for (thePtr = (struct defrule *) theRule; thePtr != NULL; thePtr = thePtr->disjunct) { thePtr->afterBreakpoint = 1; } } /************************************/ /* EnvRemoveBreak: C access routine */ /* for the remove-break command. */ /************************************/ #if IBM_TBC #pragma argsused #endif globle intBool EnvRemoveBreak( void *theEnv, void *theRule) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif struct defrule *thePtr; int rv = FALSE; for (thePtr = (struct defrule *) theRule; thePtr != NULL; thePtr = thePtr->disjunct) { if (thePtr->afterBreakpoint == 1) { thePtr->afterBreakpoint = 0; rv = TRUE; } } return(rv); } /**************************************************/ /* RemoveAllBreakpoints: Removes all breakpoints. */ /**************************************************/ globle void RemoveAllBreakpoints( void *theEnv) { void *theRule; void *theDefmodule = NULL; while ((theDefmodule = EnvGetNextDefmodule(theEnv,theDefmodule)) != NULL) { theRule = NULL; while ((theRule = EnvGetNextDefrule(theEnv,theRule)) != NULL) { EnvRemoveBreak(theEnv,theRule); } } } /***********************************/ /* EnvShowBreaks: C access routine */ /* for the show-breaks command. */ /***********************************/ globle void EnvShowBreaks( void *theEnv, char *logicalName, void *vTheModule) { ListItemsDriver(theEnv,logicalName,(struct defmodule *) vTheModule, NULL,NULL, EnvGetNextDefrule,(char *(*)(void *)) GetConstructNameString, NULL,EnvDefruleHasBreakpoint); } /**********************************************/ /* EnvDefruleHasBreakpoint: Indicates whether */ /* the specified rule has a breakpoint set. */ /**********************************************/ #if IBM_TBC #pragma argsused #endif globle intBool EnvDefruleHasBreakpoint( void *theEnv, void *theRule) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif return(((struct defrule *) theRule)->afterBreakpoint); } /*****************************************/ /* SetBreakCommand: H/L access routine */ /* for the set-break command. */ /*****************************************/ globle void SetBreakCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; void *defrulePtr; if (EnvArgCountCheck(theEnv,"set-break",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"set-break",1,SYMBOL,&argPtr) == FALSE) return; argument = DOToString(argPtr); if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL) { CantFindItemErrorMessage(theEnv,"defrule",argument); return; } EnvSetBreak(theEnv,defrulePtr); } /********************************************/ /* RemoveBreakCommand: H/L access routine */ /* for the remove-break command. */ /********************************************/ globle void RemoveBreakCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; int nargs; void *defrulePtr; if ((nargs = EnvArgCountCheck(theEnv,"remove-break",NO_MORE_THAN,1)) == -1) { return; } if (nargs == 0) { RemoveAllBreakpoints(theEnv); return; } if (EnvArgTypeCheck(theEnv,"remove-break",1,SYMBOL,&argPtr) == FALSE) return; argument = DOToString(argPtr); if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL) { CantFindItemErrorMessage(theEnv,"defrule",argument); return; } if (EnvRemoveBreak(theEnv,defrulePtr) == FALSE) { EnvPrintRouter(theEnv,WERROR,"Rule "); EnvPrintRouter(theEnv,WERROR,argument); EnvPrintRouter(theEnv,WERROR," does not have a breakpoint set.\n"); } } /*******************************************/ /* ShowBreaksCommand: H/L access routine */ /* for the show-breaks command. */ /*******************************************/ globle void ShowBreaksCommand( void *theEnv) { int numArgs, error; struct defmodule *theModule; if ((numArgs = EnvArgCountCheck(theEnv,"show-breaks",NO_MORE_THAN,1)) == -1) return; if (numArgs == 1) { theModule = GetModuleName(theEnv,"show-breaks",1,&error); if (error) return; } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } EnvShowBreaks(theEnv,WDISPLAY,theModule); } /***********************************************/ /* ListFocusStackCommand: H/L access routine */ /* for the list-focus-stack command. */ /***********************************************/ globle void ListFocusStackCommand( void *theEnv) { if (EnvArgCountCheck(theEnv,"list-focus-stack",EXACTLY,0) == -1) return; EnvListFocusStack(theEnv,WDISPLAY); } /***************************************/ /* EnvListFocusStack: C access routine */ /* for the list-focus-stack command. */ /***************************************/ globle void EnvListFocusStack( void *theEnv, char *logicalName) { struct focus *theFocus; for (theFocus = EngineData(theEnv)->CurrentFocus; theFocus != NULL; theFocus = theFocus->next) { EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theFocus->theModule)); EnvPrintRouter(theEnv,logicalName,"\n"); } } #endif /***********************************************/ /* GetFocusStackFunction: H/L access routine */ /* for the get-focus-stack function. */ /***********************************************/ globle void GetFocusStackFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { if (EnvArgCountCheck(theEnv,"get-focus-stack",EXACTLY,0) == -1) return; EnvGetFocusStack(theEnv,returnValue); } /***************************************/ /* EnvGetFocusStack: C access routine */ /* for the get-focus-stack function. */ /***************************************/ globle void EnvGetFocusStack( void *theEnv, DATA_OBJECT_PTR returnValue) { struct focus *theFocus; struct multifield *theList; unsigned long count = 0; /*===========================================*/ /* If there is no current focus, then return */ /* a multifield value of length zero. */ /*===========================================*/ if (EngineData(theEnv)->CurrentFocus == NULL) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); SetpValue(returnValue,(void *) EnvCreateMultifield(theEnv,0L)); return; } /*=====================================================*/ /* Determine the number of modules on the focus stack. */ /*=====================================================*/ for (theFocus = EngineData(theEnv)->CurrentFocus; theFocus != NULL; theFocus = theFocus->next) { count++; } /*=============================================*/ /* Create a multifield of the appropriate size */ /* in which to store the module names. */ /*=============================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*=================================================*/ /* Store the module names in the multifield value. */ /*=================================================*/ for (theFocus = EngineData(theEnv)->CurrentFocus, count = 1; theFocus != NULL; theFocus = theFocus->next, count++) { SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,theFocus->theModule->name); } } /******************************************/ /* PopFocusFunction: H/L access routine */ /* for the pop-focus function. */ /******************************************/ globle void *PopFocusFunction( void *theEnv) { struct defmodule *theModule; EnvArgCountCheck(theEnv,"pop-focus",EXACTLY,0); theModule = (struct defmodule *) EnvPopFocus(theEnv); if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); return(theModule->name); } /******************************************/ /* GetFocusFunction: H/L access routine */ /* for the get-focus function. */ /******************************************/ globle void *GetFocusFunction( void *theEnv) { struct defmodule *rv; EnvArgCountCheck(theEnv,"get-focus",EXACTLY,0); rv = (struct defmodule *) EnvGetFocus(theEnv); if (rv == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); return(rv->name); } /*********************************/ /* EnvGetFocus: C access routine */ /* for the get-focus function. */ /*********************************/ globle void *EnvGetFocus( void *theEnv) { if (EngineData(theEnv)->CurrentFocus == NULL) return(NULL); return((void *) EngineData(theEnv)->CurrentFocus->theModule); } /**************************************/ /* FocusCommand: H/L access routine */ /* for the focus function. */ /**************************************/ globle int FocusCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; struct defmodule *theModule; int argCount, i; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"focus",AT_LEAST,1)) == -1) { return(FALSE); } /*===========================================*/ /* Focus on the specified defrule module(s). */ /*===========================================*/ for (i = argCount; i > 0; i--) { if (EnvArgTypeCheck(theEnv,"focus",i,SYMBOL,&argPtr) == FALSE) { return(FALSE); } argument = DOToString(argPtr); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",argument); return(FALSE); } EnvFocus(theEnv,(void *) theModule); } /*===================================================*/ /* Return TRUE to indicate success of focus command. */ /*===================================================*/ return(TRUE); } /***********************************************************************/ /* EnvGetFocusChanged: Returns the value of the variable FocusChanged. */ /***********************************************************************/ globle int EnvGetFocusChanged( void *theEnv) { return(EngineData(theEnv)->FocusChanged); } /********************************************************************/ /* EnvSetFocusChanged: Sets the value of the variable FocusChanged. */ /********************************************************************/ globle void EnvSetFocusChanged( void *theEnv, int value) { EngineData(theEnv)->FocusChanged = value; } /*********************************************/ /* EnvSetHaltRules: Sets the HaltRules flag. */ /*********************************************/ globle void EnvSetHaltRules( void *theEnv, intBool value) { EngineData(theEnv)->HaltRules = value; } /****************************************************/ /* EnvGetHaltRules: Returns the HaltExecution flag. */ /****************************************************/ globle intBool EnvGetHaltRules( void *theEnv) { return(EngineData(theEnv)->HaltRules); } #endif /* DEFRULE_CONSTRUCT */ clips-6.24/clipssrc/._factprt.h0000400000175000017500000000012207422634576014560 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/insmult.c0000755000175000017500000004611710441147571014406 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* INSTANCE MULTIFIELD SLOT MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Access routines for Instance Multifield Slots */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM #include "argacces.h" #include "envrnmnt.h" #include "extnfunc.h" #include "insfun.h" #include "msgfun.h" #include "msgpass.h" #include "multifun.h" #include "router.h" #define _INSMULT_SOURCE_ #include "insmult.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define INSERT 0 #define REPLACE 1 #define DELETE_OP 2 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static INSTANCE_TYPE *CheckMultifieldSlotInstance(void *,char *); static INSTANCE_SLOT *CheckMultifieldSlotModify(void *,int,char *,INSTANCE_TYPE *, EXPRESSION *,int *,int *,DATA_OBJECT *); static void AssignSlotToDataObject(DATA_OBJECT *,INSTANCE_SLOT *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if (! RUN_TIME) /*************************************************** NAME : SetupInstanceMultifieldCommands DESCRIPTION : Defines function interfaces for manipulating instance multislots INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions defined to KB NOTES : None ***************************************************/ globle void SetupInstanceMultifieldCommands( void *theEnv) { /* =================================== Old version 5.1 compatibility names =================================== */ EnvDefineFunction2(theEnv,"direct-mv-replace",'b',PTIEF DirectMVReplaceCommand, "DirectMVReplaceCommand","4**wii"); EnvDefineFunction2(theEnv,"direct-mv-insert",'b',PTIEF DirectMVInsertCommand, "DirectMVInsertCommand","3**wi"); EnvDefineFunction2(theEnv,"direct-mv-delete",'b',PTIEF DirectMVDeleteCommand, "DirectMVDeleteCommand","33iw"); EnvDefineFunction2(theEnv,"mv-slot-replace",'u',PTIEF MVSlotReplaceCommand, "MVSlotReplaceCommand","5*uewii"); EnvDefineFunction2(theEnv,"mv-slot-insert",'u',PTIEF MVSlotInsertCommand, "MVSlotInsertCommand","4*uewi"); EnvDefineFunction2(theEnv,"mv-slot-delete",'u',PTIEF MVSlotDeleteCommand, "MVSlotDeleteCommand","44iew"); /* ===================== New version 6.0 names ===================== */ EnvDefineFunction2(theEnv,"slot-direct-replace$",'b',PTIEF DirectMVReplaceCommand, "DirectMVReplaceCommand","4**wii"); EnvDefineFunction2(theEnv,"slot-direct-insert$",'b',PTIEF DirectMVInsertCommand, "DirectMVInsertCommand","3**wi"); EnvDefineFunction2(theEnv,"slot-direct-delete$",'b',PTIEF DirectMVDeleteCommand, "DirectMVDeleteCommand","33iw"); EnvDefineFunction2(theEnv,"slot-replace$",'u',PTIEF MVSlotReplaceCommand, "MVSlotReplaceCommand","5*uewii"); EnvDefineFunction2(theEnv,"slot-insert$",'u',PTIEF MVSlotInsertCommand, "MVSlotInsertCommand","4*uewi"); EnvDefineFunction2(theEnv,"slot-delete$",'u',PTIEF MVSlotDeleteCommand, "MVSlotDeleteCommand","44iew"); } #endif /*********************************************************************************** NAME : MVSlotReplaceCommand DESCRIPTION : Allows user to replace a specified field of a multi-value slot The slot is directly read (w/o a get- message) and the new slot-value is placed via a put- message. This function is not valid for single-value slots. INPUTS : Caller's result buffer RETURNS : TRUE if multi-value slot successfully modified, FALSE otherwise SIDE EFFECTS : Put messsage sent for slot NOTES : H/L Syntax : (slot-replace$ ) ***********************************************************************************/ globle void MVSlotReplaceCommand( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT newval,newseg,oldseg; INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; int rb,re; EXPRESSION arg; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ins = CheckMultifieldSlotInstance(theEnv,"slot-replace$"); if (ins == NULL) return; sp = CheckMultifieldSlotModify(theEnv,REPLACE,"slot-replace$",ins, GetFirstArgument()->nextArg,&rb,&re,&newval); if (sp == NULL) return; AssignSlotToDataObject(&oldseg,sp); if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"slot-replace$") == FALSE) return; arg.type = MULTIFIELD; arg.value = (void *) &newseg; arg.nextArg = NULL; arg.argList = NULL; DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg); } /*********************************************************************************** NAME : MVSlotInsertCommand DESCRIPTION : Allows user to insert a specified field of a multi-value slot The slot is directly read (w/o a get- message) and the new slot-value is placed via a put- message. This function is not valid for single-value slots. INPUTS : Caller's result buffer RETURNS : TRUE if multi-value slot successfully modified, FALSE otherwise SIDE EFFECTS : Put messsage sent for slot NOTES : H/L Syntax : (slot-insert$ ) ***********************************************************************************/ globle void MVSlotInsertCommand( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT newval,newseg,oldseg; INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; int theIndex; EXPRESSION arg; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ins = CheckMultifieldSlotInstance(theEnv,"slot-insert$"); if (ins == NULL) return; sp = CheckMultifieldSlotModify(theEnv,INSERT,"slot-insert$",ins, GetFirstArgument()->nextArg,&theIndex,NULL,&newval); if (sp == NULL) return; AssignSlotToDataObject(&oldseg,sp); if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"slot-insert$") == FALSE) return; arg.type = MULTIFIELD; arg.value = (void *) &newseg; arg.nextArg = NULL; arg.argList = NULL; DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg); } /*********************************************************************************** NAME : MVSlotDeleteCommand DESCRIPTION : Allows user to delete a specified field of a multi-value slot The slot is directly read (w/o a get- message) and the new slot-value is placed via a put- message. This function is not valid for single-value slots. INPUTS : Caller's result buffer RETURNS : TRUE if multi-value slot successfully modified, FALSE otherwise SIDE EFFECTS : Put message sent for slot NOTES : H/L Syntax : (slot-delete$ ) ***********************************************************************************/ globle void MVSlotDeleteCommand( void *theEnv, DATA_OBJECT *result) { DATA_OBJECT newseg,oldseg; INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; int rb,re; EXPRESSION arg; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ins = CheckMultifieldSlotInstance(theEnv,"slot-delete$"); if (ins == NULL) return; sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"slot-delete$",ins, GetFirstArgument()->nextArg,&rb,&re,NULL); if (sp == NULL) return; AssignSlotToDataObject(&oldseg,sp); if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"slot-delete$") == FALSE) return; arg.type = MULTIFIELD; arg.value = (void *) &newseg; arg.nextArg = NULL; arg.argList = NULL; DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg); } /***************************************************************** NAME : DirectMVReplaceCommand DESCRIPTION : Directly replaces a slot's value INPUTS : None RETURNS : TRUE if put OK, FALSE otherwise SIDE EFFECTS : Slot modified NOTES : H/L Syntax: (direct-slot-replace$ ) *****************************************************************/ globle intBool DirectMVReplaceCommand( void *theEnv) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; int rb,re; DATA_OBJECT newval,newseg,oldseg; if (CheckCurrentMessage(theEnv,"direct-slot-replace$",TRUE) == FALSE) return(FALSE); ins = GetActiveInstance(theEnv); sp = CheckMultifieldSlotModify(theEnv,REPLACE,"direct-slot-replace$",ins, GetFirstArgument(),&rb,&re,&newval); if (sp == NULL) return(FALSE); AssignSlotToDataObject(&oldseg,sp); if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"direct-slot-replace$") == FALSE) return(FALSE); if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-replace$")) return(TRUE); return(FALSE); } /************************************************************************ NAME : DirectMVInsertCommand DESCRIPTION : Directly inserts a slot's value INPUTS : None RETURNS : TRUE if put OK, FALSE otherwise SIDE EFFECTS : Slot modified NOTES : H/L Syntax: (direct-slot-insert$ ) ************************************************************************/ globle intBool DirectMVInsertCommand( void *theEnv) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; int theIndex; DATA_OBJECT newval,newseg,oldseg; if (CheckCurrentMessage(theEnv,"direct-slot-insert$",TRUE) == FALSE) return(FALSE); ins = GetActiveInstance(theEnv); sp = CheckMultifieldSlotModify(theEnv,INSERT,"direct-slot-insert$",ins, GetFirstArgument(),&theIndex,NULL,&newval); if (sp == NULL) return(FALSE); AssignSlotToDataObject(&oldseg,sp); if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"direct-slot-insert$") == FALSE) return(FALSE); if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-insert$")) return(TRUE); return(FALSE); } /***************************************************************** NAME : DirectMVDeleteCommand DESCRIPTION : Directly deletes a slot's value INPUTS : None RETURNS : TRUE if put OK, FALSE otherwise SIDE EFFECTS : Slot modified NOTES : H/L Syntax: (direct-slot-delete$ ) *****************************************************************/ globle intBool DirectMVDeleteCommand( void *theEnv) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; int rb,re; DATA_OBJECT newseg,oldseg; if (CheckCurrentMessage(theEnv,"direct-slot-delete$",TRUE) == FALSE) return(FALSE); ins = GetActiveInstance(theEnv); sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"direct-slot-delete$",ins, GetFirstArgument(),&rb,&re,NULL); if (sp == NULL) return(FALSE); AssignSlotToDataObject(&oldseg,sp); if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"direct-slot-delete$") == FALSE) return(FALSE); if (PutSlotValue(theEnv,ins,sp,&newseg,&oldseg,"function direct-slot-delete$")) return(TRUE); return(FALSE); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /********************************************************************** NAME : CheckMultifieldSlotInstance DESCRIPTION : Gets the instance for the functions slot-replace$, insert and delete INPUTS : The function name RETURNS : The instance address, NULL on errors SIDE EFFECTS : None NOTES : None **********************************************************************/ static INSTANCE_TYPE *CheckMultifieldSlotInstance( void *theEnv, char *func) { INSTANCE_TYPE *ins; DATA_OBJECT temp; if (EnvArgTypeCheck(theEnv,func,1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE) { SetEvaluationError(theEnv,TRUE); return(NULL); } if (temp.type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) temp.value; if (ins->garbage == 1) { StaleInstanceAddress(theEnv,func,0); SetEvaluationError(theEnv,TRUE); return(NULL); } } else { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value); if (ins == NULL) NoInstanceError(theEnv,ValueToString(temp.value),func); } return(ins); } /********************************************************************* NAME : CheckMultifieldSlotModify DESCRIPTION : For the functions slot-replace$, insert, & delete as well as direct-slot-replace$, insert, & delete this function gets the slot, index, and optional field-value for these functions INPUTS : 1) A code indicating the type of operation INSERT (0) : Requires one index REPLACE (1) : Requires two indices DELETE_OP (2) : Requires two indices 2) Function name-string 3) Instance address 4) Argument expression chain 5) Caller's buffer for index (or beginning of range) 6) Caller's buffer for end of range (can be NULL for INSERT) 7) Caller's new-field value buffer (can be NULL for DELETE_OP) RETURNS : The address of the instance-slot, NULL on errors SIDE EFFECTS : Caller's index buffer set Caller's new-field value buffer set (if not NULL) Will allocate an ephemeral segment to store more than 1 new field value EvaluationError set on errors NOTES : Assume the argument chain is at least 2 expressions deep - slot, index, and optional values *********************************************************************/ static INSTANCE_SLOT *CheckMultifieldSlotModify( void *theEnv, int code, char *func, INSTANCE_TYPE *ins, EXPRESSION *args, int *rb, int *re, DATA_OBJECT *newval) { DATA_OBJECT temp; INSTANCE_SLOT *sp; int start; start = (args == GetFirstArgument()) ? 1 : 2; EvaluationData(theEnv)->EvaluationError = FALSE; EvaluateExpression(theEnv,args,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,func,start,"symbol"); SetEvaluationError(theEnv,TRUE); return(NULL); } sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),func); return(NULL); } if (sp->desc->multiple == 0) { PrintErrorID(theEnv,"INSMULT",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR," cannot be used on single-field slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name)); EnvPrintRouter(theEnv,WERROR," in instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } EvaluateExpression(theEnv,args->nextArg,&temp); if (temp.type != INTEGER) { ExpectedTypeError1(theEnv,func,start+1,"integer"); SetEvaluationError(theEnv,TRUE); return(NULL); } args = args->nextArg->nextArg; *rb = ValueToInteger(temp.value); if ((code == REPLACE) || (code == DELETE_OP)) { EvaluateExpression(theEnv,args,&temp); if (temp.type != INTEGER) { ExpectedTypeError1(theEnv,func,start+2,"integer"); SetEvaluationError(theEnv,TRUE); return(NULL); } *re = ValueToInteger(temp.value); args = args->nextArg; } if ((code == INSERT) || (code == REPLACE)) { if (EvaluateAndStoreInDataObject(theEnv,1,args,newval,TRUE) == FALSE) return(NULL); } return(sp); } /*************************************************** NAME : AssignSlotToDataObject DESCRIPTION : Assigns the value of a multifield slot to a data object INPUTS : 1) The data object buffer 2) The instance slot RETURNS : Nothing useful SIDE EFFECTS : Data object fields set NOTES : Assumes slot is a multislot ***************************************************/ static void AssignSlotToDataObject( DATA_OBJECT *theDataObject, INSTANCE_SLOT *theSlot) { theDataObject->type = (unsigned short) theSlot->type; theDataObject->value = theSlot->value; theDataObject->begin = 0; SetpDOEnd(theDataObject,GetInstanceSlotLength(theSlot)); } #endif /*************************************************** NAME : DESCRIPTION : INPUTS : RETURNS : SIDE EFFECTS : NOTES : ***************************************************/ clips-6.24/clipssrc/sortfun.c0000755000175000017500000003276310253662160014412 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* SORT FUNCTIONS MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains the code for sorting functions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */ /* */ /* 6.24: The sort function leaks memory when called */ /* with a multifield value of length zero. */ /* DR0864 */ /* */ /*************************************************************/ #define _SORTFUN_SOURCE_ #include "setup.h" #include "argacces.h" #include "dffnxfun.h" #include "envrnmnt.h" #include "evaluatn.h" #include "extnfunc.h" #include "memalloc.h" #include "multifld.h" #include "sysdep.h" #include "sortfun.h" #define SORTFUN_DATA 7 struct sortFunctionData { struct expr *SortComparisonFunction; }; #define SortFunctionData(theEnv) ((struct sortFunctionData *) GetEnvironmentData(theEnv,SORTFUN_DATA)) /***************************************/ /* LOCAL INTERNAL FUNCTION DEFINITIONS */ /***************************************/ static void DoMergeSort(void *,DATA_OBJECT *,DATA_OBJECT *,unsigned long, unsigned long,unsigned long,unsigned long, int (*)(void *,DATA_OBJECT *,DATA_OBJECT *)); static int DefaultCompareSwapFunction(void *,DATA_OBJECT *,DATA_OBJECT *); /****************************************/ /* SortFunctionDefinitions: Initializes */ /* the sorting functions. */ /****************************************/ globle void SortFunctionDefinitions( void *theEnv) { AllocateEnvironmentData(theEnv,SORTFUN_DATA,sizeof(struct sortFunctionData),NULL); #if ! RUN_TIME EnvDefineFunction2(theEnv,"sort",'u', PTIEF SortFunction,"SortFunction","1**w"); #endif } /**************************************/ /* DefaultCompareSwapFunction: */ /**************************************/ static int DefaultCompareSwapFunction( void *theEnv, DATA_OBJECT *item1, DATA_OBJECT *item2) { DATA_OBJECT returnValue; SortFunctionData(theEnv)->SortComparisonFunction->argList = GenConstant(theEnv,item1->type,item1->value); SortFunctionData(theEnv)->SortComparisonFunction->argList->nextArg = GenConstant(theEnv,item2->type,item2->value); ExpressionInstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction); EvaluateExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction,&returnValue); ExpressionDeinstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction); ReturnExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction->argList); SortFunctionData(theEnv)->SortComparisonFunction->argList = NULL; if ((GetType(returnValue) == SYMBOL) && (GetValue(returnValue) == EnvFalseSymbol(theEnv))) { return(FALSE); } return(TRUE); } /**************************************/ /* SortFunction: H/L access routine */ /* for the rest$ function. */ /**************************************/ globle void SortFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { long argumentCount, i, j, k = 0; DATA_OBJECT *theArguments, *theArguments2; DATA_OBJECT theArg; struct multifield *theMultifield, *tempMultifield; char *functionName; struct expr *functionReference; int argumentSize = 0; struct FunctionDefinition *fptr; #if DEFFUNCTION_CONSTRUCT DEFFUNCTION *dptr; #endif /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=============================================*/ /* The function expects at least one argument. */ /*=============================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,"sort",AT_LEAST,1)) == -1) { return; } /*=============================================*/ /* Verify that the comparison function exists. */ /*=============================================*/ if (EnvArgTypeCheck(theEnv,"sort",1,SYMBOL,&theArg) == FALSE) { return; } functionName = DOToString(theArg); functionReference = FunctionReferenceExpression(theEnv,functionName); if (functionReference == NULL) { ExpectedTypeError1(theEnv,"sort",1,"function name, deffunction name, or defgeneric name"); return; } /*======================================*/ /* For an external function, verify the */ /* correct number of arguments. */ /*======================================*/ if (functionReference->type == FCALL) { fptr = (struct FunctionDefinition *) functionReference->value; if ((GetMinimumArgs(fptr) > 2) || (GetMaximumArgs(fptr) == 0) || (GetMaximumArgs(fptr) == 1)) { ExpectedTypeError1(theEnv,"sort",1,"function name expecting two arguments"); ReturnExpression(theEnv,functionReference); return; } } /*=======================================*/ /* For a deffunction, verify the correct */ /* number of arguments. */ /*=======================================*/ #if DEFFUNCTION_CONSTRUCT if (functionReference->type == PCALL) { dptr = (DEFFUNCTION *) functionReference->value; if ((dptr->minNumberOfParameters > 2) || (dptr->maxNumberOfParameters == 0) || (dptr->maxNumberOfParameters == 1)) { ExpectedTypeError1(theEnv,"sort",1,"deffunction name expecting two arguments"); ReturnExpression(theEnv,functionReference); return; } } #endif /*=====================================*/ /* If there are no items to be sorted, */ /* then return an empty multifield. */ /*=====================================*/ if (argumentCount == 1) { EnvSetMultifieldErrorValue(theEnv,returnValue); ReturnExpression(theEnv,functionReference); return; } /*=====================================*/ /* Retrieve the arguments to be sorted */ /* and determine how many there are. */ /*=====================================*/ theArguments = (DATA_OBJECT *) genalloc(theEnv,(argumentCount - 1) * sizeof(DATA_OBJECT)); for (i = 2; i <= argumentCount; i++) { EnvRtnUnknown(theEnv,i,&theArguments[i-2]); if (GetType(theArguments[i-2]) == MULTIFIELD) { argumentSize += GetpDOLength(&theArguments[i-2]); } else { argumentSize++; } } if (argumentSize == 0) { genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); /* Bug Fix */ EnvSetMultifieldErrorValue(theEnv,returnValue); ReturnExpression(theEnv,functionReference); return; } /*====================================*/ /* Pack all of the items to be sorted */ /* into a data object array. */ /*====================================*/ theArguments2 = (DATA_OBJECT *) genalloc(theEnv,argumentSize * sizeof(DATA_OBJECT)); for (i = 2; i <= argumentCount; i++) { if (GetType(theArguments[i-2]) == MULTIFIELD) { tempMultifield = (struct multifield *) GetValue(theArguments[i-2]); for (j = GetDOBegin(theArguments[i-2]); j <= GetDOEnd(theArguments[i-2]); j++, k++) { SetType(theArguments2[k],GetMFType(tempMultifield,j)); SetValue(theArguments2[k],GetMFValue(tempMultifield,j)); } } else { SetType(theArguments2[k],GetType(theArguments[i-2])); SetValue(theArguments2[k],GetValue(theArguments[i-2])); k++; } } genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); functionReference->nextArg = SortFunctionData(theEnv)->SortComparisonFunction; SortFunctionData(theEnv)->SortComparisonFunction = functionReference; for (i = 0; i < argumentSize; i++) { ValueInstall(theEnv,&theArguments2[i]); } MergeSort(theEnv,(unsigned long) argumentSize,theArguments2,DefaultCompareSwapFunction); for (i = 0; i < argumentSize; i++) { ValueDeinstall(theEnv,&theArguments2[i]); } SortFunctionData(theEnv)->SortComparisonFunction = SortFunctionData(theEnv)->SortComparisonFunction->nextArg; functionReference->nextArg = NULL; ReturnExpression(theEnv,functionReference); theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,(unsigned long) argumentSize); for (i = 0; i < argumentSize; i++) { SetMFType(theMultifield,i+1,GetType(theArguments2[i])); SetMFValue(theMultifield,i+1,GetValue(theArguments2[i])); } genfree(theEnv,theArguments2,argumentSize * sizeof(DATA_OBJECT)); SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,argumentSize); SetpValue(returnValue,(void *) theMultifield); } /*******************************************/ /* MergeSort: Sorts a list of fields */ /* according to user specified criteria. */ /*******************************************/ void MergeSort( void *theEnv, unsigned long listSize, DATA_OBJECT *theList, int (*swapFunction)(void *,DATA_OBJECT *,DATA_OBJECT *)) { DATA_OBJECT *tempList; unsigned long middle; if (listSize <= 1) return; /*==============================*/ /* Create the temporary storage */ /* needed for the merge sort. */ /*==============================*/ tempList = (DATA_OBJECT *) genalloc(theEnv,listSize * sizeof(DATA_OBJECT)); /*=====================================*/ /* Call the merge sort driver routine. */ /*=====================================*/ middle = (listSize + 1) / 2; DoMergeSort(theEnv,theList,tempList,0,middle-1,middle,listSize - 1,swapFunction); /*==================================*/ /* Deallocate the temporary storage */ /* needed by the merge sort. */ /*==================================*/ genfree(theEnv,tempList,listSize * sizeof(DATA_OBJECT)); } /******************************************************/ /* DoMergeSort: Driver routine for performing a merge */ /* sort on an array of DATA_OBJECT structures. */ /******************************************************/ static void DoMergeSort( void *theEnv, DATA_OBJECT *theList, DATA_OBJECT *tempList, unsigned long s1, unsigned long e1, unsigned long s2, unsigned long e2, int (*swapFunction)(void *,DATA_OBJECT *,DATA_OBJECT *)) { DATA_OBJECT temp; unsigned long middle, size; unsigned long c1, c2, mergePoint; /* Sort the two subareas before merging them. */ if (s1 == e1) { /* List doesn't need to be merged. */ } else if ((s1 + 1) == e1) { if ((*swapFunction)(theEnv,&theList[s1],&theList[e1])) { TransferDataObjectValues(&temp,&theList[s1]); TransferDataObjectValues(&theList[s1],&theList[e1]); TransferDataObjectValues(&theList[e1],&temp); } } else { size = ((e1 - s1) + 1); middle = s1 + ((size + 1) / 2); DoMergeSort(theEnv,theList,tempList,s1,middle-1,middle,e1,swapFunction); } if (s2 == e2) { /* List doesn't need to be merged. */ } else if ((s2 + 1) == e2) { if ((*swapFunction)(theEnv,&theList[s2],&theList[e2])) { TransferDataObjectValues(&temp,&theList[s2]); TransferDataObjectValues(&theList[s2],&theList[e2]); TransferDataObjectValues(&theList[e2],&temp); } } else { size = ((e2 - s2) + 1); middle = s2 + ((size + 1) / 2); DoMergeSort(theEnv,theList,tempList,s2,middle-1,middle,e2,swapFunction); } /*======================*/ /* Merge the two areas. */ /*======================*/ mergePoint = s1; c1 = s1; c2 = s2; while (mergePoint <= e2) { if (c1 > e1) { TransferDataObjectValues(&tempList[mergePoint],&theList[c2]); c2++; mergePoint++; } else if (c2 > e2) { TransferDataObjectValues(&tempList[mergePoint],&theList[c1]); c1++; mergePoint++; } else if ((*swapFunction)(theEnv,&theList[c1],&theList[c2])) { TransferDataObjectValues(&tempList[mergePoint],&theList[c2]); c2++; mergePoint++; } else { TransferDataObjectValues(&tempList[mergePoint],&theList[c1]); c1++; mergePoint++; } } /*=======================================*/ /* Copy them back to the original array. */ /*=======================================*/ for (c1 = s1; c1 <= e2; c1++) { TransferDataObjectValues(&theList[c1],&tempList[c1]); } } clips-6.24/clipssrc/._cstrnutl.c0000400000175000017500000000452210253662664014771 0ustar jfsjfsMac OS X  2 R TEXTR*chn cstrnutl.crol PanelTCmr.txt.docTEXTR*ch p)N " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monacot]t].РtnSlnGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/._prccode.h0000400000175000017500000000452210441150525014522 0ustar jfsjfsMac OS X  2 R TEXTR*ch`an prccode.htrol PanelTCmr.txt.docTEXTR*ch p) U " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH MonacoO O ;nS \nGXJB"BBST.MWBB:MPSRF">Fclips-6.24/clipssrc/._emathfun.h0000400000175000017500000000012207422634640014714 0ustar jfsjfsMac OS X  2 RTEXT???? clips-6.24/clipssrc/dffctbsc.h0000755000175000017500000000564710441111645014472 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFFACTS BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements core commands for the deffacts */ /* construct such as clear, reset, save, undeffacts, */ /* ppdeffacts, list-deffacts, and get-deffacts-list. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_dffctbsc #define _H_dffctbsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _DFFCTBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetDeffactsList(theEnv,a,b) EnvGetDeffactsList(theEnv,a,b) #define ListDeffacts(theEnv,a,b) EnvListDeffacts(theEnv,a,b) #define Undeffacts(theEnv,a) EnvUndeffacts(theEnv,a) #else #define GetDeffactsList(a,b) EnvGetDeffactsList(GetCurrentEnvironment(),a,b) #define ListDeffacts(a,b) EnvListDeffacts(GetCurrentEnvironment(),a,b) #define Undeffacts(a) EnvUndeffacts(GetCurrentEnvironment(),a) #endif LOCALE void DeffactsBasicCommands(void *); LOCALE void UndeffactsCommand(void *); LOCALE intBool EnvUndeffacts(void *,void *); LOCALE void GetDeffactsListFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetDeffactsList(void *,DATA_OBJECT_PTR,void *); LOCALE void *DeffactsModuleFunction(void *); LOCALE void PPDeffactsCommand(void *); LOCALE int PPDeffacts(void *,char *,char *); LOCALE void ListDeffactsCommand(void *); LOCALE void EnvListDeffacts(void *,char *,void *); #endif clips-6.24/clipssrc/._classfun.c0000400000175000017500000000075410441602057014721 0ustar jfsjfsMac OS X  2 RTEXT???? aTTFH Monacov67v67qTTFL'FMPSRMWBBLclips-6.24/clipssrc/globlcom.h0000755000175000017500000000462310441143630014502 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFGLOBAL COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_globlcom #define _H_globlcom #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetResetGlobals(theEnv) EnvGetResetGlobals(theEnv) #define SetResetGlobals(theEnv,a) EnvSetResetGlobals(theEnv,a) #define ShowDefglobals(theEnv,a,b) EnvShowDefglobals(theEnv,a,b) #else #define GetResetGlobals() EnvGetResetGlobals(GetCurrentEnvironment()) #define SetResetGlobals(a) EnvSetResetGlobals(GetCurrentEnvironment(),a) #define ShowDefglobals(a,b) EnvShowDefglobals(GetCurrentEnvironment(),a,b) #endif LOCALE void DefglobalCommandDefinitions(void *); LOCALE int SetResetGlobalsCommand(void *); LOCALE intBool EnvSetResetGlobals(void *,int); LOCALE int GetResetGlobalsCommand(void *); LOCALE intBool EnvGetResetGlobals(void *); LOCALE void ShowDefglobalsCommand(void *); LOCALE void EnvShowDefglobals(void *,char *,void *); #endif clips-6.24/clipssrc/._constrct.c0000400000175000017500000000075410441164404014741 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco00S4llTTFHUFMWBBMPSRclips-6.24/clipssrc/dfinsbin.h0000755000175000017500000000350507422634673014517 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_dfinsbin #define _H_dfinsbin #if DEFINSTANCES_CONSTRUCT && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #ifndef _H_defins #include "defins.h" #endif #define DFINSBIN_DATA 25 struct definstancesBinaryData { DEFINSTANCES *DefinstancesArray; long DefinstancesCount; long ModuleCount; DEFINSTANCES_MODULE *ModuleArray; }; #define DefinstancesBinaryData(theEnv) ((struct definstancesBinaryData *) GetEnvironmentData(theEnv,DFINSBIN_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _DFINSBIN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void SetupDefinstancesBload(void *); LOCALE void *BloadDefinstancesModuleRef(void *,int); #ifndef _DFINSBIN_SOURCE_ #endif #endif #endif clips-6.24/clipssrc/classexm.h0000755000175000017500000001072710441130063014521 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 07/01/05 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: The DescribeClass macros were incorrectly */ /* defined. DR0862 */ /* */ /* Added allowed-classes slot facet. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_classexm #define _H_classexm #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSEXM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define BrowseClasses(theEnv,a,b) EnvBrowseClasses(theEnv,a,b) #define DescribeClass(theEnv,a,b) EnvDescribeClass(theEnv,a,b) #define SlotDirectAccessP(theEnv,a,b) EnvSlotDirectAccessP(theEnv,a,b) #define SlotExistP(theEnv,a,b,c) EnvSlotExistP(theEnv,a,b,c) #define SlotInitableP(theEnv,a,b) EnvSlotInitableP(theEnv,a,b) #define SlotPublicP(theEnv,a,b) EnvSlotPublicP(theEnv,a,b) #define SlotWritableP(theEnv,a,b) EnvSlotWritableP(theEnv,a,b) #define SubclassP(theEnv,a,b) EnvSubclassP(theEnv,a,b) #define SuperclassP(theEnv,a,b) EnvSuperclassP(theEnv,a,b) #define SlotDefaultValue(theEnv,a,b,c) EnvSlotDefaultValue(theEnv,a,b,c) #else #define BrowseClasses(a,b) EnvBrowseClasses(GetCurrentEnvironment(),a,b) #define DescribeClass(a,b) EnvDescribeClass(GetCurrentEnvironment(),a,b) #define SlotDirectAccessP(a,b) EnvSlotDirectAccessP(GetCurrentEnvironment(),a,b) #define SlotExistP(a,b,c) EnvSlotExistP(GetCurrentEnvironment(),a,b,c) #define SlotInitableP(a,b) EnvSlotInitableP(GetCurrentEnvironment(),a,b) #define SlotPublicP(a,b) EnvSlotPublicP(GetCurrentEnvironment(),a,b) #define SlotWritableP(a,b) EnvSlotWritableP(GetCurrentEnvironment(),a,b) #define SubclassP(a,b) EnvSubclassP(GetCurrentEnvironment(),a,b) #define SuperclassP(a,b) EnvSuperclassP(GetCurrentEnvironment(),a,b) #define SlotDefaultValue(a,b,c) EnvSlotDefaultValue(GetCurrentEnvironment(),a,b,c) #endif #if DEBUGGING_FUNCTIONS LOCALE void BrowseClassesCommand(void *); LOCALE void EnvBrowseClasses(void *,char *,void *); LOCALE void DescribeClassCommand(void *); LOCALE void EnvDescribeClass(void *,char *,void *); #endif LOCALE char *GetCreateAccessorString(void *); LOCALE void *GetDefclassModuleCommand(void *); LOCALE intBool SuperclassPCommand(void *); LOCALE intBool EnvSuperclassP(void *,void *,void *); LOCALE intBool SubclassPCommand(void *); LOCALE intBool EnvSubclassP(void *,void *,void *); LOCALE int SlotExistPCommand(void *); LOCALE intBool EnvSlotExistP(void *,void *,char *,intBool); LOCALE int MessageHandlerExistPCommand(void *); LOCALE intBool SlotWritablePCommand(void *); LOCALE intBool EnvSlotWritableP(void *,void *,char *); LOCALE intBool SlotInitablePCommand(void *); LOCALE intBool EnvSlotInitableP(void *,void *,char *); LOCALE intBool SlotPublicPCommand(void *); LOCALE intBool EnvSlotPublicP(void *,void *,char *); LOCALE intBool SlotDirectAccessPCommand(void *); LOCALE intBool EnvSlotDirectAccessP(void *,void *,char *); LOCALE void SlotDefaultValueCommand(void *,DATA_OBJECT_PTR); LOCALE intBool EnvSlotDefaultValue(void *,void *,char *,DATA_OBJECT_PTR); LOCALE int ClassExistPCommand(void *); #ifndef _CLASSEXM_SOURCE_ #endif #endif clips-6.24/clipssrc/clsltpsr.c0000755000175000017500000010166010441130250014536 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* CLASS PARSER MODULE */ /*******************************************************/ /**************************************************************/ /* Purpose: Parsing Routines for Defclass Construct */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /**************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include "setup.h" #if OBJECT_SYSTEM && (! BLOAD_ONLY) && (! RUN_TIME) #include #include "classcom.h" #include "classfun.h" #include "cstrnchk.h" #include "cstrnpsr.h" #include "cstrnutl.h" #include "default.h" #include "envrnmnt.h" #include "insfun.h" #include "memalloc.h" #include "prntutil.h" #include "router.h" #include "scanner.h" #define _CLSLTPSR_SOURCE_ #include "clsltpsr.h" /* ========================================= ***************************************** CONSTANTS ========================================= ***************************************** */ #define DEFAULT_FACET "default" #define DYNAMIC_FACET "default-dynamic" #define VARIABLE_VAR "VARIABLE" #define STORAGE_FACET "storage" #define SLOT_SHARE_RLN "shared" #define SLOT_LOCAL_RLN "local" #define ACCESS_FACET "access" #define SLOT_RDONLY_RLN "read-only" #define SLOT_RDWRT_RLN "read-write" #define SLOT_INIT_RLN "initialize-only" #define PROPAGATION_FACET "propagation" #define SLOT_NO_INH_RLN "no-inherit" #define SLOT_INH_RLN "inherit" #define SOURCE_FACET "source" #define SLOT_COMPOSITE_RLN "composite" #define SLOT_EXCLUSIVE_RLN "exclusive" #define MATCH_FACET MATCH_RLN #define SLOT_REACTIVE_RLN REACTIVE_RLN #define SLOT_NONREACTIVE_RLN NONREACTIVE_RLN #define VISIBILITY_FACET "visibility" #define SLOT_PUBLIC_RLN "public" #define SLOT_PRIVATE_RLN "private" #define CREATE_ACCESSOR_FACET "create-accessor" #define SLOT_READ_RLN "read" #define SLOT_WRITE_RLN "write" #define SLOT_NONE_RLN "NONE" #define OVERRIDE_MSG_FACET "override-message" #define SLOT_DEFAULT_RLN "DEFAULT" #define STORAGE_BIT 0 #define FIELD_BIT 1 #define ACCESS_BIT 2 #define PROPAGATION_BIT 3 #define SOURCE_BIT 4 #define MATCH_BIT 5 #define DEFAULT_BIT 6 #define DEFAULT_DYNAMIC_BIT 7 #define VISIBILITY_BIT 8 #define CREATE_ACCESSOR_BIT 9 #define OVERRIDE_MSG_BIT 10 /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ static SLOT_DESC *NewSlot(void *,SYMBOL_HN *); static TEMP_SLOT_LINK *InsertSlot(void *,TEMP_SLOT_LINK *,SLOT_DESC *); static int ParseSimpleFacet(void *,char *,char*,char *,int,char *,char *,char *,char *,SYMBOL_HN **); static intBool ParseDefaultFacet(void *,char *,char *,SLOT_DESC *); static void BuildCompositeFacets(void *,SLOT_DESC *,PACKED_CLASS_LINKS *,char *, CONSTRAINT_PARSE_RECORD *); static intBool CheckForFacetConflicts(void *,SLOT_DESC *,CONSTRAINT_PARSE_RECORD *); static intBool EvaluateSlotDefaultValue(void *,SLOT_DESC *,char *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************ NAME : ParseSlot DESCRIPTION : Parses slot definitions for a defclass statement INPUTS : 1) The logical name of the input source 2) The current slot list 3) The class precedence list for the class to which this slot is being attached (used to find facets for composite slots) 4) A flag indicating if this is a multifield slot or not 5) A flag indicating if the type of slot (single or multi) was explicitly specified or not RETURNS : The address of the list of slots, NULL if there was an error SIDE EFFECTS : The slot list is allocated NOTES : Assumes "(slot" has already been parsed. ************************************************************/ globle TEMP_SLOT_LINK *ParseSlot( void *theEnv, char *readSource, TEMP_SLOT_LINK *slist, PACKED_CLASS_LINKS *preclist, int multiSlot, int fieldSpecified) { SLOT_DESC *slot; CONSTRAINT_PARSE_RECORD parsedConstraint; char specbits[2]; int rtnCode; SYMBOL_HN *newOverrideMsg; /* =============================================================== Bits in specbits are when slot qualifiers are specified so that duplicate or conflicting qualifiers can be detected. Shared/local bit-0 Single/multiple bit-1 Read-only/Read-write/Initialize-Only bit-2 Inherit/No-inherit bit-3 Composite/Exclusive bit-4 Reactive/Nonreactive bit-5 Default bit-6 Default-dynamic bit-7 Visibility bit-8 Override-message bit-9 =============================================================== */ SavePPBuffer(theEnv," "); specbits[0] = specbits[1] = '\0'; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { DeleteSlots(theEnv,slist); SyntaxErrorMessage(theEnv,"defclass slot"); return(NULL); } if ((DefclassData(theEnv)->ObjectParseToken.value == (void *) DefclassData(theEnv)->ISA_SYMBOL) || (DefclassData(theEnv)->ObjectParseToken.value == (void *) DefclassData(theEnv)->NAME_SYMBOL)) { DeleteSlots(theEnv,slist); SyntaxErrorMessage(theEnv,"defclass slot"); return(NULL); } slot = NewSlot(theEnv,(SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken)); slist = InsertSlot(theEnv,slist,slot); if (slist == NULL) return(NULL); if (multiSlot) slot->multiple = TRUE; if (fieldSpecified) SetBitMap(specbits,FIELD_BIT); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); IncrementIndentDepth(theEnv,3); InitializeConstraintParseRecord(&parsedConstraint); while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,"("); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defclass slot"); goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DEFAULT_FACET) == 0) { if (ParseDefaultFacet(theEnv,readSource,specbits,slot) == FALSE) goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DYNAMIC_FACET) == 0) { SetBitMap(specbits,DEFAULT_DYNAMIC_BIT); if (ParseDefaultFacet(theEnv,readSource,specbits,slot) == FALSE) goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),ACCESS_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,ACCESS_FACET,ACCESS_BIT, SLOT_RDWRT_RLN,SLOT_RDONLY_RLN,SLOT_INIT_RLN, NULL,NULL); if (rtnCode == -1) goto ParseSlotError; else if (rtnCode == 1) slot->noWrite = 1; else if (rtnCode == 2) slot->initializeOnly = 1; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),STORAGE_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,STORAGE_FACET,STORAGE_BIT, SLOT_LOCAL_RLN,SLOT_SHARE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->shared = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),PROPAGATION_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,PROPAGATION_FACET,PROPAGATION_BIT, SLOT_INH_RLN,SLOT_NO_INH_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->noInherit = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SOURCE_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,SOURCE_FACET,SOURCE_BIT, SLOT_EXCLUSIVE_RLN,SLOT_COMPOSITE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->composite = rtnCode; } #if DEFRULE_CONSTRUCT else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MATCH_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,MATCH_FACET,MATCH_BIT, SLOT_NONREACTIVE_RLN,SLOT_REACTIVE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->reactive = rtnCode; } #endif else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),VISIBILITY_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,VISIBILITY_FACET,VISIBILITY_BIT, SLOT_PRIVATE_RLN,SLOT_PUBLIC_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->publicVisibility = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),CREATE_ACCESSOR_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,CREATE_ACCESSOR_FACET, CREATE_ACCESSOR_BIT, SLOT_READ_RLN,SLOT_WRITE_RLN,SLOT_RDWRT_RLN, SLOT_NONE_RLN,NULL); if (rtnCode == -1) goto ParseSlotError; if ((rtnCode == 0) || (rtnCode == 2)) slot->createReadAccessor = TRUE; if ((rtnCode == 1) || (rtnCode == 2)) slot->createWriteAccessor = TRUE; } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),OVERRIDE_MSG_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,readSource,specbits,OVERRIDE_MSG_FACET,OVERRIDE_MSG_BIT, NULL,NULL,NULL,SLOT_DEFAULT_RLN,&newOverrideMsg); if (rtnCode == -1) goto ParseSlotError; if (rtnCode == 4) { DecrementSymbolCount(theEnv,slot->overrideMessage); slot->overrideMessage = newOverrideMsg; IncrementSymbolCount(slot->overrideMessage); } slot->overrideMessageSpecified = TRUE; } else if (StandardConstraint(DOToString(DefclassData(theEnv)->ObjectParseToken))) { if (ParseStandardConstraint(theEnv,readSource,DOToString(DefclassData(theEnv)->ObjectParseToken), slot->constraint,&parsedConstraint,TRUE) == FALSE) goto ParseSlotError; } else { SyntaxErrorMessage(theEnv,"defclass slot"); goto ParseSlotError; } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"defclass slot"); goto ParseSlotError; } if (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE) { if (! TestBitMap(specbits,CREATE_ACCESSOR_BIT)) { slot->createReadAccessor = TRUE; if (! slot->noWrite) { slot->createWriteAccessor = TRUE; } } } if (slot->composite) BuildCompositeFacets(theEnv,slot,preclist,specbits,&parsedConstraint); if (CheckForFacetConflicts(theEnv,slot,&parsedConstraint) == FALSE) goto ParseSlotError; if (CheckConstraintParseConflicts(theEnv,slot->constraint) == FALSE) goto ParseSlotError; if (EvaluateSlotDefaultValue(theEnv,slot,specbits) == FALSE) goto ParseSlotError; if ((slot->dynamicDefault == 0) && (slot->noWrite == 1) && (slot->initializeOnly == 0)) slot->shared = 1; slot->constraint = AddConstraint(theEnv,slot->constraint); DecrementIndentDepth(theEnv,3); return(slist); ParseSlotError: DecrementIndentDepth(theEnv,3); DeleteSlots(theEnv,slist); return(NULL); } /*************************************************** NAME : DeleteSlots DESCRIPTION : Deallocates a list of slots and their values INPUTS : The address of the slot list RETURNS : Nothing useful SIDE EFFECTS : The slot list is destroyed NOTES : None ***************************************************/ globle void DeleteSlots( void *theEnv, TEMP_SLOT_LINK *slots) { TEMP_SLOT_LINK *stmp; while (slots != NULL) { stmp = slots; slots = slots->nxt; DeleteSlotName(theEnv,stmp->desc->slotName); DecrementSymbolCount(theEnv,stmp->desc->overrideMessage); RemoveConstraint(theEnv,stmp->desc->constraint); if (stmp->desc->dynamicDefault == 1) { ExpressionDeinstall(theEnv,(EXPRESSION *) stmp->desc->defaultValue); ReturnPackedExpression(theEnv,(EXPRESSION *) stmp->desc->defaultValue); } else if (stmp->desc->defaultValue != NULL) { ValueDeinstall(theEnv,(DATA_OBJECT *) stmp->desc->defaultValue); rtn_struct(theEnv,dataObject,stmp->desc->defaultValue); } rtn_struct(theEnv,slotDescriptor,stmp->desc); rtn_struct(theEnv,tempSlotLink,stmp); } } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /************************************************************** NAME : NewSlot DESCRIPTION : Allocates and initalizes a new slot structure INPUTS : The symbolic name of the new slot RETURNS : The address of the new slot SIDE EFFECTS : None NOTES : Also adds symbols of the form get- and put- for slot accessors **************************************************************/ static SLOT_DESC *NewSlot( void *theEnv, SYMBOL_HN *name) { SLOT_DESC *slot; slot = get_struct(theEnv,slotDescriptor); slot->dynamicDefault = 1; slot->defaultSpecified = 0; slot->noDefault = 0; #if DEFRULE_CONSTRUCT slot->reactive = 1; #endif slot->noInherit = 0; slot->noWrite = 0; slot->initializeOnly = 0; slot->shared = 0; slot->multiple = 0; slot->composite = 0; slot->sharedCount = 0; slot->publicVisibility = 0; slot->createReadAccessor = FALSE; slot->createWriteAccessor = FALSE; slot->overrideMessageSpecified = 0; slot->cls = NULL; slot->defaultValue = NULL; slot->constraint = GetConstraintRecord(theEnv); slot->slotName = AddSlotName(theEnv,name,0,FALSE); slot->overrideMessage = slot->slotName->putHandlerName; IncrementSymbolCount(slot->overrideMessage); return(slot); } /********************************************************** NAME : InsertSlot DESCRIPTION : Inserts a slot into the list of slots INPUTS : 1) The current head of the slot list 2) The slot to be inserted RETURNS : The head of the slot list SIDE EFFECTS : The slot is inserted if no errors, otherwise the original list and the new slot are destroyed NOTES : None **********************************************************/ static TEMP_SLOT_LINK *InsertSlot( void *theEnv, TEMP_SLOT_LINK *slist, SLOT_DESC *slot) { TEMP_SLOT_LINK *stmp,*sprv,*tmp; tmp = get_struct(theEnv,tempSlotLink); tmp->desc = slot; tmp->nxt = NULL; if (slist == NULL) slist = tmp; else { stmp = slist; sprv = NULL; while (stmp != NULL) { if (stmp->desc->slotName == slot->slotName) { tmp->nxt = slist; DeleteSlots(theEnv,tmp); PrintErrorID(theEnv,"CLSLTPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Duplicate slots not allowed.\n"); return(NULL); } sprv = stmp; stmp = stmp->nxt; } sprv->nxt = tmp; } return(slist); } /**************************************************************** NAME : ParseSimpleFacet DESCRIPTION : Parses the following facets for a slot: access, source, propagation, storage, pattern-match, visibility and override-message INPUTS : 1) The input logical name 2) The bitmap indicating which facets have already been parsed 3) The name of the facet 4) The bit to test/set in arg #2 for this facet 5) The facet value string which indicates the facet should be false 6) The facet value string which indicates the facet should be TRUE 7) An alternate value string for use when the first two don't match (can be NULL) 7) An alternate value string for use when the first three don't match (can be NULL) (will be an SF_VARIABLE type) 9) A buffer to hold the facet value symbol (can be NULL - only set if args #5 and #6 are both NULL) RETURNS : -1 on errors 0 if first value string matched 1 if second value string matched 2 if alternate value string matched 3 if variable value string matched 4 if facet value buffer was set SIDE EFFECTS : Messages printed on errors Bitmap marked indicating facet was parsed Facet value symbol buffer set, if appropriate NOTES : None *****************************************************************/ static int ParseSimpleFacet( void *theEnv, char *readSource, char *specbits, char *facetName, int testBit, char *clearRelation, char *setRelation, char *alternateRelation, char *varRelation, SYMBOL_HN **facetSymbolicValue) { int rtnCode; if (TestBitMap(specbits,testBit)) { PrintErrorID(theEnv,"CLSLTPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,facetName); EnvPrintRouter(theEnv,WERROR," facet already specified.\n"); return(-1); } SetBitMap(specbits,testBit); SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); /* =============================== Check for the variable relation =============================== */ if (DefclassData(theEnv)->ObjectParseToken.type == SF_VARIABLE) { if ((varRelation == NULL) ? FALSE : (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),varRelation) == 0)) rtnCode = 3; else goto ParseSimpleFacetError; } else { if (DefclassData(theEnv)->ObjectParseToken.type != SYMBOL) goto ParseSimpleFacetError; /* =================================================== If the facet value buffer is non-NULL simply get the value and do not check any relations =================================================== */ if (facetSymbolicValue == NULL) { if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),clearRelation) == 0) rtnCode = 0; else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),setRelation) == 0) rtnCode = 1; else if ((alternateRelation == NULL) ? FALSE : (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),alternateRelation) == 0)) rtnCode = 2; else goto ParseSimpleFacetError; } else { rtnCode = 4; *facetSymbolicValue = (SYMBOL_HN *) DefclassData(theEnv)->ObjectParseToken.value; } } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (DefclassData(theEnv)->ObjectParseToken.type != RPAREN) goto ParseSimpleFacetError; return(rtnCode); ParseSimpleFacetError: SyntaxErrorMessage(theEnv,"slot facet"); return(-1); } /************************************************************* NAME : ParseDefaultFacet DESCRIPTION : Parses the facet for a slot INPUTS : 1) The input logical name 2) The bitmap indicating which facets have already been parsed 3) The slot descriptor to set RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Slot set and parsed facet bitmap set NOTES : Syntax: (default ?NONE|*) (default-dynamic *) *************************************************************/ static intBool ParseDefaultFacet( void *theEnv, char *readSource, char *specbits, SLOT_DESC *slot) { EXPRESSION *tmp; int error,noneSpecified,deriveSpecified; if (TestBitMap(specbits,DEFAULT_BIT)) { PrintErrorID(theEnv,"CLSLTPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"default facet already specified.\n"); return(FALSE); } SetBitMap(specbits,DEFAULT_BIT); error = FALSE; tmp = ParseDefault(theEnv,readSource,1,(int) TestBitMap(specbits,DEFAULT_DYNAMIC_BIT), 0,&noneSpecified,&deriveSpecified,&error); if (error == TRUE) return(FALSE); if (noneSpecified || deriveSpecified) { if (noneSpecified) { slot->noDefault = 1; slot->defaultSpecified = 1; } else ClearBitMap(specbits,DEFAULT_BIT); } else { slot->defaultValue = (void *) PackExpression(theEnv,tmp); ReturnExpression(theEnv,tmp); ExpressionInstall(theEnv,(EXPRESSION *) slot->defaultValue); slot->defaultSpecified = 1; } return(TRUE); } /************************************************************************** NAME : BuildCompositeFacets DESCRIPTION : Composite slots are ones that get their facets from more than one class. By default, the most specific class in object's precedence list specifies the complete set of facets for a slot. The composite facet in a slot allows facets that are not overridden by the most specific class to be obtained from other classes. Since all superclasses are predetermined before creating a new class based on them, this routine need only examine the immediately next most specific class for extra facets. Even if that slot is also composite, the other facets have already been filtered down. If the slot is no-inherit, the next most specific class must be examined. INPUTS : 1) The slot descriptor 2) The class precedence list 3) The bitmap marking which facets were specified in the original slot definition RETURNS : Nothing useful SIDE EFFECTS : Composite slot is updated to reflect facets from a less specific class NOTES : Assumes slot is composite *************************************************************************/ static void BuildCompositeFacets( void *theEnv, SLOT_DESC *sd, PACKED_CLASS_LINKS *preclist, char *specbits, CONSTRAINT_PARSE_RECORD *parsedConstraint) { SLOT_DESC *compslot = NULL; register unsigned i; for (i = 1 ; i < preclist->classCount ; i++) { compslot = FindClassSlot(preclist->classArray[i],sd->slotName->name); if ((compslot != NULL) ? (compslot->noInherit == 0) : FALSE) break; } if (compslot != NULL) { if ((sd->defaultSpecified == 0) && (compslot->defaultSpecified == 1)) { sd->dynamicDefault = compslot->dynamicDefault; sd->noDefault = compslot->noDefault; sd->defaultSpecified = 1; if (compslot->defaultValue != NULL) { if (sd->dynamicDefault) { sd->defaultValue = (void *) PackExpression(theEnv,(EXPRESSION *) compslot->defaultValue); ExpressionInstall(theEnv,(EXPRESSION *) sd->defaultValue); } else { sd->defaultValue = (void *) get_struct(theEnv,dataObject); GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,compslot->defaultValue); ValueInstall(theEnv,(DATA_OBJECT *) sd->defaultValue); } } } if (TestBitMap(specbits,FIELD_BIT) == 0) sd->multiple = compslot->multiple; if (TestBitMap(specbits,STORAGE_BIT) == 0) sd->shared = compslot->shared; if (TestBitMap(specbits,ACCESS_BIT) == 0) { sd->noWrite = compslot->noWrite; sd->initializeOnly = compslot->initializeOnly; } #if DEFRULE_CONSTRUCT if (TestBitMap(specbits,MATCH_BIT) == 0) sd->reactive = compslot->reactive; #endif if (TestBitMap(specbits,VISIBILITY_BIT) == 0) sd->publicVisibility = compslot->publicVisibility; if (TestBitMap(specbits,CREATE_ACCESSOR_BIT) == 0) { sd->createReadAccessor = compslot->createReadAccessor; sd->createWriteAccessor = compslot->createWriteAccessor; } if ((TestBitMap(specbits,OVERRIDE_MSG_BIT) == 0) && compslot->overrideMessageSpecified) { DecrementSymbolCount(theEnv,sd->overrideMessage); sd->overrideMessage = compslot->overrideMessage; IncrementSymbolCount(sd->overrideMessage); sd->overrideMessageSpecified = TRUE; } OverlayConstraint(theEnv,parsedConstraint,sd->constraint,compslot->constraint); } } /*************************************************** NAME : CheckForFacetConflicts DESCRIPTION : Determines if all facets specified (and inherited) for a slot are consistent INPUTS : 1) The slot descriptor 2) The parse record for the type constraints on the slot RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Min and Max fields replaced in constraint for single-field slot NOTES : None ***************************************************/ static intBool CheckForFacetConflicts( void *theEnv, SLOT_DESC *sd, CONSTRAINT_PARSE_RECORD *parsedConstraint) { if (sd->multiple == 0) { if (parsedConstraint->cardinality) { PrintErrorID(theEnv,"CLSLTPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Cardinality facet can only be used with multifield slots\n"); return(FALSE); } else { ReturnExpression(theEnv,sd->constraint->minFields); ReturnExpression(theEnv,sd->constraint->maxFields); sd->constraint->minFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L)); sd->constraint->maxFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L)); } } if (sd->noDefault && sd->noWrite) { PrintErrorID(theEnv,"CLSLTPSR",4,TRUE); EnvPrintRouter(theEnv,WERROR,"read-only slots must have a default value\n"); return(FALSE); } if (sd->noWrite && (sd->createWriteAccessor || sd->overrideMessageSpecified)) { PrintErrorID(theEnv,"CLSLTPSR",5,TRUE); EnvPrintRouter(theEnv,WERROR,"read-only slots cannot have a write accessor\n"); return(FALSE); } if (sd->noInherit && sd->publicVisibility) { PrintErrorID(theEnv,"CLSLTPSR",6,TRUE); EnvPrintRouter(theEnv,WERROR,"no-inherit slots cannot also be public\n"); return(FALSE); } return(TRUE); } /******************************************************************** NAME : EvaluateSlotDefaultValue DESCRIPTION : Checks the default value against the slot constraints and evaluates static default values INPUTS : 1) The slot descriptor 2) The bitmap marking which facets were specified in the original slot definition RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : Static default value expressions deleted and replaced with data object evaluation NOTES : On errors, slot is marked as dynamix so that DeleteSlots() will erase the slot expression ********************************************************************/ static intBool EvaluateSlotDefaultValue( void *theEnv, SLOT_DESC *sd, char *specbits) { DATA_OBJECT temp; int oldce,olddcc,vCode; /* =================================================================== Slot default value expression is marked as dynamic until now so that DeleteSlots() would erase in the event of an error. The delay was so that the evaluation of a static default value could be delayed until all the constraints were parsed. =================================================================== */ if (TestBitMap(specbits,DEFAULT_DYNAMIC_BIT) == 0) sd->dynamicDefault = 0; if (sd->noDefault) return(TRUE); if (sd->dynamicDefault == 0) { if (TestBitMap(specbits,DEFAULT_BIT)) { oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,TRUE); olddcc = EnvSetDynamicConstraintChecking(theEnv,EnvGetStaticConstraintChecking(theEnv)); vCode = EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple, (EXPRESSION *) sd->defaultValue,&temp,TRUE); if (vCode != FALSE) vCode = ValidSlotValue(theEnv,&temp,sd,NULL,"slot default value"); EnvSetDynamicConstraintChecking(theEnv,olddcc); SetExecutingConstruct(theEnv,oldce); if (vCode) { ExpressionDeinstall(theEnv,(EXPRESSION *) sd->defaultValue); ReturnPackedExpression(theEnv,(EXPRESSION *) sd->defaultValue); sd->defaultValue = (void *) get_struct(theEnv,dataObject); GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,&temp); ValueInstall(theEnv,(DATA_OBJECT *) sd->defaultValue); } else { sd->dynamicDefault = 1; return(FALSE); } } else if (sd->defaultSpecified == 0) { sd->defaultValue = (void *) get_struct(theEnv,dataObject); DeriveDefaultFromConstraints(theEnv,sd->constraint, (DATA_OBJECT *) sd->defaultValue,(int) sd->multiple,TRUE); ValueInstall(theEnv,(DATA_OBJECT *) sd->defaultValue); } } else if (EnvGetStaticConstraintChecking(theEnv)) { vCode = ConstraintCheckExpressionChain(theEnv,(EXPRESSION *) sd->defaultValue,sd->constraint); if (vCode != NO_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expression for "); PrintSlot(theEnv,WERROR,sd,NULL,"dynamic default value"); ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0, vCode,sd->constraint,FALSE); return(FALSE); } } return(TRUE); } #endif clips-6.24/clipssrc/objrtmch.h0000755000175000017500000001007510441150445014514 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */ /* DEFRULE_CONSTRUCT. */ /* */ /* Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_objrtmch #define _H_objrtmch #if DEFRULE_CONSTRUCT && OBJECT_SYSTEM #define OBJECT_ASSERT 1 #define OBJECT_RETRACT 2 #define OBJECT_MODIFY 3 #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_expressn #include "expressn.h" #endif #ifndef _H_match #include "match.h" #endif #ifndef _H_network #include "network.h" #endif #ifndef _H_object #include "object.h" #endif #ifndef _H_symbol #include "symbol.h" #endif typedef struct classBitMap { unsigned short maxid; char map[1]; } CLASS_BITMAP; #define ClassBitMapSize(bmp) ((sizeof(CLASS_BITMAP) + \ (sizeof(char) * (bmp->maxid / BITS_PER_BYTE)))) typedef struct slotBitMap { unsigned short maxid; char map[1]; } SLOT_BITMAP; #define SlotBitMapSize(bmp) ((sizeof(SLOT_BITMAP) + \ (sizeof(char) * (bmp->maxid / BITS_PER_BYTE)))) typedef struct objectAlphaNode OBJECT_ALPHA_NODE; typedef struct objectPatternNode { unsigned blocked : 1; unsigned multifieldNode : 1; unsigned endSlot : 1; unsigned whichField : 8; unsigned leaveFields : 8; unsigned long matchTimeTag; unsigned slotNameID; EXPRESSION *networkTest; struct objectPatternNode *nextLevel; struct objectPatternNode *lastLevel; struct objectPatternNode *leftNode; struct objectPatternNode *rightNode; OBJECT_ALPHA_NODE *alphaNode; long bsaveID; } OBJECT_PATTERN_NODE; struct objectAlphaNode { struct patternNodeHeader header; unsigned long matchTimeTag; BITMAP_HN *classbmp,*slotbmp; OBJECT_PATTERN_NODE *patternNode; struct objectAlphaNode *nxtInGroup, *nxtTerminal; long bsaveID; }; typedef struct objectMatchAction { int type; INSTANCE_TYPE *ins; SLOT_BITMAP *slotNameIDs; struct objectMatchAction *nxt; } OBJECT_MATCH_ACTION; #ifdef LOCALE #undef LOCALE #endif #ifdef _OBJRTMCH_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void ObjectMatchDelay(void *,DATA_OBJECT *); LOCALE intBool SetDelayObjectPatternMatching(void *,int); LOCALE intBool GetDelayObjectPatternMatching(void *); LOCALE OBJECT_PATTERN_NODE *ObjectNetworkPointer(void *); LOCALE OBJECT_ALPHA_NODE *ObjectNetworkTerminalPointer(void *); LOCALE void SetObjectNetworkPointer(void *,OBJECT_PATTERN_NODE *); LOCALE void SetObjectNetworkTerminalPointer(void *,OBJECT_ALPHA_NODE *); LOCALE void ObjectNetworkAction(void *,int,INSTANCE_TYPE *,int); LOCALE void ResetObjectMatchTimeTags(void *); #endif #endif clips-6.24/clipssrc/._objrtbld.c0000400000175000017500000000075410441150267014706 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0z0z:TTFS AFMWBBMPSRclips-6.24/clipssrc/._proflfun.h0000400000175000017500000000075410441150657014747 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco0z0z;TTFS tFMWBBMPSRclips-6.24/clipssrc/._genrcbin.c0000400000175000017500000000075410177533441014700 0ustar jfsjfsMac OS X  2 RTEXT????`aTTFH Monaco0z0z$A_Q_Q]yTTFT#!FMWBBMPSRclips-6.24/clipssrc/._proflfun.c0000400000175000017500000000075410441602277014742 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco{&,6{&,6;,,TTFL-*FMPSRMWBBLclips-6.24/clipssrc/._reorder.c0000400000175000017500000000075407673515535014566 0ustar jfsjfsMac OS X  2 RTEXT????`TTFH Monaco0z0zTTFNH,FMWBBMPSRclips-6.24/clipssrc/factmch.h0000755000175000017500000000362207422634760014325 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* FACT MATCH HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_factmch #define _H_factmch #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_factmngr #include "factmngr.h" #endif #ifndef _H_factbld #include "factbld.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _FACTMCH_SOURCE_ #define LOCALE #else #define LOCALE extern #endif LOCALE void FactPatternMatch(void *,struct fact *, struct factPatternNode *,int, struct multifieldMarker *, struct multifieldMarker *); LOCALE void MarkFactPatternForIncrementalReset(void *,struct patternNodeHeader *,int); LOCALE void FactsIncrementalReset(void *); #endif clips-6.24/clipssrc/._factcmp.h0000400000175000017500000000012207422634536014526 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/globlbsc.h0000755000175000017500000000655410441143614014502 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* DEFGLOBAL BASIC COMMANDS HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* Brian L. Donnell */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_globlbsc #define _H_globlbsc #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _GLOBLBSC_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define GetDefglobalList(theEnv,a,b) EnvGetDefglobalList(theEnv,a,b) #define GetDefglobalWatch(theEnv,a) EnvGetDefglobalWatch(theEnv,a) #define ListDefglobals(theEnv,a,b) EnvListDefglobals(theEnv,a,b) #define SetDefglobalWatch(theEnv,a,b) EnvSetDefglobalWatch(theEnv,a,b) #define Undefglobal(theEnv,a) EnvUndefglobal(theEnv,a) #else #define GetDefglobalList(a,b) EnvGetDefglobalList(GetCurrentEnvironment(),a,b) #define GetDefglobalWatch(a) EnvGetDefglobalWatch(GetCurrentEnvironment(),a) #define ListDefglobals(a,b) EnvListDefglobals(GetCurrentEnvironment(),a,b) #define SetDefglobalWatch(a,b) EnvSetDefglobalWatch(GetCurrentEnvironment(),a,b) #define Undefglobal(a) EnvUndefglobal(GetCurrentEnvironment(),a) #endif LOCALE void DefglobalBasicCommands(void *); LOCALE void UndefglobalCommand(void *); LOCALE intBool EnvUndefglobal(void *,void *); LOCALE void GetDefglobalListFunction(void *,DATA_OBJECT_PTR); LOCALE void EnvGetDefglobalList(void *,DATA_OBJECT_PTR,void *); LOCALE void *DefglobalModuleFunction(void *); LOCALE void PPDefglobalCommand(void *); LOCALE int PPDefglobal(void *,char *,char *); LOCALE void ListDefglobalsCommand(void *); LOCALE void EnvListDefglobals(void *,char *,void *); LOCALE unsigned EnvGetDefglobalWatch(void *,void *); LOCALE void EnvSetDefglobalWatch(void *,unsigned,void *); LOCALE void ResetDefglobals(void *); #ifndef _GLOBLBSC_SOURCE_ extern unsigned WatchGlobals; #endif #endif clips-6.24/clipssrc/objbin.c0000755000175000017500000016035410441073050014144 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 05/17/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: Binary Load/Save Functions for Classes and their */ /* message-handlers */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.24: Removed IMPERATIVE_MESSAGE_HANDLERS and */ /* AUXILIARY_MESSAGE_HANDLERS compilation flags. */ /* */ /*************************************************************/ /* ========================================= ***************************************** EXTERNAL DEFINITIONS ========================================= ***************************************** */ #include #include "setup.h" #if OBJECT_SYSTEM && (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) #include "bload.h" #include "bsave.h" #include "classcom.h" #include "classfun.h" #include "classini.h" #include "cstrcbin.h" #include "cstrnbin.h" #include "envrnmnt.h" #include "insfun.h" #include "memalloc.h" #include "modulbin.h" #include "msgcom.h" #include "msgfun.h" #include "prntutil.h" #include "router.h" #define _OBJBIN_SOURCE_ #include "objbin.h" /* ========================================= ***************************************** MACROS AND TYPES ========================================= ***************************************** */ typedef unsigned long UNLN; #define SlotIndex(p) (((p) != NULL) ? (p)->bsaveIndex : -1L) #define SlotNameIndex(p) (p)->bsaveIndex #define LinkPointer(i) (((i) == -1L) ? NULL : (DEFCLASS **) &ObjectBinaryData(theEnv)->LinkArray[i]) #define SlotPointer(i) (((i) == -1L) ? NULL : (SLOT_DESC *) &ObjectBinaryData(theEnv)->SlotArray[i]) #define TemplateSlotPointer(i) (((i) == -1L) ? NULL : (SLOT_DESC **) &ObjectBinaryData(theEnv)->TmpslotArray[i]) #define OrderedSlotPointer(i) (((i) == -1L) ? NULL : (unsigned *) &ObjectBinaryData(theEnv)->MapslotArray[i]) #define SlotNamePointer(i) ((SLOT_NAME *) &ObjectBinaryData(theEnv)->SlotNameArray[i]) #define HandlerPointer(i) (((i) == -1L) ? NULL : (HANDLER *) &ObjectBinaryData(theEnv)->HandlerArray[i]) #define OrderedHandlerPointer(i) (((i) == -1L) ? NULL : (unsigned *) &ObjectBinaryData(theEnv)->MaphandlerArray[i]) typedef struct bsaveDefclassModule { struct bsaveDefmoduleItemHeader header; } BSAVE_DEFCLASS_MODULE; typedef struct bsavePackedClassLinks { unsigned short classCount; long classArray; } BSAVE_PACKED_CLASS_LINKS; typedef struct bsaveDefclass { struct bsaveConstructHeader header; unsigned abstract : 1; unsigned reactive : 1; unsigned system : 1; unsigned short id; BSAVE_PACKED_CLASS_LINKS directSuperclasses, directSubclasses, allSuperclasses; unsigned slotCount,localInstanceSlotCount, instanceSlotCount,maxSlotNameID; unsigned handlerCount; long slots, instanceTemplate, slotNameMap, handlers, scopeMap; } BSAVE_DEFCLASS; typedef struct bsaveSlotName { unsigned id, hashTableIndex; long name, putHandlerName; } BSAVE_SLOT_NAME; typedef struct bsaveSlotDescriptor { unsigned shared : 1; unsigned multiple : 1; unsigned composite : 1; unsigned noInherit : 1; unsigned noWrite : 1; unsigned initializeOnly : 1; unsigned dynamicDefault : 1; unsigned noDefault : 1; unsigned reactive : 1; unsigned publicVisibility : 1; unsigned createReadAccessor : 1; unsigned createWriteAccessor : 1; long cls, slotName, defaultValue, constraint, overrideMessage; } BSAVE_SLOT_DESC; typedef struct bsaveMessageHandler { unsigned system : 1; unsigned type : 2; int minParams, maxParams, localVarCount; long name, cls, actions; } BSAVE_HANDLER; typedef struct handlerBsaveInfo { HANDLER *handlers; unsigned *handlerOrderMap; unsigned handlerCount; } HANDLER_BSAVE_INFO; /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTION HEADERS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE static void BsaveObjectsFind(void *); static void MarkDefclassItems(void *,struct constructHeader *,void *); static void BsaveObjectsExpressions(void *,FILE *); static void BsaveDefaultSlotExpressions(void *,struct constructHeader *,void *); static void BsaveHandlerActionExpressions(void *,struct constructHeader *,void *); static void BsaveStorageObjects(void *,FILE *); static void BsaveObjects(void *,FILE *); static void BsaveDefclass(void *,struct constructHeader *,void *); static void BsaveClassLinks(void *,struct constructHeader *,void *); static void BsaveSlots(void *,struct constructHeader *,void *); static void BsaveTemplateSlots(void *,struct constructHeader *,void *); static void BsaveSlotMap(void *,struct constructHeader *,void *); static void BsaveHandlers(void *,struct constructHeader *,void *); static void BsaveHandlerMap(void *,struct constructHeader *,void *); #endif static void BloadStorageObjects(void *); static void BloadObjects(void *); static void UpdatePrimitiveClassesMap(void *); static void UpdateDefclassModule(void *,void *,long); static void UpdateDefclass(void *,void *,long); static void UpdateLink(void *,void *,long); static void UpdateSlot(void *,void *,long); static void UpdateSlotName(void *,void *,long); static void UpdateTemplateSlot(void *,void *,long); static void UpdateHandler(void *,void *,long); static void ClearBloadObjects(void *); static void DeallocateObjectBinaryData(void *); /* ========================================= ***************************************** EXTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ /*********************************************************** NAME : SetupObjectsBload DESCRIPTION : Initializes data structures and routines for binary loads of generic function constructs INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Routines defined and structures initialized NOTES : None ***********************************************************/ globle void SetupObjectsBload( void *theEnv) { AllocateEnvironmentData(theEnv,OBJECTBIN_DATA,sizeof(struct objectBinaryData),DeallocateObjectBinaryData); AddAbortBloadFunction(theEnv,"defclass",CreateSystemClasses,0); #if BLOAD_AND_BSAVE AddBinaryItem(theEnv,"defclass",0,BsaveObjectsFind,BsaveObjectsExpressions, BsaveStorageObjects,BsaveObjects, BloadStorageObjects,BloadObjects, ClearBloadObjects); #endif #if BLOAD || BLOAD_ONLY AddBinaryItem(theEnv,"defclass",0,NULL,NULL,NULL,NULL, BloadStorageObjects,BloadObjects, ClearBloadObjects); #endif } /*******************************************************/ /* DeallocateObjectBinaryData: Deallocates environment */ /* data for object binary functionality. */ /*******************************************************/ static void DeallocateObjectBinaryData( void *theEnv) { unsigned long space, i; #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME) space = (unsigned long) (sizeof(DEFCLASS_MODULE) * ObjectBinaryData(theEnv)->ModuleCount); if (space != 0) genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->ModuleArray,space); if (ObjectBinaryData(theEnv)->ClassCount != 0) { if (DefclassData(theEnv)->ClassIDMap != NULL) { rm(theEnv,(void *) DefclassData(theEnv)->ClassIDMap,(sizeof(DEFCLASS *) * DefclassData(theEnv)->AvailClassID)); } for (i = 0L ; i < (unsigned long) ObjectBinaryData(theEnv)->SlotCount ; i++) { if ((ObjectBinaryData(theEnv)->SlotArray[i].defaultValue != NULL) && (ObjectBinaryData(theEnv)->SlotArray[i].dynamicDefault == 0)) { rtn_struct(theEnv,dataObject,ObjectBinaryData(theEnv)->SlotArray[i].defaultValue); } } space = (UNLN) (sizeof(DEFCLASS) * ObjectBinaryData(theEnv)->ClassCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->DefclassArray,space); } space = (UNLN) (sizeof(DEFCLASS *) * ObjectBinaryData(theEnv)->LinkCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->LinkArray,space); } space = (UNLN) (sizeof(SLOT_DESC) * ObjectBinaryData(theEnv)->SlotCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->SlotArray,space); } space = (UNLN) (sizeof(SLOT_NAME) * ObjectBinaryData(theEnv)->SlotNameCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->SlotNameArray,space); } space = (UNLN) (sizeof(SLOT_DESC *) * ObjectBinaryData(theEnv)->TemplateSlotCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->TmpslotArray,space); } space = (UNLN) (sizeof(unsigned) * ObjectBinaryData(theEnv)->SlotNameMapCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->MapslotArray,space); } } if (ObjectBinaryData(theEnv)->HandlerCount != 0L) { space = (UNLN) (sizeof(HANDLER) * ObjectBinaryData(theEnv)->HandlerCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->HandlerArray,space); space = (UNLN) (sizeof(unsigned) * ObjectBinaryData(theEnv)->HandlerCount); genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->MaphandlerArray,space); } } #endif } /*************************************************** NAME : BloadDefclassModuleReference DESCRIPTION : Returns a pointer to the appropriate defclass module INPUTS : The index of the module RETURNS : A pointer to the module SIDE EFFECTS : None NOTES : None ***************************************************/ globle void *BloadDefclassModuleReference( void *theEnv, int theIndex) { return ((void *) &ObjectBinaryData(theEnv)->ModuleArray[theIndex]); } /* ========================================= ***************************************** INTERNALLY VISIBLE FUNCTIONS ========================================= ***************************************** */ #if BLOAD_AND_BSAVE /*************************************************************************** NAME : BsaveObjectsFind DESCRIPTION : For all classes and their message-handlers, this routine marks all the needed symbols and system functions. Also, it also counts the number of expression structures needed. INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented for every expression needed Symbols are marked in their structures NOTES : Also sets bsaveIndex for each class (assumes classes will be bsaved in order of binary list) ***************************************************************************/ static void BsaveObjectsFind( void *theEnv) { register unsigned i; SLOT_NAME *snp; /* ======================================================== The counts need to be saved in case a bload is in effect ======================================================== */ SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->ModuleCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->ClassCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->LinkCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->SlotNameCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->SlotCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->TemplateSlotCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->SlotNameMapCount); SaveBloadCount(theEnv,ObjectBinaryData(theEnv)->HandlerCount); ObjectBinaryData(theEnv)->ModuleCount= 0L; ObjectBinaryData(theEnv)->ClassCount = 0L; ObjectBinaryData(theEnv)->SlotCount = 0L; ObjectBinaryData(theEnv)->SlotNameCount = 0L; ObjectBinaryData(theEnv)->LinkCount = 0L; ObjectBinaryData(theEnv)->TemplateSlotCount = 0L; ObjectBinaryData(theEnv)->SlotNameMapCount = 0L; ObjectBinaryData(theEnv)->HandlerCount = 0L; /* ============================================== Mark items needed by defclasses in all modules ============================================== */ ObjectBinaryData(theEnv)->ModuleCount = DoForAllConstructs(theEnv,MarkDefclassItems,DefclassData(theEnv)->DefclassModuleIndex, FALSE,NULL); /* ============================================= Mark items needed by canonicalized slot names ============================================= */ for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) for (snp = DefclassData(theEnv)->SlotNameTable[i] ; snp != NULL ; snp = snp->nxt) { if ((snp->id != ISA_ID) && (snp->id != NAME_ID)) { snp->bsaveIndex = ObjectBinaryData(theEnv)->SlotNameCount++; snp->name->neededSymbol = TRUE; snp->putHandlerName->neededSymbol = TRUE; } } } /*************************************************** NAME : MarkDefclassItems DESCRIPTION : Marks needed items for a defclass INPUTS : 1) The defclass 2) User buffer (ignored) RETURNS : Nothing useful SIDE EFFECTS : Bsave indices set and needed ephemerals marked NOTES : None ***************************************************/ #if IBM_TBC #pragma argsused #endif static void MarkDefclassItems( void *theEnv, struct constructHeader *theDefclass, void *buf) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(buf) #endif DEFCLASS *cls = (DEFCLASS *) theDefclass; register unsigned i; EXPRESSION *tmpexp; MarkConstructHeaderNeededItems(&cls->header,ObjectBinaryData(theEnv)->ClassCount++); ObjectBinaryData(theEnv)->LinkCount += cls->directSuperclasses.classCount + cls->directSubclasses.classCount + cls->allSuperclasses.classCount; #if DEFMODULE_CONSTRUCT cls->scopeMap->neededBitMap = TRUE; #endif /* =================================================== Mark items needed by slot default value expressions =================================================== */ for (i = 0 ; i < cls->slotCount ; i++) { cls->slots[i].bsaveIndex = ObjectBinaryData(theEnv)->SlotCount++; cls->slots[i].overrideMessage->neededSymbol = TRUE; if (cls->slots[i].defaultValue != NULL) { if (cls->slots[i].dynamicDefault) { ExpressionData(theEnv)->ExpressionCount += ExpressionSize((EXPRESSION *) cls->slots[i].defaultValue); MarkNeededItems(theEnv,(EXPRESSION *) cls->slots[i].defaultValue); } else { /* ================================================= Static default values are stotred as data objects and must be converted into expressions ================================================= */ tmpexp = ConvertValueToExpression(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue); ExpressionData(theEnv)->ExpressionCount += ExpressionSize(tmpexp); MarkNeededItems(theEnv,tmpexp); ReturnExpression(theEnv,tmpexp); } } } /* ======================================== Count canonical slots needed by defclass ======================================== */ ObjectBinaryData(theEnv)->TemplateSlotCount += (long) cls->instanceSlotCount; if (cls->instanceSlotCount != 0) ObjectBinaryData(theEnv)->SlotNameMapCount += (long) cls->maxSlotNameID + 1; /* =============================================== Mark items needed by defmessage-handler actions =============================================== */ for (i = 0 ; i < cls->handlerCount ; i++) { cls->handlers[i].name->neededSymbol = TRUE; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(cls->handlers[i].actions); MarkNeededItems(theEnv,cls->handlers[i].actions); } ObjectBinaryData(theEnv)->HandlerCount += (long) cls->handlerCount; } /*************************************************** NAME : BsaveObjectsExpressions DESCRIPTION : Writes out all expressions needed by classes and handlers INPUTS : The file pointer of the binary file RETURNS : Nothing useful SIDE EFFECTS : File updated NOTES : None ***************************************************/ static void BsaveObjectsExpressions( void *theEnv, FILE *fp) { if ((ObjectBinaryData(theEnv)->ClassCount == 0L) && (ObjectBinaryData(theEnv)->HandlerCount == 0L)) return; /* ================================================ Save the defclass slot default value expressions ================================================ */ DoForAllConstructs(theEnv,BsaveDefaultSlotExpressions,DefclassData(theEnv)->DefclassModuleIndex, FALSE,(void *) fp); /* ============================================== Save the defmessage-handler action expressions ============================================== */ DoForAllConstructs(theEnv,BsaveHandlerActionExpressions,DefclassData(theEnv)->DefclassModuleIndex, FALSE,(void *) fp); } /*************************************************** NAME : BsaveDefaultSlotExpressions DESCRIPTION : Writes expressions for default slot values to binary file INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Slot value expressions written NOTES : None ***************************************************/ static void BsaveDefaultSlotExpressions( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; register unsigned i; EXPRESSION *tmpexp; for (i = 0 ; i < cls->slotCount ; i++) { if (cls->slots[i].defaultValue != NULL) { if (cls->slots[i].dynamicDefault) BsaveExpression(theEnv,(EXPRESSION *) cls->slots[i].defaultValue,(FILE *) buf); else { /* ================================================= Static default values are stotred as data objects and must be converted into expressions ================================================= */ tmpexp = ConvertValueToExpression(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue); BsaveExpression(theEnv,tmpexp,(FILE *) buf); ReturnExpression(theEnv,tmpexp); } } } } /*************************************************** NAME : BsaveHandlerActionExpressions DESCRIPTION : Writes expressions for handler actions to binary file INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Handler actions expressions written NOTES : None ***************************************************/ static void BsaveHandlerActionExpressions( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; register unsigned i; for (i = 0 ; i < cls->handlerCount ; i++) BsaveExpression(theEnv,cls->handlers[i].actions,(FILE *) buf); } /************************************************************************************* NAME : BsaveStorageObjects DESCRIPTION : Writes out number of each type of structure required for COOL Space required for counts (unsigned long) Number of class modules (long) Number of classes (long) Number of links to classes (long) Number of slots (long) Number of instance template slots (long) Number of handlers (long) Number of definstances (long) INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None *************************************************************************************/ static void BsaveStorageObjects( void *theEnv, FILE *fp) { UNLN space; if ((ObjectBinaryData(theEnv)->ClassCount == 0L) && (ObjectBinaryData(theEnv)->HandlerCount == 0L)) { space = 0L; GenWrite((void *) &space,(UNLN) sizeof(long),fp); return; } space = sizeof(long) * 9; GenWrite((void *) &space,(UNLN) sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->ModuleCount,(UNLN) sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->ClassCount,(UNLN) sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->LinkCount,(UNLN) sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->SlotNameCount,(UNLN) sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->SlotCount,(UNLN) sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->TemplateSlotCount,(UNLN) sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->SlotNameMapCount,(UNLN) sizeof(long),fp); GenWrite((void *) &ObjectBinaryData(theEnv)->HandlerCount,(UNLN) sizeof(long),fp); space = (UNLN) DefclassData(theEnv)->MaxClassID; GenWrite((void *) &space,(UNLN) sizeof(long),fp); } /************************************************************************************* NAME : BsaveObjects DESCRIPTION : Writes out classes and message-handlers in binary format Space required (unsigned long) Followed by the data structures in order INPUTS : File pointer of binary file RETURNS : Nothing useful SIDE EFFECTS : Binary file adjusted NOTES : None *************************************************************************************/ static void BsaveObjects( void *theEnv, FILE *fp) { UNLN space; struct defmodule *theModule; DEFCLASS_MODULE *theModuleItem; BSAVE_DEFCLASS_MODULE dummy_mitem; BSAVE_SLOT_NAME dummy_slot_name; SLOT_NAME *snp; register unsigned i; if ((ObjectBinaryData(theEnv)->ClassCount == 0L) && (ObjectBinaryData(theEnv)->HandlerCount == 0L)) { space = 0L; GenWrite((void *) &space,(UNLN) sizeof(UNLN),fp); return; } space = (ObjectBinaryData(theEnv)->ModuleCount * (UNLN) sizeof(BSAVE_DEFCLASS_MODULE)) + (ObjectBinaryData(theEnv)->ClassCount * (UNLN) sizeof(BSAVE_DEFCLASS)) + (ObjectBinaryData(theEnv)->LinkCount * (UNLN) sizeof(long)) + (ObjectBinaryData(theEnv)->SlotCount * (UNLN) sizeof(BSAVE_SLOT_DESC)) + (ObjectBinaryData(theEnv)->SlotNameCount * (UNLN) sizeof(BSAVE_SLOT_NAME)) + (ObjectBinaryData(theEnv)->TemplateSlotCount * (UNLN) sizeof(long)) + (ObjectBinaryData(theEnv)->SlotNameMapCount * (UNLN) sizeof(unsigned)) + (ObjectBinaryData(theEnv)->HandlerCount * (UNLN) sizeof(BSAVE_HANDLER)) + (ObjectBinaryData(theEnv)->HandlerCount * (UNLN) sizeof(unsigned)); GenWrite((void *) &space,(UNLN) sizeof(UNLN),fp); ObjectBinaryData(theEnv)->ClassCount = 0L; ObjectBinaryData(theEnv)->LinkCount = 0L; ObjectBinaryData(theEnv)->SlotCount = 0L; ObjectBinaryData(theEnv)->SlotNameCount = 0L; ObjectBinaryData(theEnv)->TemplateSlotCount = 0L; ObjectBinaryData(theEnv)->SlotNameMapCount = 0L; ObjectBinaryData(theEnv)->HandlerCount = 0L; /* ================================= Write out each defclass module ================================= */ theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); while (theModule != NULL) { theModuleItem = (DEFCLASS_MODULE *) GetModuleItem(theEnv,theModule,FindModuleItem(theEnv,"defclass")->moduleIndex); AssignBsaveDefmdlItemHdrVals(&dummy_mitem.header,&theModuleItem->header); GenWrite((void *) &dummy_mitem,(unsigned long) sizeof(BSAVE_DEFCLASS_MODULE),fp); theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule); } /* ===================== Write out the classes ===================== */ DoForAllConstructs(theEnv,BsaveDefclass,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ========================= Write out the class links ========================= */ ObjectBinaryData(theEnv)->LinkCount = 0L; DoForAllConstructs(theEnv,BsaveClassLinks,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* =============================== Write out the slot name entries =============================== */ for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++) for (snp = DefclassData(theEnv)->SlotNameTable[i] ; snp != NULL ; snp = snp->nxt) { if ((snp->id != ISA_ID) && (snp->id != NAME_ID)) { dummy_slot_name.id = snp->id; dummy_slot_name.hashTableIndex = snp->hashTableIndex; dummy_slot_name.name = (long) snp->name->bucket; dummy_slot_name.putHandlerName = (long) snp->putHandlerName->bucket; GenWrite((void *) &dummy_slot_name,(UNLN) sizeof(BSAVE_SLOT_NAME),fp); } } /* =================== Write out the slots =================== */ DoForAllConstructs(theEnv,BsaveSlots,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ===================================== Write out the template instance slots ===================================== */ DoForAllConstructs(theEnv,BsaveTemplateSlots,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ============================================= Write out the ordered instance slot name maps ============================================= */ DoForAllConstructs(theEnv,BsaveSlotMap,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ============================== Write out the message-handlers ============================== */ DoForAllConstructs(theEnv,BsaveHandlers,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); /* ========================================== Write out the ordered message-handler maps ========================================== */ DoForAllConstructs(theEnv,BsaveHandlerMap,DefclassData(theEnv)->DefclassModuleIndex,FALSE,(void *) fp); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->ModuleCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->ClassCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->LinkCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->SlotCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->SlotNameCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->TemplateSlotCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->SlotNameMapCount); RestoreBloadCount(theEnv,&ObjectBinaryData(theEnv)->HandlerCount); } /*************************************************** NAME : BsaveDefclass DESCRIPTION : Writes defclass binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass binary data written NOTES : None ***************************************************/ static void BsaveDefclass( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; BSAVE_DEFCLASS dummy_class; AssignBsaveConstructHeaderVals(&dummy_class.header,&cls->header); dummy_class.abstract = cls->abstract; dummy_class.reactive = cls->reactive; dummy_class.system = cls->system; dummy_class.id = cls->id; dummy_class.slotCount = cls->slotCount; dummy_class.instanceSlotCount = cls->instanceSlotCount; dummy_class.localInstanceSlotCount = cls->localInstanceSlotCount; dummy_class.maxSlotNameID = cls->maxSlotNameID; dummy_class.handlerCount = cls->handlerCount; dummy_class.directSuperclasses.classCount = cls->directSuperclasses.classCount; dummy_class.directSubclasses.classCount = cls->directSubclasses.classCount; dummy_class.allSuperclasses.classCount = cls->allSuperclasses.classCount; if (cls->directSuperclasses.classCount != 0) { dummy_class.directSuperclasses.classArray = ObjectBinaryData(theEnv)->LinkCount; ObjectBinaryData(theEnv)->LinkCount += cls->directSuperclasses.classCount; } else dummy_class.directSuperclasses.classArray = -1L; if (cls->directSubclasses.classCount != 0) { dummy_class.directSubclasses.classArray = ObjectBinaryData(theEnv)->LinkCount; ObjectBinaryData(theEnv)->LinkCount += cls->directSubclasses.classCount; } else dummy_class.directSubclasses.classArray = -1L; if (cls->allSuperclasses.classCount != 0) { dummy_class.allSuperclasses.classArray = ObjectBinaryData(theEnv)->LinkCount; ObjectBinaryData(theEnv)->LinkCount += cls->allSuperclasses.classCount; } else dummy_class.allSuperclasses.classArray = -1L; if (cls->slots != NULL) { dummy_class.slots = ObjectBinaryData(theEnv)->SlotCount; ObjectBinaryData(theEnv)->SlotCount += (long) cls->slotCount; } else dummy_class.slots = -1L; if (cls->instanceTemplate != NULL) { dummy_class.instanceTemplate = ObjectBinaryData(theEnv)->TemplateSlotCount; ObjectBinaryData(theEnv)->TemplateSlotCount += (long) cls->instanceSlotCount; dummy_class.slotNameMap = ObjectBinaryData(theEnv)->SlotNameMapCount; ObjectBinaryData(theEnv)->SlotNameMapCount += (long) cls->maxSlotNameID + 1; } else { dummy_class.instanceTemplate = -1L; dummy_class.slotNameMap = -1L; } if (cls->handlers != NULL) { dummy_class.handlers = ObjectBinaryData(theEnv)->HandlerCount; ObjectBinaryData(theEnv)->HandlerCount += (long) cls->handlerCount; } else dummy_class.handlers = -1L; #if DEFMODULE_CONSTRUCT dummy_class.scopeMap = (long) cls->scopeMap->bucket; #else dummy_class.scopeMap = -1L; #endif GenWrite((void *) &dummy_class,(UNLN) sizeof(BSAVE_DEFCLASS),(FILE *) buf); } /*************************************************** NAME : BsaveClassLinks DESCRIPTION : Writes class links binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass links binary data written NOTES : None ***************************************************/ static void BsaveClassLinks( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; register unsigned i; long dummy_class_index; for (i = 0 ; i < cls->directSuperclasses.classCount ; i++) { dummy_class_index = DefclassIndex(cls->directSuperclasses.classArray[i]); GenWrite((void *) &dummy_class_index,(UNLN) sizeof(long),(FILE *) buf); } ObjectBinaryData(theEnv)->LinkCount += cls->directSuperclasses.classCount; for (i = 0 ; i < cls->directSubclasses.classCount ; i++) { dummy_class_index = DefclassIndex(cls->directSubclasses.classArray[i]); GenWrite((void *) &dummy_class_index,(UNLN) sizeof(long),(FILE *) buf); } ObjectBinaryData(theEnv)->LinkCount += cls->directSubclasses.classCount; for (i = 0 ; i < cls->allSuperclasses.classCount ; i++) { dummy_class_index = DefclassIndex(cls->allSuperclasses.classArray[i]); GenWrite((void *) &dummy_class_index,(UNLN) sizeof(long),(FILE *) buf); } ObjectBinaryData(theEnv)->LinkCount += cls->allSuperclasses.classCount; } /*************************************************** NAME : BsaveSlots DESCRIPTION : Writes class slots binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass slots binary data written NOTES : None ***************************************************/ static void BsaveSlots( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; register unsigned i; BSAVE_SLOT_DESC dummy_slot; SLOT_DESC *sp; EXPRESSION *tmpexp; for (i = 0 ; i < cls->slotCount ; i++) { sp = &cls->slots[i]; dummy_slot.dynamicDefault = sp->dynamicDefault; dummy_slot.noDefault = sp->noDefault; dummy_slot.shared = sp->shared; dummy_slot.multiple = sp->multiple; dummy_slot.composite = sp->composite; dummy_slot.noInherit = sp->noInherit; dummy_slot.noWrite = sp->noWrite; dummy_slot.initializeOnly = sp->initializeOnly; dummy_slot.reactive = sp->reactive; dummy_slot.publicVisibility = sp->publicVisibility; dummy_slot.createReadAccessor = sp->createReadAccessor; dummy_slot.createWriteAccessor = sp->createWriteAccessor; dummy_slot.cls = DefclassIndex(sp->cls); dummy_slot.slotName = SlotNameIndex(sp->slotName); dummy_slot.overrideMessage = (long) sp->overrideMessage->bucket; if (sp->defaultValue != NULL) { dummy_slot.defaultValue = ExpressionData(theEnv)->ExpressionCount; if (sp->dynamicDefault) ExpressionData(theEnv)->ExpressionCount += ExpressionSize((EXPRESSION *) sp->defaultValue); else { tmpexp = ConvertValueToExpression(theEnv,(DATA_OBJECT *) sp->defaultValue); ExpressionData(theEnv)->ExpressionCount += ExpressionSize(tmpexp); ReturnExpression(theEnv,tmpexp); } } else dummy_slot.defaultValue = -1L; dummy_slot.constraint = ConstraintIndex(sp->constraint); GenWrite((void *) &dummy_slot,(UNLN) sizeof(BSAVE_SLOT_DESC),(FILE *) buf); } } /************************************************************** NAME : BsaveTemplateSlots DESCRIPTION : Writes class instance template binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass instance template binary data written NOTES : None **************************************************************/ #if IBM_TBC #pragma argsused #endif static void BsaveTemplateSlots( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; register unsigned i; long tsp; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif for (i = 0 ; i < cls->instanceSlotCount ; i++) { tsp = SlotIndex(cls->instanceTemplate[i]); GenWrite((void *) &tsp,(UNLN) sizeof(long),(FILE *) buf); } } /*************************************************************** NAME : BsaveSlotMap DESCRIPTION : Writes class canonical slot map binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass canonical slot map binary data written NOTES : None ***************************************************************/ #if IBM_TBC #pragma argsused #endif static void BsaveSlotMap( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif if (cls->instanceSlotCount != 0) GenWrite((void *) cls->slotNameMap, (UNLN) (sizeof(unsigned) * (cls->maxSlotNameID + 1)),(FILE *) buf); } /************************************************************ NAME : BsaveHandlers DESCRIPTION : Writes class message-handlers binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass message-handler binary data written NOTES : None ************************************************************/ static void BsaveHandlers( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; register unsigned i; BSAVE_HANDLER dummy_handler; HANDLER *hnd; for (i = 0 ; i < cls->handlerCount ; i++) { hnd = &cls->handlers[i]; dummy_handler.system = hnd->system; dummy_handler.type = hnd->type; dummy_handler.minParams = hnd->minParams; dummy_handler.maxParams = hnd->maxParams; dummy_handler.localVarCount = hnd->localVarCount; dummy_handler.cls = DefclassIndex(hnd->cls); dummy_handler.name = (long) hnd->name->bucket; if (hnd->actions != NULL) { dummy_handler.actions = ExpressionData(theEnv)->ExpressionCount; ExpressionData(theEnv)->ExpressionCount += ExpressionSize(hnd->actions); } else dummy_handler.actions = -1L; GenWrite((void *) &dummy_handler,(UNLN) sizeof(BSAVE_HANDLER),(FILE *) buf); } } /**************************************************************** NAME : BsaveHandlerMap DESCRIPTION : Writes class message-handler map binary data INPUTS : 1) The defclass 2) The binary file pointer RETURNS : Nothing useful SIDE EFFECTS : Defclass message-handler map binary data written NOTES : None ****************************************************************/ #if IBM_TBC #pragma argsused #endif static void BsaveHandlerMap( void *theEnv, struct constructHeader *theDefclass, void *buf) { DEFCLASS *cls = (DEFCLASS *) theDefclass; #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #endif GenWrite((void *) cls->handlerOrderMap, (UNLN) (sizeof(unsigned) * cls->handlerCount),(FILE *) buf); } #endif /*********************************************************************** NAME : BloadStorageObjects DESCRIPTION : This routine reads class and handler information from a binary file in five chunks: Class count Handler count Class array Handler array INPUTS : Notthing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures Bload fails if there are still classes in the system!! ***********************************************************************/ static void BloadStorageObjects( void *theEnv) { UNLN space; long counts[9]; if ((DefclassData(theEnv)->ClassIDMap != NULL) || (DefclassData(theEnv)->MaxClassID != 0)) { SystemError(theEnv,"OBJBIN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } GenReadBinary(theEnv,(void *) &space,(UNLN) sizeof(UNLN)); if (space == 0L) { ObjectBinaryData(theEnv)->ClassCount = ObjectBinaryData(theEnv)->HandlerCount = 0L; return; } GenReadBinary(theEnv,(void *) counts,space); ObjectBinaryData(theEnv)->ModuleCount = counts[0]; ObjectBinaryData(theEnv)->ClassCount = counts[1]; ObjectBinaryData(theEnv)->LinkCount = counts[2]; ObjectBinaryData(theEnv)->SlotNameCount = counts[3]; ObjectBinaryData(theEnv)->SlotCount = counts[4]; ObjectBinaryData(theEnv)->TemplateSlotCount = counts[5]; ObjectBinaryData(theEnv)->SlotNameMapCount = counts[6]; ObjectBinaryData(theEnv)->HandlerCount = counts[7]; DefclassData(theEnv)->MaxClassID = (unsigned short) counts[8]; DefclassData(theEnv)->AvailClassID = (unsigned short) counts[8]; if (ObjectBinaryData(theEnv)->ModuleCount != 0L) { space = (UNLN) (sizeof(DEFCLASS_MODULE) * ObjectBinaryData(theEnv)->ModuleCount); ObjectBinaryData(theEnv)->ModuleArray = (DEFCLASS_MODULE *) genlongalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->ClassCount != 0L) { space = (UNLN) (sizeof(DEFCLASS) * ObjectBinaryData(theEnv)->ClassCount); ObjectBinaryData(theEnv)->DefclassArray = (DEFCLASS *) genlongalloc(theEnv,space); DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) gm2(theEnv,(sizeof(DEFCLASS *) * DefclassData(theEnv)->MaxClassID)); } if (ObjectBinaryData(theEnv)->LinkCount != 0L) { space = (UNLN) (sizeof(DEFCLASS *) * ObjectBinaryData(theEnv)->LinkCount); ObjectBinaryData(theEnv)->LinkArray = (DEFCLASS * *) genlongalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->SlotCount != 0L) { space = (UNLN) (sizeof(SLOT_DESC) * ObjectBinaryData(theEnv)->SlotCount); ObjectBinaryData(theEnv)->SlotArray = (SLOT_DESC *) genlongalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->SlotNameCount != 0L) { space = (UNLN) (sizeof(SLOT_NAME) * ObjectBinaryData(theEnv)->SlotNameCount); ObjectBinaryData(theEnv)->SlotNameArray = (SLOT_NAME *) genlongalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->TemplateSlotCount != 0L) { space = (UNLN) (sizeof(SLOT_DESC *) * ObjectBinaryData(theEnv)->TemplateSlotCount); ObjectBinaryData(theEnv)->TmpslotArray = (SLOT_DESC * *) genlongalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->SlotNameMapCount != 0L) { space = (UNLN) (sizeof(unsigned) * ObjectBinaryData(theEnv)->SlotNameMapCount); ObjectBinaryData(theEnv)->MapslotArray = (unsigned *) genlongalloc(theEnv,space); } if (ObjectBinaryData(theEnv)->HandlerCount != 0L) { space = (UNLN) (sizeof(HANDLER) * ObjectBinaryData(theEnv)->HandlerCount); ObjectBinaryData(theEnv)->HandlerArray = (HANDLER *) genlongalloc(theEnv,space); space = (UNLN) (sizeof(unsigned) * ObjectBinaryData(theEnv)->HandlerCount); ObjectBinaryData(theEnv)->MaphandlerArray = (unsigned *) genlongalloc(theEnv,space); } } /*************************************************************** NAME : BloadObjects DESCRIPTION : This routine moves through the class and handler binary arrays updating pointers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Pointers reset from array indices NOTES : Assumes all loading is finished **************************************************************/ static void BloadObjects( void *theEnv) { UNLN space; GenReadBinary(theEnv,(void *) &space,(UNLN) sizeof(UNLN)); if (space == 0L) return; if (ObjectBinaryData(theEnv)->ModuleCount != 0L) BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->ModuleCount,(unsigned) sizeof(BSAVE_DEFCLASS_MODULE),UpdateDefclassModule); if (ObjectBinaryData(theEnv)->ClassCount != 0L) { BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->ClassCount,(unsigned) sizeof(BSAVE_DEFCLASS),UpdateDefclass); BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->LinkCount,(unsigned) sizeof(DEFCLASS *),UpdateLink); BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->SlotNameCount,(unsigned) sizeof(BSAVE_SLOT_NAME),UpdateSlotName); BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->SlotCount,(unsigned) sizeof(BSAVE_SLOT_DESC),UpdateSlot); if (ObjectBinaryData(theEnv)->TemplateSlotCount != 0L) BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->TemplateSlotCount,(unsigned) sizeof(long),UpdateTemplateSlot); if (ObjectBinaryData(theEnv)->SlotNameMapCount != 0L) { space = (UNLN) (sizeof(unsigned) * ObjectBinaryData(theEnv)->SlotNameMapCount); GenReadBinary(theEnv,(void *) ObjectBinaryData(theEnv)->MapslotArray,space); } if (ObjectBinaryData(theEnv)->HandlerCount != 0L) { BloadandRefresh(theEnv,ObjectBinaryData(theEnv)->HandlerCount,(unsigned) sizeof(BSAVE_HANDLER),UpdateHandler); space = (UNLN) (sizeof(unsigned) * ObjectBinaryData(theEnv)->HandlerCount); GenReadBinary(theEnv,(void *) ObjectBinaryData(theEnv)->MaphandlerArray,space); } UpdatePrimitiveClassesMap(theEnv); } } /*************************************************** NAME : UpdatePrimitiveClassesMap DESCRIPTION : Resets the pointers for the global primitive classes map INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : PrimitiveClassMap pointers set into bload array NOTES : Looks at first nine primitive type codes in the source file CONSTANT.H ***************************************************/ static void UpdatePrimitiveClassesMap( void *theEnv) { register unsigned i; for (i = 0 ; i < OBJECT_TYPE_CODE ; i++) DefclassData(theEnv)->PrimitiveClassMap[i] = (DEFCLASS *) &ObjectBinaryData(theEnv)->DefclassArray[i]; } /********************************************************* Refresh update routines for bsaved COOL structures *********************************************************/ static void UpdateDefclassModule( void *theEnv, void *buf, long obji) { BSAVE_DEFCLASS_MODULE *bdptr; bdptr = (BSAVE_DEFCLASS_MODULE *) buf; UpdateDefmoduleItemHeader(theEnv,&bdptr->header,&ObjectBinaryData(theEnv)->ModuleArray[obji].header, (int) sizeof(DEFCLASS),(void *) ObjectBinaryData(theEnv)->DefclassArray); } static void UpdateDefclass( void *theEnv, void *buf, long obji) { BSAVE_DEFCLASS *bcls; DEFCLASS *cls; bcls = (BSAVE_DEFCLASS *) buf; cls = (DEFCLASS *) &ObjectBinaryData(theEnv)->DefclassArray[obji]; UpdateConstructHeader(theEnv,&bcls->header,&cls->header, (int) sizeof(DEFCLASS_MODULE),(void *) ObjectBinaryData(theEnv)->ModuleArray, (int) sizeof(DEFCLASS),(void *) ObjectBinaryData(theEnv)->DefclassArray); cls->abstract = bcls->abstract; cls->reactive = bcls->reactive; cls->system = bcls->system; cls->id = bcls->id; DefclassData(theEnv)->ClassIDMap[cls->id] = cls; #if DEBUGGING_FUNCTIONS cls->traceInstances = DefclassData(theEnv)->WatchInstances; cls->traceSlots = DefclassData(theEnv)->WatchSlots; #endif cls->slotCount = bcls->slotCount; cls->instanceSlotCount = bcls->instanceSlotCount; cls->localInstanceSlotCount = bcls->localInstanceSlotCount; cls->maxSlotNameID = bcls->maxSlotNameID; cls->handlerCount = bcls->handlerCount; cls->directSuperclasses.classCount =bcls->directSuperclasses.classCount; cls->directSuperclasses.classArray = LinkPointer(bcls->directSuperclasses.classArray); cls->directSubclasses.classCount =bcls->directSubclasses.classCount; cls->directSubclasses.classArray = LinkPointer(bcls->directSubclasses.classArray); cls->allSuperclasses.classCount =bcls->allSuperclasses.classCount; cls->allSuperclasses.classArray = LinkPointer(bcls->allSuperclasses.classArray); cls->slots = SlotPointer(bcls->slots); cls->instanceTemplate = TemplateSlotPointer(bcls->instanceTemplate); cls->slotNameMap = OrderedSlotPointer(bcls->slotNameMap); cls->instanceList = NULL; cls->handlers = HandlerPointer(bcls->handlers); cls->handlerOrderMap = OrderedHandlerPointer(bcls->handlers); cls->installed = 1; cls->busy = 0; cls->instanceList = NULL; cls->instanceListBottom = NULL; #if DEFMODULE_CONSTRUCT cls->scopeMap = BitMapPointer(bcls->scopeMap); IncrementBitMapCount(cls->scopeMap); #else cls->scopeMap = NULL; #endif PutClassInTable(theEnv,cls); } static void UpdateLink( void *theEnv, void *buf, long obji) { long *blink; blink = (long *) buf; ObjectBinaryData(theEnv)->LinkArray[obji] = DefclassPointer(*blink); } static void UpdateSlot( void *theEnv, void *buf, long obji) { SLOT_DESC *sp; BSAVE_SLOT_DESC *bsp; sp = (SLOT_DESC *) &ObjectBinaryData(theEnv)->SlotArray[obji]; bsp = (BSAVE_SLOT_DESC *) buf; sp->dynamicDefault = bsp->dynamicDefault; sp->noDefault = bsp->noDefault; sp->shared = bsp->shared; sp->multiple = bsp->multiple; sp->composite = bsp->composite; sp->noInherit = bsp->noInherit; sp->noWrite = bsp->noWrite; sp->initializeOnly = bsp->initializeOnly; sp->reactive = bsp->reactive; sp->publicVisibility = bsp->publicVisibility; sp->createReadAccessor = bsp->createReadAccessor; sp->createWriteAccessor = bsp->createWriteAccessor; sp->cls = DefclassPointer(bsp->cls); sp->slotName = SlotNamePointer(bsp->slotName); sp->overrideMessage = SymbolPointer(bsp->overrideMessage); IncrementSymbolCount(sp->overrideMessage); if (bsp->defaultValue != -1L) { if (sp->dynamicDefault) sp->defaultValue = (void *) ExpressionPointer(bsp->defaultValue); else { sp->defaultValue = (void *) get_struct(theEnv,dataObject); EvaluateAndStoreInDataObject(theEnv,(int) sp->multiple,ExpressionPointer(bsp->defaultValue), (DATA_OBJECT *) sp->defaultValue,TRUE); ValueInstall(theEnv,(DATA_OBJECT *) sp->defaultValue); } } else sp->defaultValue = NULL; sp->constraint = ConstraintPointer(bsp->constraint); sp->sharedCount = 0; sp->sharedValue.value = NULL; sp->bsaveIndex = 0L; if (sp->shared) { sp->sharedValue.desc = sp; sp->sharedValue.value = NULL; } } static void UpdateSlotName( void *theEnv, void *buf, long obji) { SLOT_NAME *snp; BSAVE_SLOT_NAME *bsnp; bsnp = (BSAVE_SLOT_NAME *) buf; snp = (SLOT_NAME *) &ObjectBinaryData(theEnv)->SlotNameArray[obji]; snp->id = bsnp->id; snp->name = SymbolPointer(bsnp->name); IncrementSymbolCount(snp->name); snp->putHandlerName = SymbolPointer(bsnp->putHandlerName); IncrementSymbolCount(snp->putHandlerName); snp->hashTableIndex = bsnp->hashTableIndex; snp->nxt = DefclassData(theEnv)->SlotNameTable[snp->hashTableIndex]; DefclassData(theEnv)->SlotNameTable[snp->hashTableIndex] = snp; } static void UpdateTemplateSlot( void *theEnv, void *buf, long obji) { ObjectBinaryData(theEnv)->TmpslotArray[obji] = SlotPointer(* (long *) buf); } static void UpdateHandler( void *theEnv, void *buf, long obji) { HANDLER *hnd; BSAVE_HANDLER *bhnd; hnd = (HANDLER *) &ObjectBinaryData(theEnv)->HandlerArray[obji]; bhnd = (BSAVE_HANDLER *) buf; hnd->system = bhnd->system; hnd->type = bhnd->type; hnd->minParams = bhnd->minParams; hnd->maxParams = bhnd->maxParams; hnd->localVarCount = bhnd->localVarCount; hnd->cls = DefclassPointer(bhnd->cls); hnd->name = SymbolPointer(bhnd->name); IncrementSymbolCount(hnd->name); hnd->actions = ExpressionPointer(bhnd->actions); hnd->ppForm = NULL; hnd->busy = 0; hnd->mark = 0; hnd->usrData = NULL; #if DEBUGGING_FUNCTIONS hnd->trace = MessageHandlerData(theEnv)->WatchHandlers; #endif } /*************************************************************** NAME : ClearBloadObjects DESCRIPTION : Release all binary-loaded class and handler structure arrays (and others) INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Memory cleared NOTES : None ***************************************************************/ static void ClearBloadObjects( void *theEnv) { register long i; UNLN space; space = (unsigned long) (sizeof(DEFCLASS_MODULE) * ObjectBinaryData(theEnv)->ModuleCount); if (space == 0L) return; genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->ModuleArray,space); ObjectBinaryData(theEnv)->ModuleArray = NULL; ObjectBinaryData(theEnv)->ModuleCount = 0L; if (ObjectBinaryData(theEnv)->ClassCount != 0L) { rm(theEnv,(void *) DefclassData(theEnv)->ClassIDMap,(sizeof(DEFCLASS *) * DefclassData(theEnv)->AvailClassID)); DefclassData(theEnv)->ClassIDMap = NULL; DefclassData(theEnv)->MaxClassID = 0; DefclassData(theEnv)->AvailClassID = 0; for (i = 0L ; i < ObjectBinaryData(theEnv)->ClassCount ; i++) { UnmarkConstructHeader(theEnv,&ObjectBinaryData(theEnv)->DefclassArray[i].header); #if DEFMODULE_CONSTRUCT DecrementBitMapCount(theEnv,ObjectBinaryData(theEnv)->DefclassArray[i].scopeMap); #endif RemoveClassFromTable(theEnv,(DEFCLASS *) &ObjectBinaryData(theEnv)->DefclassArray[i]); } for (i = 0L ; i < ObjectBinaryData(theEnv)->SlotCount ; i++) { DecrementSymbolCount(theEnv,ObjectBinaryData(theEnv)->SlotArray[i].overrideMessage); if ((ObjectBinaryData(theEnv)->SlotArray[i].defaultValue != NULL) && (ObjectBinaryData(theEnv)->SlotArray[i].dynamicDefault == 0)) { ValueDeinstall(theEnv,(DATA_OBJECT *) ObjectBinaryData(theEnv)->SlotArray[i].defaultValue); rtn_struct(theEnv,dataObject,ObjectBinaryData(theEnv)->SlotArray[i].defaultValue); } } for (i = 0L ; i < ObjectBinaryData(theEnv)->SlotNameCount ; i++) { DefclassData(theEnv)->SlotNameTable[ObjectBinaryData(theEnv)->SlotNameArray[i].hashTableIndex] = NULL; DecrementSymbolCount(theEnv,ObjectBinaryData(theEnv)->SlotNameArray[i].name); DecrementSymbolCount(theEnv,ObjectBinaryData(theEnv)->SlotNameArray[i].putHandlerName); } space = (UNLN) (sizeof(DEFCLASS) * ObjectBinaryData(theEnv)->ClassCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->DefclassArray,space); ObjectBinaryData(theEnv)->DefclassArray = NULL; ObjectBinaryData(theEnv)->ClassCount = 0L; } space = (UNLN) (sizeof(DEFCLASS *) * ObjectBinaryData(theEnv)->LinkCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->LinkArray,space); ObjectBinaryData(theEnv)->LinkArray = NULL; ObjectBinaryData(theEnv)->LinkCount = 0L; } space = (UNLN) (sizeof(SLOT_DESC) * ObjectBinaryData(theEnv)->SlotCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->SlotArray,space); ObjectBinaryData(theEnv)->SlotArray = NULL; ObjectBinaryData(theEnv)->SlotCount = 0L; } space = (UNLN) (sizeof(SLOT_NAME) * ObjectBinaryData(theEnv)->SlotNameCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->SlotNameArray,space); ObjectBinaryData(theEnv)->SlotNameArray = NULL; ObjectBinaryData(theEnv)->SlotNameCount = 0L; } space = (UNLN) (sizeof(SLOT_DESC *) * ObjectBinaryData(theEnv)->TemplateSlotCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->TmpslotArray,space); ObjectBinaryData(theEnv)->TmpslotArray = NULL; ObjectBinaryData(theEnv)->TemplateSlotCount = 0L; } space = (UNLN) (sizeof(unsigned) * ObjectBinaryData(theEnv)->SlotNameMapCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->MapslotArray,space); ObjectBinaryData(theEnv)->MapslotArray = NULL; ObjectBinaryData(theEnv)->SlotNameMapCount = 0L; } } if (ObjectBinaryData(theEnv)->HandlerCount != 0L) { for (i = 0L ; i < ObjectBinaryData(theEnv)->HandlerCount ; i++) DecrementSymbolCount(theEnv,ObjectBinaryData(theEnv)->HandlerArray[i].name); space = (UNLN) (sizeof(HANDLER) * ObjectBinaryData(theEnv)->HandlerCount); if (space != 0L) { genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->HandlerArray,space); ObjectBinaryData(theEnv)->HandlerArray = NULL; space = (UNLN) (sizeof(unsigned) * ObjectBinaryData(theEnv)->HandlerCount); genlongfree(theEnv,(void *) ObjectBinaryData(theEnv)->MaphandlerArray,space); ObjectBinaryData(theEnv)->MaphandlerArray = NULL; ObjectBinaryData(theEnv)->HandlerCount = 0L; } } } #endif clips-6.24/clipssrc/factlhs.c0000755000175000017500000002377210177533437014347 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.22 06/15/04 */ /* */ /* FACT LHS PATTERN PARSING MODULE */ /*******************************************************/ /*************************************************************/ /* Purpose: Contains routines for integration of ordered and */ /* deftemplate fact patterns with the defrule LHS pattern */ /* parser including routines for recognizing fact */ /* patterns, parsing ordered fact patterns, initiating the */ /* parsing of deftemplate fact patterns, and creating the */ /* default initial-fact fact pattern. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #define _FACTLHS_SOURCE_ #include "setup.h" #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) #include #define _STDIO_INCLUDED_ #include "cstrcpsr.h" #include "envrnmnt.h" #include "pattern.h" #include "router.h" #include "reorder.h" #include "tmpltpsr.h" #include "tmpltdef.h" #include "tmpltlhs.h" #include "tmpltutl.h" #include "modulutl.h" #include "modulpsr.h" #include "factlhs.h" /***********************************************/ /* SequenceRestrictionParse: Parses an ordered */ /* fact pattern conditional element. */ /* */ /* */ /* ::= ( +) */ /***********************************************/ globle struct lhsParseNode *SequenceRestrictionParse( void *theEnv, char *readSource, struct token *theToken) { struct lhsParseNode *topNode; struct lhsParseNode *nextField; /*================================================*/ /* Create the pattern node for the relation name. */ /*================================================*/ topNode = GetLHSParseNode(theEnv); topNode->type = SF_WILDCARD; topNode->negated = FALSE; topNode->index = -1; topNode->slotNumber = 1; topNode->bottom = GetLHSParseNode(theEnv); topNode->bottom->type = SYMBOL; topNode->bottom->negated = FALSE; topNode->bottom->value = (void *) theToken->value; /*======================================================*/ /* Connective constraints cannot be used in conjunction */ /* with the first field of a pattern. */ /*======================================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); if ((theToken->type == OR_CONSTRAINT) || (theToken->type == AND_CONSTRAINT)) { ReturnLHSParseNodes(theEnv,topNode); SyntaxErrorMessage(theEnv,"the first field of a pattern"); return(NULL); } /*============================================================*/ /* Treat the remaining constraints of an ordered fact pattern */ /* as if they were contained in a multifield slot. */ /*============================================================*/ nextField = RestrictionParse(theEnv,readSource,theToken,TRUE,NULL,1,NULL,1); if (nextField == NULL) { ReturnLHSParseNodes(theEnv,topNode); return(NULL); } topNode->right = nextField; /*================================================*/ /* The pattern must end with a right parenthesis. */ /*================================================*/ if (theToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken->printForm); SyntaxErrorMessage(theEnv,"fact patterns"); ReturnLHSParseNodes(theEnv,topNode); return(NULL); } /*====================================*/ /* Fix the pretty print output if the */ /* slot contained no restrictions. */ /*====================================*/ if (nextField->bottom == NULL) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } /*===================================*/ /* If no errors, return the pattern. */ /*===================================*/ return(topNode); } /****************************************************************/ /* CreateInitialFactPattern: Creates the pattern (initial-fact) */ /* for use in rules which have no LHS patterns. */ /****************************************************************/ globle struct lhsParseNode *CreateInitialFactPattern( void *theEnv) { struct lhsParseNode *topNode; struct deftemplate *theDeftemplate; int count; /*==================================*/ /* If the initial-fact deftemplate */ /* doesn't exist, then create it. */ /*==================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,"initial-fact", &count,TRUE,NULL); if (theDeftemplate == NULL) { PrintWarningID(theEnv,"FACTLHS",1,FALSE); EnvPrintRouter(theEnv,WWARNING,"Creating implied initial-fact deftemplate in module "); EnvPrintRouter(theEnv,WWARNING,EnvGetDefmoduleName(theEnv,EnvGetCurrentModule(theEnv))); EnvPrintRouter(theEnv,WWARNING,".\n"); EnvPrintRouter(theEnv,WWARNING," You probably want to import this deftemplate from the MAIN module.\n"); CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE); } /*====================================*/ /* Create the (initial-fact) pattern. */ /*====================================*/ topNode = GetLHSParseNode(theEnv); topNode->type = SF_WILDCARD; topNode->index = 0; topNode->slotNumber = 1; topNode->bottom = GetLHSParseNode(theEnv); topNode->bottom->type = SYMBOL; topNode->bottom->value = (void *) EnvAddSymbol(theEnv,"initial-fact"); /*=====================*/ /* Return the pattern. */ /*=====================*/ return(topNode); } /**********************************************************************/ /* FactPatternParserFind: This function is the pattern find function */ /* for facts. It tells the pattern parsing code that the specified */ /* pattern can be parsed as a fact pattern. By default, any pattern */ /* beginning with a symbol can be parsed as a fact pattern. Since */ /* all patterns begin with a symbol, it follows that all patterns */ /* can be parsed as a fact pattern. */ /**********************************************************************/ #if IBM_TBC #pragma argsused #endif globle int FactPatternParserFind( SYMBOL_HN *theRelation) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theRelation) #endif return(TRUE); } /******************************************************/ /* FactPatternParse: This function is called to parse */ /* both deftemplate and ordered fact patterns. */ /******************************************************/ globle struct lhsParseNode *FactPatternParse( void *theEnv, char *readSource, struct token *theToken) { struct deftemplate *theDeftemplate; int count; /*=========================================*/ /* A module separator can not be included */ /* as part of the pattern's relation name. */ /*=========================================*/ if (FindModuleSeparator(ValueToString(theToken->value))) { IllegalModuleSpecifierMessage(theEnv); return(NULL); } /*=========================================================*/ /* Find the deftemplate associated with the relation name. */ /*=========================================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,ValueToString(theToken->value), &count,TRUE,NULL); if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",ValueToString(theToken->value)); return(NULL); } /*======================================================*/ /* If no deftemplate exists with the specified relation */ /* name, then create an implied deftemplate. */ /*======================================================*/ if (theDeftemplate == NULL) { #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,"deftemplate",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(theToken->value))) { ImportExportConflictMessage(theEnv,"implied deftemplate",ValueToString(theToken->value),NULL,NULL); return(NULL); } #endif /* DEFMODULE_CONSTRUCT */ if (! ConstructData(theEnv)->CheckSyntaxMode) { theDeftemplate = CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) theToken->value,TRUE); } else { theDeftemplate = NULL; } } /*===============================================*/ /* If an explicit deftemplate exists, then parse */ /* the pattern as a deftemplate pattern. */ /*===============================================*/ if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE)) { return(DeftemplateLHSParse(theEnv,readSource,theDeftemplate)); } /*================================*/ /* Parse an ordered fact pattern. */ /*================================*/ return(SequenceRestrictionParse(theEnv,readSource,theToken)); } #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) */ clips-6.24/clipssrc/cstrncmp.h0000755000175000017500000000345007422634770014551 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.20 01/31/02 */ /* */ /* CONSTRAINT CONSTRUCTS-TO-C HEADER */ /*******************************************************/ /*************************************************************/ /* Purpose: Implements the constructs-to-c feature for */ /* constraint records. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /*************************************************************/ #ifndef _H_cstrncmp #define _H_cstrncmp #ifndef _H_evaluatn #include "evaluatn.h" #endif #ifndef _H_constrnt #include "constrnt.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CSTRNCMP_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #ifndef _STDIO_INCLUDED_ #define _STDIO_INCLUDED_ #include #endif LOCALE void PrintConstraintReference(void *,FILE *,CONSTRAINT_RECORD *,int,int); LOCALE void ConstraintRecordToCode(FILE *,CONSTRAINT_RECORD *); LOCALE int ConstraintsToCode(void *,char *,int,FILE *,int,int); #endif clips-6.24/clipssrc/._lgcldpnd.c0000400000175000017500000000452210441162373014671 0ustar jfsjfsMac OS X  2 R TEXTR*chn lgcldpnd.crol PanelTCmr.txt.docTEXTR*ch p)\ " @ copy@feed@jnmap@pmap@,qual@rang@psmap@sort@tmap@$BestsGG: US Letter@RsyptPtTD US Letter@@R@base@crea@ flag@unit@syptP@dirm@ layo@scal@ ddunivnoneunivnoneR*chMonaco  Helvetica ConfidentialHH Monaco1i1i9n/B`nGXJB"BBST.MPSR:MWBBF">clips-6.24/clipssrc/._edmisc.c0000400000175000017500000000075410441163261014346 0ustar jfsjfsMac OS X  2 RTEXT???? TTFH MonacoYhYh@ @>TTF/BFMPSRMWBBLclips-6.24/clipssrc/._tmpltfun.h0000400000175000017500000000075410441602344014760 0ustar jfsjfsMac OS X  2 RTEXT????TTFH Monaco1Pe1Pe<yyTTFL0lFMPSRMWBBLclips-6.24/clipssrc/._dffctbin.c0000400000175000017500000000061407673514761014676 0ustar jfsjfsMac OS X  2 R:TEXT????228232MWBB clips-6.24/clipssrc/evaluatn.h0000755000175000017500000002372610441602161014527 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* EVALUATION HEADER FILE */ /*******************************************************/ /*************************************************************/ /* Purpose: Provides routines for evaluating expressions. */ /* */ /* Principal Programmer(s): */ /* Gary D. Riley */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /* Added EvaluateAndStoreInDataObject function. */ /* */ /*************************************************************/ #ifndef _H_evaluatn #define _H_evaluatn struct entityRecord; struct dataObject; #ifndef _H_constant #include "constant.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifndef _H_expressn #include "expressn.h" #endif struct dataObject { void *supplementalInfo; unsigned short type; void *value; long begin; long end; struct dataObject *next; }; typedef struct dataObject DATA_OBJECT; typedef struct dataObject * DATA_OBJECT_PTR; typedef struct expr FUNCTION_REFERENCE; #define DATA_OBJECT_PTR_ARG DATA_OBJECT_PTR #include "userdata.h" struct entityRecord { char *name; unsigned int type : 13; unsigned int copyToEvaluate : 1; unsigned int bitMap : 1; unsigned int addsToRuleComplexity : 1; void (*shortPrintFunction)(void *,char *,void *); void (*longPrintFunction)(void *,char *,void *); intBool (*deleteFunction)(void *,void *); intBool (*evaluateFunction)(void *,void *,DATA_OBJECT *); void *(*getNextFunction)(void *,void *); void (*decrementBusyCount)(void *,void *); void (*incrementBusyCount)(void *,void *); void (*propagateDepth)(void *,void *); void (*markNeeded)(void *,void *); void (*install)(void *,void *); void (*deinstall)(void *,void *); struct userData *usrData; }; typedef struct entityRecord ENTITY_RECORD; typedef struct entityRecord * ENTITY_RECORD_PTR; #define GetDOLength(target) (((target).end - (target).begin) + 1) #define GetpDOLength(target) (((target)->end - (target)->begin) + 1) #define GetDOBegin(target) ((target).begin + 1) #define GetDOEnd(target) ((target).end + 1) #define GetpDOBegin(target) ((target)->begin + 1) #define GetpDOEnd(target) ((target)->end + 1) #define SetDOBegin(target,val) ((target).begin = (long) ((val) - 1)) #define SetDOEnd(target,val) ((target).end = (long) ((val) - 1)) #define SetpDOBegin(target,val) ((target)->begin = (long) ((val) - 1)) #define SetpDOEnd(target,val) ((target)->end = (long) ((val) - 1)) #define EnvGetDOLength(theEnv,target) (((target).end - (target).begin) + 1) #define EnvGetpDOLength(theEnv,target) (((target)->end - (target)->begin) + 1) #define EnvGetDOBegin(theEnv,target) ((target).begin + 1) #define EnvGetDOEnd(theEnv,target) ((target).end + 1) #define EnvGetpDOBegin(theEnv,target) ((target)->begin + 1) #define EnvGetpDOEnd(theEnv,target) ((target)->end + 1) #define EnvSetDOBegin(theEnv,target,val) ((target).begin = (long) ((val) - 1)) #define EnvSetDOEnd(theEnv,target,val) ((target).end = (long) ((val) - 1)) #define EnvSetpDOBegin(theEnv,target,val) ((target)->begin = (long) ((val) - 1)) #define EnvSetpDOEnd(theEnv,target,val) ((target)->end = (long) ((val) - 1)) #define DOPToString(target) (((struct symbolHashNode *) ((target)->value))->contents) #define DOPToDouble(target) (((struct floatHashNode *) ((target)->value))->contents) #define DOPToFloat(target) ((float) (((struct floatHashNode *) ((target)->value))->contents)) #define DOPToLong(target) (((struct integerHashNode *) ((target)->value))->contents) #define DOPToInteger(target) ((int) (((struct integerHashNode *) ((target)->value))->contents)) #define DOPToPointer(target) ((target)->value) #define EnvDOPToString(theEnv,target) (((struct symbolHashNode *) ((target)->value))->contents) #define EnvDOPToDouble(theEnv,target) (((struct floatHashNode *) ((target)->value))->contents) #define EnvDOPToFloat(theEnv,target) ((float) (((struct floatHashNode *) ((target)->value))->contents)) #define EnvDOPToLong(theEnv,target) (((struct integerHashNode *) ((target)->value))->contents) #define EnvDOPToInteger(theEnv,target) ((int) (((struct integerHashNode *) ((target)->value))->contents)) #define EnvDOPToPointer(theEnv,target) ((target)->value) #define DOToString(target) (((struct symbolHashNode *) (target.value))->contents) #define DOToDouble(target) (((struct floatHashNode *) (target.value))->contents) #define DOToFloat(target) ((float) (((struct floatHashNode *) (target.value))->contents)) #define DOToLong(target) (((struct integerHashNode *) (target.value))->contents) #define DOToInteger(target) ((int) (((struct integerHashNode *) (target.value))->contents)) #define DOToPointer(target) ((target).value) #define EnvDOToString(theEnv,target) (((struct symbolHashNode *) (target.value))->contents) #define EnvDOToDouble(theEnv,target) (((struct floatHashNode *) (target.value))->contents) #define EnvDOToFloat(theEnv,target) ((float) (((struct floatHashNode *) (target.value))->contents)) #define EnvDOToLong(theEnv,target) (((struct integerHashNode *) (target.value))->contents) #define EnvDOToInteger(theEnv,target) ((int) (((struct integerHashNode *) (target.value))->contents)) #define EnvDOToPointer(theEnv,target) ((target).value) #define CoerceToLongInteger(t,v) ((t == INTEGER) ? ValueToLong(v) : (long int) ValueToDouble(v)) #define CoerceToInteger(t,v) ((t == INTEGER) ? (int) ValueToLong(v) : (int) ValueToDouble(v)) #define CoerceToDouble(t,v) ((t == INTEGER) ? (double) ValueToLong(v) : ValueToDouble(v)) #define GetFirstArgument() (EvaluationData(theEnv)->CurrentExpression->argList) #define GetNextArgument(ep) (ep->nextArg) #define MAXIMUM_PRIMITIVES 150 #define BITS_PER_BYTE 8 #define BitwiseTest(n,b) ((n) & (char) (1 << (b))) #define BitwiseSet(n,b) (n |= (char) (1 << (b))) #define BitwiseClear(n,b) (n &= (char) ~(1 << (b))) #define TestBitMap(map,id) BitwiseTest(map[(id) / BITS_PER_BYTE],(id) % BITS_PER_BYTE) #define SetBitMap(map,id) BitwiseSet(map[(id) / BITS_PER_BYTE],(id) % BITS_PER_BYTE) #define ClearBitMap(map,id) BitwiseClear(map[(id) / BITS_PER_BYTE],(id) % BITS_PER_BYTE) #define EVALUATION_DATA 44 struct evaluationData { struct expr *CurrentExpression; int EvaluationError; int HaltExecution; int CurrentEvaluationDepth; struct entityRecord *PrimitivesArray[MAXIMUM_PRIMITIVES]; }; #define EvaluationData(theEnv) ((struct evaluationData *) GetEnvironmentData(theEnv,EVALUATION_DATA)) #ifdef LOCALE #undef LOCALE #endif #ifdef _EVALUATN_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define SetMultifieldErrorValue(theEnv,a) EnvSetMultifieldErrorValue(theEnv,a) #define FunctionCall(theEnv,a,b,c) EnvFunctionCall(theEnv,a,b,c) #else #define SetMultifieldErrorValue(a) EnvSetMultifieldErrorValue(GetCurrentEnvironment(),a) #define FunctionCall(a,b,c) EnvFunctionCall(GetCurrentEnvironment(),a,b,c) #endif LOCALE void InitializeEvaluationData(void *); LOCALE int EvaluateExpression(void *,struct expr *,struct dataObject *); LOCALE void SetEvaluationError(void *,intBool); LOCALE int GetEvaluationError(void *); LOCALE void SetHaltExecution(void *,int); LOCALE int GetHaltExecution(void *); LOCALE void ReturnValues(void *,struct dataObject *); LOCALE void PrintDataObject(void *,char *,struct dataObject *); LOCALE void EnvSetMultifieldErrorValue(void *,struct dataObject *); LOCALE void ValueInstall(void *,struct dataObject *); LOCALE void ValueDeinstall(void *,struct dataObject *); LOCALE void PropagateReturnValue(void *,struct dataObject *); #if DEFFUNCTION_CONSTRUCT || DEFGENERIC_CONSTRUCT LOCALE int EnvFunctionCall(void *,char *,char *,DATA_OBJECT *); LOCALE int FunctionCall2(void *,FUNCTION_REFERENCE *,char *,DATA_OBJECT *); #endif LOCALE void CopyDataObject(void *,DATA_OBJECT *,DATA_OBJECT *,int); LOCALE void AtomInstall(void *,int,void *); LOCALE void AtomDeinstall(void *,int,void *); LOCALE struct expr *ConvertValueToExpression(void *,DATA_OBJECT *); LOCALE unsigned int GetAtomicHashValue(unsigned short,void *,int); LOCALE void InstallPrimitive(void *,struct entityRecord *,int); LOCALE void TransferDataObjectValues(DATA_OBJECT *,DATA_OBJECT *); LOCALE struct expr *FunctionReferenceExpression(void *,char *); LOCALE intBool GetFunctionReference(void *,char *,FUNCTION_REFERENCE *); LOCALE intBool DOsEqual(DATA_OBJECT_PTR,DATA_OBJECT_PTR); LOCALE int EvaluateAndStoreInDataObject(void *,int,EXPRESSION *,DATA_OBJECT *,int); #endif clips-6.24/clipssrc/._factrhs.h0000400000175000017500000000012207422635005014533 0ustar jfsjfsMac OS X  2 RTEXT????clips-6.24/clipssrc/classcom.h0000755000175000017500000001453310441130017014504 0ustar jfsjfs /*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.24 06/05/06 */ /* */ /* */ /*******************************************************/ /*************************************************************/ /* Purpose: */ /* */ /* Principal Programmer(s): */ /* Brian L. Donnell */ /* */ /* Contributing Programmer(s): */ /* */ /* Revision History: */ /* 6.23: Corrected compilation errors for files */ /* generated by constructs-to-c. DR0861 */ /* */ /* 6.24: Renamed BOOLEAN macro type to intBool. */ /* */ /*************************************************************/ #ifndef _H_classcom #define _H_classcom #define CONVENIENCE_MODE 0 #define CONSERVATION_MODE 1 #define EnvGetDefclassName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define EnvGetDefclassPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetDefclassNamePointer(x) GetConstructNamePointer((struct constructHeader *) x) #define GetDefclassModule(x) GetConstructModuleItem((struct constructHeader *) x) #define SetNextDefclass(c,t) SetNextConstruct((struct constructHeader *) c, \ (struct constructHeader *) t) #define SetDefclassPPForm(c,ppf) SetConstructPPForm(theEnv,(struct constructHeader *) c,ppf) #define EnvDefclassModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #ifndef _H_cstrccom #include "cstrccom.h" #endif #ifndef _H_moduldef #include "moduldef.h" #endif #ifndef _H_object #include "object.h" #endif #ifndef _H_symbol #include "symbol.h" #endif #ifdef LOCALE #undef LOCALE #endif #ifdef _CLASSCOM_SOURCE_ #define LOCALE #else #define LOCALE extern #endif #if ENVIRONMENT_API_ONLY #define DefclassModule(theEnv,x) GetConstructModuleName((struct constructHeader *) x) #define FindDefclass(theEnv,a) EnvFindDefclass(theEnv,a) #define GetDefclassList(theEnv,a,b) EnvGetDefclassList(theEnv,a,b) #define GetDefclassName(theEnv,x) GetConstructNameString((struct constructHeader *) x) #define GetDefclassPPForm(theEnv,x) GetConstructPPForm(theEnv,(struct constructHeader *) x) #define GetDefclassWatchInstances(theEnv,a) EnvGetDefclassWatchInstances(theEnv,a) #define GetDefclassWatchSlots(theEnv,a) EnvGetDefclassWatchSlots(theEnv,a) #define GetNextDefclass(theEnv,a) EnvGetNextDefclass(theEnv,a) #define IsDefclassDeletable(theEnv,a) EnvIsDefclassDeletable(theEnv,a) #define ListDefclasses(theEnv,a,b) EnvListDefclasses(theEnv,a,b) #define SetDefclassWatchInstances(theEnv,a,b) EnvSetDefclassWatchInstances(theEnv,a,b) #define SetDefclassWatchSlots(theEnv,a,b) EnvSetDefclassWatchSlots(theEnv,a,b) #define Undefclass(theEnv,a) EnvUndefclass(theEnv,a) #define SetClassDefaultsMode(theEnv,a) EnvSetClassDefaultsMode(theEnv,a) #define GetClassDefaultsMode(theEnv) EnvGetClassDefaultsMode(theEnv) #else #define DefclassModule(x) GetConstructModuleName((struct constructHeader *) x) #define FindDefclass(a) EnvFindDefclass(GetCurrentEnvironment(),a) #define GetDefclassList(a,b) EnvGetDefclassList(GetCurrentEnvironment(),a,b) #define GetDefclassName(x) GetConstructNameString((struct constructHeader *) x) #define GetDefclassPPForm(x) GetConstructPPForm(GetCurrentEnvironment(),(struct constructHeader *) x) #define GetDefclassWatchInstances(a) EnvGetDefclassWatchInstances(GetCurrentEnvironment(),a) #define GetDefclassWatchSlots(a) EnvGetDefclassWatchSlots(GetCurrentEnvironment(),a) #define GetNextDefclass(a) EnvGetNextDefclass(GetCurrentEnvironment(),a) #define IsDefclassDeletable(a) EnvIsDefclassDeletable(GetCurrentEnvironment(),a) #define ListDefclasses(a,b) EnvListDefclasses(GetCurrentEnvironment(),a,b) #define SetDefclassWatchInstances(a,b) EnvSetDefclassWatchInstances(GetCurrentEnvironment(),a,b) #define SetDefclassWatchSlots(a,b) EnvSetDefclassWatchSlots(GetCurrentEnvironment(),a,b) #define Undefclass(a) EnvUndefclass(GetCurrentEnvironment(),a) #define SetClassDefaultsMode(a) EnvSetClassDefaultsMode(GetCurrentEnvironment(),a) #define GetClassDefaultsMode() EnvGetClassDefaultsMode(GetCurrentEnvironment()) #endif LOCALE void *EnvFindDefclass(void *,char *); LOCALE DEFCLASS *LookupDefclassByMdlOrScope(void *,char *); LOCALE DEFCLASS *LookupDefclassInScope(void *,char *); LOCALE DEFCLASS *LookupDefclassAnywhere(void *,struct defmodule *,char *); LOCALE intBool DefclassInScope(void *,DEFCLASS *,struct defmodule *); LOCALE void *EnvGetNextDefclass(void *,void *); LOCALE intBool EnvIsDefclassDeletable(void *,void *); LOCALE void UndefclassCommand(void *); LOCALE unsigned short EnvSetClassDefaultsMode(void *,unsigned short); LOCALE unsigned short EnvGetClassDefaultsMode(void *); LOCALE void *GetClassDefaultsModeCommand(void *); LOCALE void *SetClassDefaultsModeCommand(void *); #if DEBUGGING_FUNCTIONS LOCALE void PPDefclassCommand(void *); LOCALE void ListDefclassesCommand(void *); LOCALE void EnvListDefclasses(void *,char *,struct defmodule *); LOCALE unsigned EnvGetDefclassWatchInstances(void *,void *); LOCALE void EnvSetDefclassWatchInstances(void *,unsigned,void *); LOCALE unsigned EnvGetDefclassWatchSlots(void *,void *); LOCALE void EnvSetDefclassWatchSlots(void *,unsigned,void *); LOCALE unsigned DefclassWatchAccess(void *,int,unsigned,EXPRESSION *); LOCALE unsigned DefclassWatchPrint(void *,char *,int,EXPRESSION *); #endif LOCALE void GetDefclassListFunction(void *,DATA_OBJECT *); LOCALE void EnvGetDefclassList(void *,DATA_OBJECT *,struct defmodule *); LOCALE intBool EnvUndefclass(void *,void *); LOCALE intBool HasSuperclass(DEFCLASS *,DEFCLASS *); LOCALE SYMBOL_HN *CheckClassAndSlot(void *,char *,DEFCLASS **); #if (! BLOAD_ONLY) && (! RUN_TIME) LOCALE void SaveDefclasses(void *,void *,char *); #endif #endif clips-6.24/readme.txt0000644000175000017500000000264507447643114012724 0ustar jfsjfsCLIPS License Information Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, OR ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. CLIPS is released as public domain software and as such you are under no obligation to pay for its use. However, if you derive commercial or monetary benefit from use of the software or just want to show support, please consider making a voluntary payment based on the worth of the software to you as compensation for the time and effort required to develop and maintain CLIPS. Payments can be made online at http://order.kagi.com/?JKT.