1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 08/19/14 */
5 /* */
6 /* MULTIFIELD MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: */
11 /* */
12 /* Principal Programmer(s): */
13 /* Gary D. Riley */
14 /* */
15 /* Contributing Programmer(s): */
16 /* Brian L. Dantes */
17 /* */
18 /* Revision History: */
19 /* */
20 /* 6.24: Renamed BOOLEAN macro type to intBool. */
21 /* */
22 /* Corrected code to remove compiler warnings. */
23 /* */
24 /* Moved ImplodeMultifield from multifun.c. */
25 /* */
26 /* 6.30: Changed integer type/precision. */
27 /* */
28 /* Changed garbage collection algorithm. */
29 /* */
30 /* Used DataObjectToString instead of */
31 /* ValueToString in implode$ to handle */
32 /* print representation of external addresses. */
33 /* */
34 /* Added const qualifiers to remove C++ */
35 /* deprecation warnings. */
36 /* */
37 /* Converted API macros to function calls. */
38 /* */
39 /* Fixed issue with StoreInMultifield when */
40 /* asserting void values in implied deftemplate */
41 /* facts. */
42 /* */
43 /*************************************************************/
44
45 #define _MULTIFLD_SOURCE_
46
47 #include <stdio.h>
48 #define _STDIO_INCLUDED_
49
50 #include "setup.h"
51
52 #include "constant.h"
53 #include "memalloc.h"
54 #include "envrnmnt.h"
55 #include "evaluatn.h"
56 #include "scanner.h"
57 #include "router.h"
58 #include "strngrtr.h"
59 #include "utility.h"
60 #if OBJECT_SYSTEM
61 #include "object.h"
62 #endif
63
64 #include "multifld.h"
65
66 /**********************/
67 /* CreateMultifield2: */
68 /**********************/
CreateMultifield2(void * theEnv,long size)69 globle void *CreateMultifield2(
70 void *theEnv,
71 long size)
72 {
73 struct multifield *theSegment;
74 long newSize = size;
75
76 if (size <= 0) newSize = 1;
77
78 theSegment = get_var_struct(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L));
79
80 theSegment->multifieldLength = size;
81 theSegment->busyCount = 0;
82 theSegment->next = NULL;
83
84 return((void *) theSegment);
85 }
86
87 /*********************/
88 /* ReturnMultifield: */
89 /*********************/
ReturnMultifield(void * theEnv,struct multifield * theSegment)90 globle void ReturnMultifield(
91 void *theEnv,
92 struct multifield *theSegment)
93 {
94 unsigned long newSize;
95
96 if (theSegment == NULL) return;
97
98 if (theSegment->multifieldLength == 0) newSize = 1;
99 else newSize = theSegment->multifieldLength;
100
101 rtn_var_struct(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment);
102 }
103
104 /**********************/
105 /* MultifieldInstall: */
106 /**********************/
MultifieldInstall(void * theEnv,struct multifield * theSegment)107 globle void MultifieldInstall(
108 void *theEnv,
109 struct multifield *theSegment)
110 {
111 unsigned long length, i;
112 struct field *theFields;
113
114 if (theSegment == NULL) return;
115
116 length = theSegment->multifieldLength;
117
118 theSegment->busyCount++;
119 theFields = theSegment->theFields;
120
121 for (i = 0 ; i < length ; i++)
122 { AtomInstall(theEnv,theFields[i].type,theFields[i].value); }
123 }
124
125 /************************/
126 /* MultifieldDeinstall: */
127 /************************/
MultifieldDeinstall(void * theEnv,struct multifield * theSegment)128 globle void MultifieldDeinstall(
129 void *theEnv,
130 struct multifield *theSegment)
131 {
132 unsigned long length, i;
133 struct field *theFields;
134
135 if (theSegment == NULL) return;
136
137 length = theSegment->multifieldLength;
138 theSegment->busyCount--;
139 theFields = theSegment->theFields;
140
141 for (i = 0 ; i < length ; i++)
142 { AtomDeinstall(theEnv,theFields[i].type,theFields[i].value); }
143 }
144
145 /*******************************************************/
146 /* StringToMultifield: Returns a multifield structure */
147 /* that represents the string sent as the argument. */
148 /*******************************************************/
StringToMultifield(void * theEnv,const char * theString)149 globle struct multifield *StringToMultifield(
150 void *theEnv,
151 const char *theString)
152 {
153 struct token theToken;
154 struct multifield *theSegment;
155 struct field *theFields;
156 unsigned long numberOfFields = 0;
157 struct expr *topAtom = NULL, *lastAtom = NULL, *theAtom;
158
159 /*====================================================*/
160 /* Open the string as an input source and read in the */
161 /* list of values to be stored in the multifield. */
162 /*====================================================*/
163
164 OpenStringSource(theEnv,"multifield-str",theString,0);
165
166 GetToken(theEnv,"multifield-str",&theToken);
167 while (theToken.type != STOP)
168 {
169 if ((theToken.type == SYMBOL) || (theToken.type == STRING) ||
170 (theToken.type == FLOAT) || (theToken.type == INTEGER) ||
171 (theToken.type == INSTANCE_NAME))
172 { theAtom = GenConstant(theEnv,theToken.type,theToken.value); }
173 else
174 { theAtom = GenConstant(theEnv,STRING,EnvAddSymbol(theEnv,theToken.printForm)); }
175
176 numberOfFields++;
177 if (topAtom == NULL) topAtom = theAtom;
178 else lastAtom->nextArg = theAtom;
179
180 lastAtom = theAtom;
181 GetToken(theEnv,"multifield-str",&theToken);
182 }
183
184 CloseStringSource(theEnv,"multifield-str");
185
186 /*====================================================================*/
187 /* Create a multifield of the appropriate size for the values parsed. */
188 /*====================================================================*/
189
190 theSegment = (struct multifield *) EnvCreateMultifield(theEnv,numberOfFields);
191 theFields = theSegment->theFields;
192
193 /*====================================*/
194 /* Copy the values to the multifield. */
195 /*====================================*/
196
197 theAtom = topAtom;
198 numberOfFields = 0;
199 while (theAtom != NULL)
200 {
201 theFields[numberOfFields].type = theAtom->type;
202 theFields[numberOfFields].value = theAtom->value;
203 numberOfFields++;
204 theAtom = theAtom->nextArg;
205 }
206
207 /*===========================*/
208 /* Return the parsed values. */
209 /*===========================*/
210
211 ReturnExpression(theEnv,topAtom);
212
213 /*============================*/
214 /* Return the new multifield. */
215 /*============================*/
216
217 return(theSegment);
218 }
219
220 /**************************************************************/
221 /* EnvCreateMultifield: Creates a multifield of the specified */
222 /* size and adds it to the list of segments. */
223 /**************************************************************/
EnvCreateMultifield(void * theEnv,long size)224 globle void *EnvCreateMultifield(
225 void *theEnv,
226 long size)
227 {
228 struct multifield *theSegment;
229 long newSize;
230
231 if (size <= 0) newSize = 1;
232 else newSize = size;
233
234 theSegment = get_var_struct(theEnv,multifield,(long) sizeof(struct field) * (newSize - 1L));
235
236 theSegment->multifieldLength = size;
237 theSegment->busyCount = 0;
238 theSegment->next = NULL;
239
240 theSegment->next = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields;
241 UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = theSegment;
242 UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE;
243 if (UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield == NULL)
244 { UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = theSegment; }
245
246 return((void *) theSegment);
247 }
248
249 /*******************/
250 /* DOToMultifield: */
251 /*******************/
DOToMultifield(void * theEnv,DATA_OBJECT * theValue)252 globle void *DOToMultifield(
253 void *theEnv,
254 DATA_OBJECT *theValue)
255 {
256 struct multifield *dst, *src;
257
258 if (theValue->type != MULTIFIELD) return(NULL);
259
260 dst = (struct multifield *) CreateMultifield2(theEnv,(unsigned long) GetpDOLength(theValue));
261
262 src = (struct multifield *) theValue->value;
263 GenCopyMemory(struct field,dst->multifieldLength,
264 &(dst->theFields[0]),&(src->theFields[GetpDOBegin(theValue) - 1]));
265
266 return((void *) dst);
267 }
268
269 /************************/
270 /* AddToMultifieldList: */
271 /************************/
AddToMultifieldList(void * theEnv,struct multifield * theSegment)272 globle void AddToMultifieldList(
273 void *theEnv,
274 struct multifield *theSegment)
275 {
276 theSegment->next = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields;
277 UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = theSegment;
278 UtilityData(theEnv)->CurrentGarbageFrame->dirty = TRUE;
279 if (UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield == NULL)
280 { UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = theSegment; }
281 }
282
283 /*********************/
284 /* FlushMultifields: */
285 /*********************/
FlushMultifields(void * theEnv)286 globle void FlushMultifields(
287 void *theEnv)
288 {
289 struct multifield *theSegment, *nextPtr, *lastPtr = NULL;
290 unsigned long newSize;
291
292 theSegment = UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields;
293 while (theSegment != NULL)
294 {
295 nextPtr = theSegment->next;
296 if (theSegment->busyCount == 0)
297 {
298 if (theSegment->multifieldLength == 0) newSize = 1;
299 else newSize = theSegment->multifieldLength;
300 rtn_var_struct(theEnv,multifield,sizeof(struct field) * (newSize - 1),theSegment);
301 if (lastPtr == NULL) UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields = nextPtr;
302 else lastPtr->next = nextPtr;
303
304 /*=================================================*/
305 /* If the multifield deleted was the last in the */
306 /* list, update the pointer to the last multifield */
307 /* to the prior multifield. */
308 /*=================================================*/
309
310 if (nextPtr == NULL)
311 { UtilityData(theEnv)->CurrentGarbageFrame->LastMultifield = lastPtr; }
312 }
313 else
314 { lastPtr = theSegment; }
315
316 theSegment = nextPtr;
317 }
318 }
319
320 /************************************************************************/
321 /* DuplicateMultifield: Allocates a new segment and copies results from */
322 /* old value to new. This value is not put on the ListOfMultifields. */
323 /************************************************************************/
DuplicateMultifield(void * theEnv,DATA_OBJECT_PTR dst,DATA_OBJECT_PTR src)324 globle void DuplicateMultifield(
325 void *theEnv,
326 DATA_OBJECT_PTR dst,
327 DATA_OBJECT_PTR src)
328 {
329 dst->type = MULTIFIELD;
330 dst->begin = 0;
331 dst->end = src->end - src->begin;
332 dst->value = (void *) CreateMultifield2(theEnv,(unsigned long) dst->end + 1);
333 GenCopyMemory(struct field,dst->end + 1,&((struct multifield *) dst->value)->theFields[0],
334 &((struct multifield *) src->value)->theFields[src->begin]);
335 }
336
337 /*******************/
338 /* CopyMultifield: */
339 /*******************/
CopyMultifield(void * theEnv,struct multifield * src)340 globle void *CopyMultifield(
341 void *theEnv,
342 struct multifield *src)
343 {
344 struct multifield *dst;
345
346 dst = (struct multifield *) CreateMultifield2(theEnv,src->multifieldLength);
347 GenCopyMemory(struct field,src->multifieldLength,&(dst->theFields[0]),&(src->theFields[0]));
348 return((void *) dst);
349 }
350
351 /*********************************************/
352 /* PrintMultifield: Prints out a multifield. */
353 /*********************************************/
PrintMultifield(void * theEnv,const char * fileid,struct multifield * segment,long begin,long end,int printParens)354 globle void PrintMultifield(
355 void *theEnv,
356 const char *fileid,
357 struct multifield *segment,
358 long begin,
359 long end,
360 int printParens)
361 {
362 struct field *theMultifield;
363 int i;
364
365 theMultifield = segment->theFields;
366 if (printParens)
367 EnvPrintRouter(theEnv,fileid,"(");
368 i = begin;
369 while (i <= end)
370 {
371 PrintAtom(theEnv,fileid,theMultifield[i].type,theMultifield[i].value);
372 i++;
373 if (i <= end) EnvPrintRouter(theEnv,fileid," ");
374 }
375 if (printParens)
376 EnvPrintRouter(theEnv,fileid,")");
377 }
378
379 /****************************************************/
380 /* StoreInMultifield: Append function for segments. */
381 /****************************************************/
StoreInMultifield(void * theEnv,DATA_OBJECT * returnValue,EXPRESSION * expptr,int garbageSegment)382 globle void StoreInMultifield(
383 void *theEnv,
384 DATA_OBJECT *returnValue,
385 EXPRESSION *expptr,
386 int garbageSegment)
387 {
388 DATA_OBJECT val_ptr;
389 DATA_OBJECT *val_arr;
390 struct multifield *theMultifield;
391 struct multifield *orig_ptr;
392 long start, end, i,j, k, argCount;
393 unsigned long seg_size;
394
395 argCount = CountArguments(expptr);
396
397 /*=========================================*/
398 /* If no arguments are given return a NULL */
399 /* multifield of length zero. */
400 /*=========================================*/
401
402 if (argCount == 0)
403 {
404 SetpType(returnValue,MULTIFIELD);
405 SetpDOBegin(returnValue,1);
406 SetpDOEnd(returnValue,0);
407 if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L);
408 else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
409 SetpValue(returnValue,(void *) theMultifield);
410 return;
411 }
412 else
413 {
414 /*========================================*/
415 /* Get a new segment with length equal to */
416 /* the total length of all the arguments. */
417 /*========================================*/
418
419 val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount);
420 seg_size = 0;
421
422 for (i = 1; i <= argCount; i++, expptr = expptr->nextArg)
423 {
424 EvaluateExpression(theEnv,expptr,&val_ptr);
425 if (EvaluationData(theEnv)->EvaluationError)
426 {
427 SetpType(returnValue,MULTIFIELD);
428 SetpDOBegin(returnValue,1);
429 SetpDOEnd(returnValue,0);
430 if (garbageSegment)
431 { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); }
432 else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
433 SetpValue(returnValue,(void *) theMultifield);
434 rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
435 return;
436 }
437 SetpType(val_arr+i-1,GetType(val_ptr));
438 if (GetType(val_ptr) == MULTIFIELD)
439 {
440 SetpValue(val_arr+i-1,GetpValue(&val_ptr));
441 start = GetDOBegin(val_ptr);
442 end = GetDOEnd(val_ptr);
443 }
444 else if (GetType(val_ptr) == RVOID)
445 {
446 SetpValue(val_arr+i-1,GetValue(val_ptr));
447 start = 1;
448 end = 0;
449 }
450 else
451 {
452 SetpValue(val_arr+i-1,GetValue(val_ptr));
453 start = end = -1;
454 }
455
456 seg_size += (unsigned long) (end - start + 1);
457 SetpDOBegin(val_arr+i-1,start);
458 SetpDOEnd(val_arr+i-1,end);
459 }
460
461 if (garbageSegment)
462 { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); }
463 else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size);
464
465 /*========================================*/
466 /* Copy each argument into new segment. */
467 /*========================================*/
468
469 for (k = 0, j = 1; k < argCount; k++)
470 {
471 if (GetpType(val_arr+k) == MULTIFIELD)
472 {
473 start = GetpDOBegin(val_arr+k);
474 end = GetpDOEnd(val_arr+k);
475 orig_ptr = (struct multifield *) GetpValue(val_arr+k);
476 for (i = start; i < end + 1; i++, j++)
477 {
478 SetMFType(theMultifield,j,(GetMFType(orig_ptr,i)));
479 SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i)));
480 }
481 }
482 else if (GetpType(val_arr+k) != RVOID)
483 {
484 SetMFType(theMultifield,j,(short) (GetpType(val_arr+k)));
485 SetMFValue(theMultifield,j,(GetpValue(val_arr+k)));
486 j++;
487 }
488 }
489
490 /*=========================*/
491 /* Return the new segment. */
492 /*=========================*/
493
494 SetpType(returnValue,MULTIFIELD);
495 SetpDOBegin(returnValue,1);
496 SetpDOEnd(returnValue,(long) seg_size);
497 SetpValue(returnValue,(void *) theMultifield);
498 rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
499 return;
500 }
501 }
502
503 /*************************************************************/
504 /* MultifieldDOsEqual: determines if two segments are equal. */
505 /*************************************************************/
MultifieldDOsEqual(DATA_OBJECT_PTR dobj1,DATA_OBJECT_PTR dobj2)506 globle intBool MultifieldDOsEqual(
507 DATA_OBJECT_PTR dobj1,
508 DATA_OBJECT_PTR dobj2)
509 {
510 long extent1,extent2; /* 6.04 Bug Fix */
511 FIELD_PTR e1,e2;
512
513 extent1 = GetpDOLength(dobj1);
514 extent2 = GetpDOLength(dobj2);
515 if (extent1 != extent2)
516 { return(FALSE); }
517
518 e1 = (FIELD_PTR) GetMFPtr(GetpValue(dobj1),GetpDOBegin(dobj1));
519 e2 = (FIELD_PTR) GetMFPtr(GetpValue(dobj2),GetpDOBegin(dobj2));
520 while (extent1 != 0)
521 {
522 if (e1->type != e2->type)
523 { return(FALSE); }
524
525 if (e1->value != e2->value)
526 { return(FALSE); }
527
528 extent1--;
529
530 if (extent1 > 0)
531 {
532 e1++;
533 e2++;
534 }
535 }
536 return(TRUE);
537 }
538
539 /******************************************************************/
540 /* MultifieldsEqual: Determines if two multifields are identical. */
541 /******************************************************************/
MultifieldsEqual(struct multifield * segment1,struct multifield * segment2)542 globle int MultifieldsEqual(
543 struct multifield *segment1,
544 struct multifield *segment2)
545 {
546 struct field *elem1;
547 struct field *elem2;
548 long length, i = 0;
549
550 length = segment1->multifieldLength;
551 if (length != segment2->multifieldLength)
552 { return(FALSE); }
553
554 elem1 = segment1->theFields;
555 elem2 = segment2->theFields;
556
557 /*==================================================*/
558 /* Compare each field of both facts until the facts */
559 /* match completely or the facts mismatch. */
560 /*==================================================*/
561
562 while (i < length)
563 {
564 if (elem1[i].type != elem2[i].type)
565 { return(FALSE); }
566
567 if (elem1[i].type == MULTIFIELD)
568 {
569 if (MultifieldsEqual((struct multifield *) elem1[i].value,
570 (struct multifield *) elem2[i].value) == FALSE)
571 { return(FALSE); }
572 }
573 else if (elem1[i].value != elem2[i].value)
574 { return(FALSE); }
575
576 i++;
577 }
578 return(TRUE);
579 }
580
581 /************************************************************/
582 /* HashMultifield: Returns the hash value for a multifield. */
583 /************************************************************/
HashMultifield(struct multifield * theSegment,unsigned long theRange)584 globle unsigned long HashMultifield(
585 struct multifield *theSegment,
586 unsigned long theRange)
587 {
588 unsigned long length, i;
589 unsigned long tvalue;
590 unsigned long count;
591 struct field *fieldPtr;
592 union
593 {
594 double fv;
595 void *vv;
596 unsigned long liv;
597 } fis;
598
599 /*================================================*/
600 /* Initialize variables for computing hash value. */
601 /*================================================*/
602
603 count = 0;
604 length = theSegment->multifieldLength;
605 fieldPtr = theSegment->theFields;
606
607 /*====================================================*/
608 /* Loop through each value in the multifield, compute */
609 /* its hash value, and add it to the running total. */
610 /*====================================================*/
611
612 for (i = 0;
613 i < length;
614 i++)
615 {
616 switch(fieldPtr[i].type)
617 {
618 case MULTIFIELD:
619 count += HashMultifield((struct multifield *) fieldPtr[i].value,theRange);
620 break;
621
622 case FLOAT:
623 fis.liv = 0;
624 fis.fv = ValueToDouble(fieldPtr[i].value);
625 count += (fis.liv * (i + 29)) +
626 (unsigned long) ValueToDouble(fieldPtr[i].value);
627 break;
628
629 case INTEGER:
630 count += (((unsigned long) ValueToLong(fieldPtr[i].value)) * (i + 29)) +
631 ((unsigned long) ValueToLong(fieldPtr[i].value));
632 break;
633
634 case FACT_ADDRESS:
635 #if OBJECT_SYSTEM
636 case INSTANCE_ADDRESS:
637 #endif
638 fis.liv = 0;
639 fis.vv = fieldPtr[i].value;
640 count += (unsigned long) (fis.liv * (i + 29));
641 break;
642
643 case EXTERNAL_ADDRESS:
644 fis.liv = 0;
645 fis.vv = ValueToExternalAddress(fieldPtr[i].value);
646 count += (unsigned long) (fis.liv * (i + 29));
647 break;
648
649 case SYMBOL:
650 case STRING:
651 #if OBJECT_SYSTEM
652 case INSTANCE_NAME:
653 #endif
654 tvalue = (unsigned long) HashSymbol(ValueToString(fieldPtr[i].value),theRange);
655 count += (unsigned long) (tvalue * (i + 29));
656 break;
657 }
658 }
659
660 /*========================*/
661 /* Return the hash value. */
662 /*========================*/
663
664 return(count);
665 }
666
667 /**********************/
668 /* GetMultifieldList: */
669 /**********************/
GetMultifieldList(void * theEnv)670 globle struct multifield *GetMultifieldList(
671 void *theEnv)
672 {
673 return(UtilityData(theEnv)->CurrentGarbageFrame->ListOfMultifields);
674 }
675
676 /***************************************/
677 /* ImplodeMultifield: C access routine */
678 /* for the implode$ function. */
679 /***************************************/
ImplodeMultifield(void * theEnv,DATA_OBJECT * value)680 globle void *ImplodeMultifield(
681 void *theEnv,
682 DATA_OBJECT *value)
683 {
684 size_t strsize = 0;
685 long i, j;
686 const char *tmp_str;
687 char *ret_str;
688 void *rv;
689 struct multifield *theMultifield;
690 DATA_OBJECT tempDO;
691
692 /*===================================================*/
693 /* Determine the size of the string to be allocated. */
694 /*===================================================*/
695
696 theMultifield = (struct multifield *) GetpValue(value);
697 for (i = GetpDOBegin(value) ; i <= GetpDOEnd(value) ; i++)
698 {
699 if (GetMFType(theMultifield,i) == FLOAT)
700 {
701 tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
702 strsize += strlen(tmp_str) + 1;
703 }
704 else if (GetMFType(theMultifield,i) == INTEGER)
705 {
706 tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
707 strsize += strlen(tmp_str) + 1;
708 }
709 else if (GetMFType(theMultifield,i) == STRING)
710 {
711 strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3;
712 tmp_str = ValueToString(GetMFValue(theMultifield,i));
713 while(*tmp_str)
714 {
715 if (*tmp_str == '"')
716 { strsize++; }
717 else if (*tmp_str == '\\') /* GDR 111599 #835 */
718 { strsize++; } /* GDR 111599 #835 */
719 tmp_str++;
720 }
721 }
722 #if OBJECT_SYSTEM
723 else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
724 { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; }
725 else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
726 { strsize += strlen(ValueToString(((INSTANCE_TYPE *)
727 GetMFValue(theMultifield,i))->name)) + 3; }
728 #endif
729
730 else
731 {
732 SetType(tempDO,GetMFType(theMultifield,i));
733 SetValue(tempDO,GetMFValue(theMultifield,i));
734 strsize += strlen(DataObjectToString(theEnv,&tempDO)) + 1;
735 }
736 }
737
738 /*=============================================*/
739 /* Allocate the string and copy all components */
740 /* of the MULTIFIELD variable to it. */
741 /*=============================================*/
742
743 if (strsize == 0) return(EnvAddSymbol(theEnv,""));
744 ret_str = (char *) gm2(theEnv,strsize);
745 for(j=0, i=GetpDOBegin(value); i <= GetpDOEnd(value) ; i++)
746 {
747 /*============================*/
748 /* Convert numbers to strings */
749 /*============================*/
750
751 if (GetMFType(theMultifield,i) == FLOAT)
752 {
753 tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
754 while(*tmp_str)
755 {
756 *(ret_str+j) = *tmp_str;
757 j++, tmp_str++;
758 }
759 }
760 else if (GetMFType(theMultifield,i) == INTEGER)
761 {
762 tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
763 while(*tmp_str)
764 {
765 *(ret_str+j) = *tmp_str;
766 j++, tmp_str++;
767 }
768 }
769
770 /*=======================================*/
771 /* Enclose strings in quotes and preceed */
772 /* imbedded quotes with a backslash */
773 /*=======================================*/
774
775 else if (GetMFType(theMultifield,i) == STRING)
776 {
777 tmp_str = ValueToString(GetMFValue(theMultifield,i));
778 *(ret_str+j) = '"';
779 j++;
780 while(*tmp_str)
781 {
782 if (*tmp_str == '"')
783 {
784 *(ret_str+j) = '\\';
785 j++;
786 }
787 else if (*tmp_str == '\\') /* GDR 111599 #835 */
788 { /* GDR 111599 #835 */
789 *(ret_str+j) = '\\'; /* GDR 111599 #835 */
790 j++; /* GDR 111599 #835 */
791 } /* GDR 111599 #835 */
792
793 *(ret_str+j) = *tmp_str;
794 j++, tmp_str++;
795 }
796 *(ret_str+j) = '"';
797 j++;
798 }
799 #if OBJECT_SYSTEM
800 else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
801 {
802 tmp_str = ValueToString(GetMFValue(theMultifield,i));
803 *(ret_str + j++) = '[';
804 while(*tmp_str)
805 {
806 *(ret_str+j) = *tmp_str;
807 j++, tmp_str++;
808 }
809 *(ret_str + j++) = ']';
810 }
811 else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
812 {
813 tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name);
814 *(ret_str + j++) = '[';
815 while(*tmp_str)
816 {
817 *(ret_str+j) = *tmp_str;
818 j++, tmp_str++;
819 }
820 *(ret_str + j++) = ']';
821 }
822 #endif
823 else
824 {
825 SetType(tempDO,GetMFType(theMultifield,i));
826 SetValue(tempDO,GetMFValue(theMultifield,i));
827 tmp_str = DataObjectToString(theEnv,&tempDO);
828 while(*tmp_str)
829 {
830 *(ret_str+j) = *tmp_str;
831 j++, tmp_str++;
832 }
833 }
834 *(ret_str+j) = ' ';
835 j++;
836 }
837 *(ret_str+j-1) = '\0';
838
839 /*====================*/
840 /* Return the string. */
841 /*====================*/
842
843 rv = EnvAddSymbol(theEnv,ret_str);
844 rm(theEnv,ret_str,strsize);
845 return(rv);
846 }
847
848 /*#####################################*/
849 /* ALLOW_ENVIRONMENT_GLOBALS Functions */
850 /*#####################################*/
851
852 #if ALLOW_ENVIRONMENT_GLOBALS
853
CreateMultifield(long size)854 globle void *CreateMultifield(
855 long size)
856 {
857 return EnvCreateMultifield(GetCurrentEnvironment(),size);
858 }
859
860 #endif /* ALLOW_ENVIRONMENT_GLOBALS */
861
862
863