1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 08/16/14 */
5 /* */
6 /* INSTANCE MULTIFIELD SLOT MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Access routines for Instance Multifield Slots */
11 /* */
12 /* Principal Programmer(s): */
13 /* Brian L. Dantes */
14 /* */
15 /* Contributing Programmer(s): */
16 /* */
17 /* Revision History: */
18 /* */
19 /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */
20 /* */
21 /* 6.24: Renamed BOOLEAN macro type to intBool. */
22 /* */
23 /* 6.30: Added const qualifiers to remove C++ */
24 /* deprecation warnings. */
25 /* */
26 /* Changed integer type/precision. */
27 /* */
28 /*************************************************************/
29
30 /* =========================================
31 *****************************************
32 EXTERNAL DEFINITIONS
33 =========================================
34 ***************************************** */
35 #include "setup.h"
36
37 #if OBJECT_SYSTEM
38
39 #include "argacces.h"
40 #include "envrnmnt.h"
41 #include "extnfunc.h"
42 #include "insfun.h"
43 #include "msgfun.h"
44 #include "msgpass.h"
45 #include "multifun.h"
46 #include "router.h"
47
48 #define _INSMULT_SOURCE_
49 #include "insmult.h"
50
51 /* =========================================
52 *****************************************
53 CONSTANTS
54 =========================================
55 ***************************************** */
56 #define INSERT 0
57 #define REPLACE 1
58 #define DELETE_OP 2
59
60 /* =========================================
61 *****************************************
62 INTERNALLY VISIBLE FUNCTION HEADERS
63 =========================================
64 ***************************************** */
65
66 static INSTANCE_TYPE *CheckMultifieldSlotInstance(void *,const char *);
67 static INSTANCE_SLOT *CheckMultifieldSlotModify(void *,int,const char *,INSTANCE_TYPE *,
68 EXPRESSION *,long *,long *,DATA_OBJECT *);
69 static void AssignSlotToDataObject(DATA_OBJECT *,INSTANCE_SLOT *);
70
71 /* =========================================
72 *****************************************
73 EXTERNALLY VISIBLE FUNCTIONS
74 =========================================
75 ***************************************** */
76
77 #if (! RUN_TIME)
78
79 /***************************************************
80 NAME : SetupInstanceMultifieldCommands
81 DESCRIPTION : Defines function interfaces for
82 manipulating instance multislots
83 INPUTS : None
84 RETURNS : Nothing useful
85 SIDE EFFECTS : Functions defined to KB
86 NOTES : None
87 ***************************************************/
SetupInstanceMultifieldCommands(void * theEnv)88 globle void SetupInstanceMultifieldCommands(
89 void *theEnv)
90 {
91 /* ===================================
92 Old version 5.1 compatibility names
93 =================================== */
94 EnvDefineFunction2(theEnv,"direct-mv-replace",'b',PTIEF DirectMVReplaceCommand,
95 "DirectMVReplaceCommand","4**wii");
96 EnvDefineFunction2(theEnv,"direct-mv-insert",'b',PTIEF DirectMVInsertCommand,
97 "DirectMVInsertCommand","3**wi");
98 EnvDefineFunction2(theEnv,"direct-mv-delete",'b',PTIEF DirectMVDeleteCommand,
99 "DirectMVDeleteCommand","33iw");
100 EnvDefineFunction2(theEnv,"mv-slot-replace",'u',PTIEF MVSlotReplaceCommand,
101 "MVSlotReplaceCommand","5*uewii");
102 EnvDefineFunction2(theEnv,"mv-slot-insert",'u',PTIEF MVSlotInsertCommand,
103 "MVSlotInsertCommand","4*uewi");
104 EnvDefineFunction2(theEnv,"mv-slot-delete",'u',PTIEF MVSlotDeleteCommand,
105 "MVSlotDeleteCommand","44iew");
106
107 /* =====================
108 New version 6.0 names
109 ===================== */
110 EnvDefineFunction2(theEnv,"slot-direct-replace$",'b',PTIEF DirectMVReplaceCommand,
111 "DirectMVReplaceCommand","4**wii");
112 EnvDefineFunction2(theEnv,"slot-direct-insert$",'b',PTIEF DirectMVInsertCommand,
113 "DirectMVInsertCommand","3**wi");
114 EnvDefineFunction2(theEnv,"slot-direct-delete$",'b',PTIEF DirectMVDeleteCommand,
115 "DirectMVDeleteCommand","33iw");
116 EnvDefineFunction2(theEnv,"slot-replace$",'u',PTIEF MVSlotReplaceCommand,
117 "MVSlotReplaceCommand","5*uewii");
118 EnvDefineFunction2(theEnv,"slot-insert$",'u',PTIEF MVSlotInsertCommand,
119 "MVSlotInsertCommand","4*uewi");
120 EnvDefineFunction2(theEnv,"slot-delete$",'u',PTIEF MVSlotDeleteCommand,
121 "MVSlotDeleteCommand","44iew");
122 }
123
124 #endif
125
126 /***********************************************************************************
127 NAME : MVSlotReplaceCommand
128 DESCRIPTION : Allows user to replace a specified field of a multi-value slot
129 The slot is directly read (w/o a get- message) and the new
130 slot-value is placed via a put- message.
131 This function is not valid for single-value slots.
132 INPUTS : Caller's result buffer
133 RETURNS : TRUE if multi-value slot successfully modified,
134 FALSE otherwise
135 SIDE EFFECTS : Put messsage sent for slot
136 NOTES : H/L Syntax : (slot-replace$ <instance> <slot>
137 <range-begin> <range-end> <value>)
138 ***********************************************************************************/
MVSlotReplaceCommand(void * theEnv,DATA_OBJECT * result)139 globle void MVSlotReplaceCommand(
140 void *theEnv,
141 DATA_OBJECT *result)
142 {
143 DATA_OBJECT newval,newseg,oldseg;
144 INSTANCE_TYPE *ins;
145 INSTANCE_SLOT *sp;
146 long rb,re;
147 EXPRESSION arg;
148
149 result->type = SYMBOL;
150 result->value = EnvFalseSymbol(theEnv);
151 ins = CheckMultifieldSlotInstance(theEnv,"slot-replace$");
152 if (ins == NULL)
153 return;
154 sp = CheckMultifieldSlotModify(theEnv,REPLACE,"slot-replace$",ins,
155 GetFirstArgument()->nextArg,&rb,&re,&newval);
156 if (sp == NULL)
157 return;
158 AssignSlotToDataObject(&oldseg,sp);
159 if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"slot-replace$") == FALSE)
160 return;
161 arg.type = MULTIFIELD;
162 arg.value = (void *) &newseg;
163 arg.nextArg = NULL;
164 arg.argList = NULL;
165 DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg);
166 }
167
168 /***********************************************************************************
169 NAME : MVSlotInsertCommand
170 DESCRIPTION : Allows user to insert a specified field of a multi-value slot
171 The slot is directly read (w/o a get- message) and the new
172 slot-value is placed via a put- message.
173 This function is not valid for single-value slots.
174 INPUTS : Caller's result buffer
175 RETURNS : TRUE if multi-value slot successfully modified, FALSE otherwise
176 SIDE EFFECTS : Put messsage sent for slot
177 NOTES : H/L Syntax : (slot-insert$ <instance> <slot> <index> <value>)
178 ***********************************************************************************/
MVSlotInsertCommand(void * theEnv,DATA_OBJECT * result)179 globle void MVSlotInsertCommand(
180 void *theEnv,
181 DATA_OBJECT *result)
182 {
183 DATA_OBJECT newval,newseg,oldseg;
184 INSTANCE_TYPE *ins;
185 INSTANCE_SLOT *sp;
186 long theIndex;
187 EXPRESSION arg;
188
189 result->type = SYMBOL;
190 result->value = EnvFalseSymbol(theEnv);
191 ins = CheckMultifieldSlotInstance(theEnv,"slot-insert$");
192 if (ins == NULL)
193 return;
194 sp = CheckMultifieldSlotModify(theEnv,INSERT,"slot-insert$",ins,
195 GetFirstArgument()->nextArg,&theIndex,NULL,&newval);
196 if (sp == NULL)
197 return;
198 AssignSlotToDataObject(&oldseg,sp);
199 if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"slot-insert$") == FALSE)
200 return;
201 arg.type = MULTIFIELD;
202 arg.value = (void *) &newseg;
203 arg.nextArg = NULL;
204 arg.argList = NULL;
205 DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg);
206 }
207
208 /***********************************************************************************
209 NAME : MVSlotDeleteCommand
210 DESCRIPTION : Allows user to delete a specified field of a multi-value slot
211 The slot is directly read (w/o a get- message) and the new
212 slot-value is placed via a put- message.
213 This function is not valid for single-value slots.
214 INPUTS : Caller's result buffer
215 RETURNS : TRUE if multi-value slot successfully modified, FALSE otherwise
216 SIDE EFFECTS : Put message sent for slot
217 NOTES : H/L Syntax : (slot-delete$ <instance> <slot>
218 <range-begin> <range-end>)
219 ***********************************************************************************/
MVSlotDeleteCommand(void * theEnv,DATA_OBJECT * result)220 globle void MVSlotDeleteCommand(
221 void *theEnv,
222 DATA_OBJECT *result)
223 {
224 DATA_OBJECT newseg,oldseg;
225 INSTANCE_TYPE *ins;
226 INSTANCE_SLOT *sp;
227 long rb,re;
228 EXPRESSION arg;
229
230 result->type = SYMBOL;
231 result->value = EnvFalseSymbol(theEnv);
232 ins = CheckMultifieldSlotInstance(theEnv,"slot-delete$");
233 if (ins == NULL)
234 return;
235 sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"slot-delete$",ins,
236 GetFirstArgument()->nextArg,&rb,&re,NULL);
237 if (sp == NULL)
238 return;
239 AssignSlotToDataObject(&oldseg,sp);
240 if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"slot-delete$") == FALSE)
241 return;
242 arg.type = MULTIFIELD;
243 arg.value = (void *) &newseg;
244 arg.nextArg = NULL;
245 arg.argList = NULL;
246 DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg);
247 }
248
249 /*****************************************************************
250 NAME : DirectMVReplaceCommand
251 DESCRIPTION : Directly replaces a slot's value
252 INPUTS : None
253 RETURNS : TRUE if put OK, FALSE otherwise
254 SIDE EFFECTS : Slot modified
255 NOTES : H/L Syntax: (direct-slot-replace$ <slot>
256 <range-begin> <range-end> <value>)
257 *****************************************************************/
DirectMVReplaceCommand(void * theEnv)258 globle intBool DirectMVReplaceCommand(
259 void *theEnv)
260 {
261 INSTANCE_SLOT *sp;
262 INSTANCE_TYPE *ins;
263 long rb,re;
264 DATA_OBJECT newval,newseg,oldseg;
265
266 if (CheckCurrentMessage(theEnv,"direct-slot-replace$",TRUE) == FALSE)
267 return(FALSE);
268 ins = GetActiveInstance(theEnv);
269 sp = CheckMultifieldSlotModify(theEnv,REPLACE,"direct-slot-replace$",ins,
270 GetFirstArgument(),&rb,&re,&newval);
271 if (sp == NULL)
272 return(FALSE);
273 AssignSlotToDataObject(&oldseg,sp);
274 if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"direct-slot-replace$")
275 == FALSE)
276 return(FALSE);
277 if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-replace$"))
278 return(TRUE);
279 return(FALSE);
280 }
281
282 /************************************************************************
283 NAME : DirectMVInsertCommand
284 DESCRIPTION : Directly inserts a slot's value
285 INPUTS : None
286 RETURNS : TRUE if put OK, FALSE otherwise
287 SIDE EFFECTS : Slot modified
288 NOTES : H/L Syntax: (direct-slot-insert$ <slot> <index> <value>)
289 ************************************************************************/
DirectMVInsertCommand(void * theEnv)290 globle intBool DirectMVInsertCommand(
291 void *theEnv)
292 {
293 INSTANCE_SLOT *sp;
294 INSTANCE_TYPE *ins;
295 long theIndex;
296 DATA_OBJECT newval,newseg,oldseg;
297
298 if (CheckCurrentMessage(theEnv,"direct-slot-insert$",TRUE) == FALSE)
299 return(FALSE);
300 ins = GetActiveInstance(theEnv);
301 sp = CheckMultifieldSlotModify(theEnv,INSERT,"direct-slot-insert$",ins,
302 GetFirstArgument(),&theIndex,NULL,&newval);
303 if (sp == NULL)
304 return(FALSE);
305 AssignSlotToDataObject(&oldseg,sp);
306 if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"direct-slot-insert$")
307 == FALSE)
308 return(FALSE);
309 if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-insert$"))
310 return(TRUE);
311 return(FALSE);
312 }
313
314 /*****************************************************************
315 NAME : DirectMVDeleteCommand
316 DESCRIPTION : Directly deletes a slot's value
317 INPUTS : None
318 RETURNS : TRUE if put OK, FALSE otherwise
319 SIDE EFFECTS : Slot modified
320 NOTES : H/L Syntax: (direct-slot-delete$ <slot>
321 <range-begin> <range-end>)
322 *****************************************************************/
DirectMVDeleteCommand(void * theEnv)323 globle intBool DirectMVDeleteCommand(
324 void *theEnv)
325 {
326 INSTANCE_SLOT *sp;
327 INSTANCE_TYPE *ins;
328 long rb,re;
329 DATA_OBJECT newseg,oldseg;
330
331 if (CheckCurrentMessage(theEnv,"direct-slot-delete$",TRUE) == FALSE)
332 return(FALSE);
333 ins = GetActiveInstance(theEnv);
334 sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"direct-slot-delete$",ins,
335 GetFirstArgument(),&rb,&re,NULL);
336 if (sp == NULL)
337 return(FALSE);
338 AssignSlotToDataObject(&oldseg,sp);
339 if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"direct-slot-delete$")
340 == FALSE)
341 return(FALSE);
342 if (PutSlotValue(theEnv,ins,sp,&newseg,&oldseg,"function direct-slot-delete$"))
343 return(TRUE);
344 return(FALSE);
345 }
346
347 /* =========================================
348 *****************************************
349 INTERNALLY VISIBLE FUNCTIONS
350 =========================================
351 ***************************************** */
352
353 /**********************************************************************
354 NAME : CheckMultifieldSlotInstance
355 DESCRIPTION : Gets the instance for the functions slot-replace$,
356 insert and delete
357 INPUTS : The function name
358 RETURNS : The instance address, NULL on errors
359 SIDE EFFECTS : None
360 NOTES : None
361 **********************************************************************/
CheckMultifieldSlotInstance(void * theEnv,const char * func)362 static INSTANCE_TYPE *CheckMultifieldSlotInstance(
363 void *theEnv,
364 const char *func)
365 {
366 INSTANCE_TYPE *ins;
367 DATA_OBJECT temp;
368
369 if (EnvArgTypeCheck(theEnv,func,1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE)
370 {
371 SetEvaluationError(theEnv,TRUE);
372 return(NULL);
373 }
374 if (temp.type == INSTANCE_ADDRESS)
375 {
376 ins = (INSTANCE_TYPE *) temp.value;
377 if (ins->garbage == 1)
378 {
379 StaleInstanceAddress(theEnv,func,0);
380 SetEvaluationError(theEnv,TRUE);
381 return(NULL);
382 }
383 }
384 else
385 {
386 ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
387 if (ins == NULL)
388 NoInstanceError(theEnv,ValueToString(temp.value),func);
389 }
390 return(ins);
391 }
392
393 /*********************************************************************
394 NAME : CheckMultifieldSlotModify
395 DESCRIPTION : For the functions slot-replace$, insert, & delete
396 as well as direct-slot-replace$, insert, & delete
397 this function gets the slot, index, and optional
398 field-value for these functions
399 INPUTS : 1) A code indicating the type of operation
400 INSERT (0) : Requires one index
401 REPLACE (1) : Requires two indices
402 DELETE_OP (2) : Requires two indices
403 2) Function name-string
404 3) Instance address
405 4) Argument expression chain
406 5) Caller's buffer for index (or beginning of range)
407 6) Caller's buffer for end of range
408 (can be NULL for INSERT)
409 7) Caller's new-field value buffer
410 (can be NULL for DELETE_OP)
411 RETURNS : The address of the instance-slot,
412 NULL on errors
413 SIDE EFFECTS : Caller's index buffer set
414 Caller's new-field value buffer set (if not NULL)
415 Will allocate an ephemeral segment to store more
416 than 1 new field value
417 EvaluationError set on errors
418 NOTES : Assume the argument chain is at least 2
419 expressions deep - slot, index, and optional values
420 *********************************************************************/
CheckMultifieldSlotModify(void * theEnv,int code,const char * func,INSTANCE_TYPE * ins,EXPRESSION * args,long * rb,long * re,DATA_OBJECT * newval)421 static INSTANCE_SLOT *CheckMultifieldSlotModify(
422 void *theEnv,
423 int code,
424 const char *func,
425 INSTANCE_TYPE *ins,
426 EXPRESSION *args,
427 long *rb,
428 long *re,
429 DATA_OBJECT *newval)
430 {
431 DATA_OBJECT temp;
432 INSTANCE_SLOT *sp;
433 int start;
434
435 start = (args == GetFirstArgument()) ? 1 : 2;
436 EvaluationData(theEnv)->EvaluationError = FALSE;
437 EvaluateExpression(theEnv,args,&temp);
438 if (temp.type != SYMBOL)
439 {
440 ExpectedTypeError1(theEnv,func,start,"symbol");
441 SetEvaluationError(theEnv,TRUE);
442 return(NULL);
443 }
444 sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
445 if (sp == NULL)
446 {
447 SlotExistError(theEnv,ValueToString(temp.value),func);
448 return(NULL);
449 }
450 if (sp->desc->multiple == 0)
451 {
452 PrintErrorID(theEnv,"INSMULT",1,FALSE);
453 EnvPrintRouter(theEnv,WERROR,"Function ");
454 EnvPrintRouter(theEnv,WERROR,func);
455 EnvPrintRouter(theEnv,WERROR," cannot be used on single-field slot ");
456 EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
457 EnvPrintRouter(theEnv,WERROR," in instance ");
458 EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
459 EnvPrintRouter(theEnv,WERROR,".\n");
460 SetEvaluationError(theEnv,TRUE);
461 return(NULL);
462 }
463 EvaluateExpression(theEnv,args->nextArg,&temp);
464 if (temp.type != INTEGER)
465 {
466 ExpectedTypeError1(theEnv,func,start+1,"integer");
467 SetEvaluationError(theEnv,TRUE);
468 return(NULL);
469 }
470 args = args->nextArg->nextArg;
471 *rb = (long) ValueToLong(temp.value);
472 if ((code == REPLACE) || (code == DELETE_OP))
473 {
474 EvaluateExpression(theEnv,args,&temp);
475 if (temp.type != INTEGER)
476 {
477 ExpectedTypeError1(theEnv,func,start+2,"integer");
478 SetEvaluationError(theEnv,TRUE);
479 return(NULL);
480 }
481 *re = (long) ValueToLong(temp.value);
482 args = args->nextArg;
483 }
484 if ((code == INSERT) || (code == REPLACE))
485 {
486 if (EvaluateAndStoreInDataObject(theEnv,1,args,newval,TRUE) == FALSE)
487 return(NULL);
488 }
489 return(sp);
490 }
491
492 /***************************************************
493 NAME : AssignSlotToDataObject
494 DESCRIPTION : Assigns the value of a multifield
495 slot to a data object
496 INPUTS : 1) The data object buffer
497 2) The instance slot
498 RETURNS : Nothing useful
499 SIDE EFFECTS : Data object fields set
500 NOTES : Assumes slot is a multislot
501 ***************************************************/
AssignSlotToDataObject(DATA_OBJECT * theDataObject,INSTANCE_SLOT * theSlot)502 static void AssignSlotToDataObject(
503 DATA_OBJECT *theDataObject,
504 INSTANCE_SLOT *theSlot)
505 {
506 theDataObject->type = (unsigned short) theSlot->type;
507 theDataObject->value = theSlot->value;
508 theDataObject->begin = 0;
509 SetpDOEnd(theDataObject,GetInstanceSlotLength(theSlot));
510 }
511
512 #endif
513
514 /***************************************************
515 NAME :
516 DESCRIPTION :
517 INPUTS :
518 RETURNS :
519 SIDE EFFECTS :
520 NOTES :
521 ***************************************************/
522
523
524