1    /*******************************************************/
2    /*      "C" Language Integrated Production System      */
3    /*                                                     */
4    /*             CLIPS Version 6.30  08/16/14            */
5    /*                                                     */
6    /*                 CONSTRAINT MODULE                   */
7    /*******************************************************/
8 
9 /*************************************************************/
10 /* Purpose: Provides functions for creating and removing     */
11 /*   constraint records, adding them to the contraint hash   */
12 /*   table, and enabling and disabling static and dynamic    */
13 /*   constraint checking.                                    */
14 /*                                                           */
15 /* Principal Programmer(s):                                  */
16 /*      Gary D. Riley                                        */
17 /*                                                           */
18 /* Contributing Programmer(s):                               */
19 /*      Brian Dantes                                         */
20 /*                                                           */
21 /* Revision History:                                         */
22 /*                                                           */
23 /*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
24 /*                                                           */
25 /*      6.24: Added allowed-classes slot facet.              */
26 /*                                                           */
27 /*            Renamed BOOLEAN macro type to intBool.         */
28 /*                                                           */
29 /*      6.30: Removed conditional code for unsupported       */
30 /*            compilers/operating systems (IBM_MCW and       */
31 /*            MAC_MCW).                                      */
32 /*                                                           */
33 /*            Changed integer type/precision.                */
34 /*                                                           */
35 /*            Converted API macros to function calls.        */
36 /*                                                           */
37 /*************************************************************/
38 
39 #define _CONSTRNT_SOURCE_
40 
41 #include <stdio.h>
42 #define _STDIO_INCLUDED_
43 #include <stdlib.h>
44 
45 #include "setup.h"
46 
47 #include "argacces.h"
48 #include "constant.h"
49 #include "envrnmnt.h"
50 #include "extnfunc.h"
51 #include "memalloc.h"
52 #include "multifld.h"
53 #include "router.h"
54 #include "scanner.h"
55 
56 #include "constrnt.h"
57 
58 /***************************************/
59 /* LOCAL INTERNAL FUNCTION DEFINITIONS */
60 /***************************************/
61 
62 #if (! RUN_TIME) && (! BLOAD_ONLY)
63    static void                     InstallConstraintRecord(void *,CONSTRAINT_RECORD *);
64    static int                      ConstraintCompare(struct constraintRecord *,struct constraintRecord *);
65 #endif
66 #if (! RUN_TIME)
67    static void                     ReturnConstraintRecord(void *,CONSTRAINT_RECORD *);
68    static void                     DeinstallConstraintRecord(void *,CONSTRAINT_RECORD *);
69 #endif
70    static void                     DeallocateConstraintData(void *);
71 
72 /*****************************************************/
73 /* InitializeConstraints: Initializes the constraint */
74 /*   hash table to NULL and defines the static and   */
75 /*   dynamic constraint access functions.            */
76 /*****************************************************/
InitializeConstraints(void * theEnv)77 globle void InitializeConstraints(
78   void *theEnv)
79   {
80 #if (! RUN_TIME) && (! BLOAD_ONLY)
81    int i;
82 #endif
83 
84    AllocateEnvironmentData(theEnv,CONSTRAINT_DATA,sizeof(struct constraintData),DeallocateConstraintData);
85 
86    ConstraintData(theEnv)->StaticConstraintChecking = TRUE;
87 
88 #if (! RUN_TIME) && (! BLOAD_ONLY)
89 
90     ConstraintData(theEnv)->ConstraintHashtable = (struct constraintRecord **)
91                           gm2(theEnv,(int) sizeof (struct constraintRecord *) *
92                                     SIZE_CONSTRAINT_HASH);
93 
94     if (ConstraintData(theEnv)->ConstraintHashtable == NULL) EnvExitRouter(theEnv,EXIT_FAILURE);
95 
96     for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) ConstraintData(theEnv)->ConstraintHashtable[i] = NULL;
97 #endif
98 
99 #if (! RUN_TIME)
100    EnvDefineFunction2(theEnv,"get-dynamic-constraint-checking",'b',GDCCommand,"GDCCommand", "00");
101    EnvDefineFunction2(theEnv,"set-dynamic-constraint-checking",'b',SDCCommand,"SDCCommand", "11");
102 
103    EnvDefineFunction2(theEnv,"get-static-constraint-checking",'b',GSCCommand,"GSCCommand", "00");
104    EnvDefineFunction2(theEnv,"set-static-constraint-checking",'b',SSCCommand,"SSCCommand", "11");
105 #endif
106   }
107 
108 /*****************************************************/
109 /* DeallocateConstraintData: Deallocates environment */
110 /*    data for constraints.                          */
111 /*****************************************************/
DeallocateConstraintData(void * theEnv)112 static void DeallocateConstraintData(
113   void *theEnv)
114   {
115 #if ! RUN_TIME
116    struct constraintRecord *tmpPtr, *nextPtr;
117    int i;
118 
119    for (i = 0; i < SIZE_CONSTRAINT_HASH; i++)
120      {
121       tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
122       while (tmpPtr != NULL)
123         {
124          nextPtr = tmpPtr->next;
125          ReturnConstraintRecord(theEnv,tmpPtr);
126          tmpPtr = nextPtr;
127         }
128      }
129 
130    rm(theEnv,ConstraintData(theEnv)->ConstraintHashtable,
131       (int) sizeof (struct constraintRecord *) * SIZE_CONSTRAINT_HASH);
132 #else
133 #if MAC_XCD
134 #pragma unused(theEnv)
135 #endif
136 #endif
137 
138 #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE) && (! RUN_TIME)
139    if (ConstraintData(theEnv)->NumberOfConstraints != 0)
140      {
141       genfree(theEnv,(void *) ConstraintData(theEnv)->ConstraintArray,
142               (sizeof(CONSTRAINT_RECORD) * ConstraintData(theEnv)->NumberOfConstraints));
143      }
144 #endif
145   }
146 
147 #if (! RUN_TIME)
148 
149 /*************************************************************/
150 /* ReturnConstraintRecord: Frees the data structures used by */
151 /*   a constraint record. If the returnOnlyFields argument   */
152 /*   is FALSE, then the constraint record is also freed.     */
153 /*************************************************************/
ReturnConstraintRecord(void * theEnv,CONSTRAINT_RECORD * constraints)154 static void ReturnConstraintRecord(
155   void *theEnv,
156   CONSTRAINT_RECORD *constraints)
157   {
158    if (constraints == NULL) return;
159 
160    if (constraints->bucket < 0)
161      {
162       ReturnExpression(theEnv,constraints->classList);
163       ReturnExpression(theEnv,constraints->restrictionList);
164       ReturnExpression(theEnv,constraints->maxValue);
165       ReturnExpression(theEnv,constraints->minValue);
166       ReturnExpression(theEnv,constraints->minFields);
167       ReturnExpression(theEnv,constraints->maxFields);
168      }
169 
170    ReturnConstraintRecord(theEnv,constraints->multifield);
171 
172    rtn_struct(theEnv,constraintRecord,constraints);
173   }
174 
175 /***************************************************/
176 /* DeinstallConstraintRecord: Decrements the count */
177 /*   values of all occurrences of primitive data   */
178 /*   types found in a constraint record.           */
179 /***************************************************/
DeinstallConstraintRecord(void * theEnv,CONSTRAINT_RECORD * constraints)180 static void DeinstallConstraintRecord(
181   void *theEnv,
182   CONSTRAINT_RECORD *constraints)
183   {
184    if (constraints->bucket >= 0)
185      {
186       RemoveHashedExpression(theEnv,constraints->classList);
187       RemoveHashedExpression(theEnv,constraints->restrictionList);
188       RemoveHashedExpression(theEnv,constraints->maxValue);
189       RemoveHashedExpression(theEnv,constraints->minValue);
190       RemoveHashedExpression(theEnv,constraints->minFields);
191       RemoveHashedExpression(theEnv,constraints->maxFields);
192      }
193    else
194      {
195       ExpressionDeinstall(theEnv,constraints->classList);
196       ExpressionDeinstall(theEnv,constraints->restrictionList);
197       ExpressionDeinstall(theEnv,constraints->maxValue);
198       ExpressionDeinstall(theEnv,constraints->minValue);
199       ExpressionDeinstall(theEnv,constraints->minFields);
200       ExpressionDeinstall(theEnv,constraints->maxFields);
201      }
202 
203    if (constraints->multifield != NULL)
204      { DeinstallConstraintRecord(theEnv,constraints->multifield); }
205   }
206 
207 /******************************************/
208 /* RemoveConstraint: Removes a constraint */
209 /*   from the constraint hash table.      */
210 /******************************************/
RemoveConstraint(void * theEnv,struct constraintRecord * theConstraint)211 globle void RemoveConstraint(
212   void *theEnv,
213   struct constraintRecord *theConstraint)
214   {
215    struct constraintRecord *tmpPtr, *prevPtr = NULL;
216 
217    if (theConstraint == NULL) return;
218 
219    /*========================================*/
220    /* If the bucket value is less than zero, */
221    /* then the constraint wasn't stored in   */
222    /* the hash table.                        */
223    /*========================================*/
224 
225    if (theConstraint->bucket < 0)
226      {
227       ReturnConstraintRecord(theEnv,theConstraint);
228       return;
229      }
230 
231    /*================================*/
232    /* Find and remove the constraint */
233    /* from the contraint hash table. */
234    /*================================*/
235 
236    tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[theConstraint->bucket];
237    while (tmpPtr != NULL)
238      {
239       if (tmpPtr == theConstraint)
240         {
241          theConstraint->count--;
242          if (theConstraint->count == 0)
243            {
244             if (prevPtr == NULL)
245               { ConstraintData(theEnv)->ConstraintHashtable[theConstraint->bucket] = theConstraint->next; }
246             else
247               { prevPtr->next = theConstraint->next; }
248             DeinstallConstraintRecord(theEnv,theConstraint);
249             ReturnConstraintRecord(theEnv,theConstraint);
250            }
251          return;
252         }
253 
254       prevPtr = tmpPtr;
255       tmpPtr = tmpPtr->next;
256      }
257 
258    return;
259   }
260 
261 #endif /* (! RUN_TIME) */
262 
263 #if (! RUN_TIME) && (! BLOAD_ONLY)
264 
265 /***********************************/
266 /* HashConstraint: Returns a hash  */
267 /*   value for a given constraint. */
268 /***********************************/
HashConstraint(struct constraintRecord * theConstraint)269 globle unsigned long HashConstraint(
270   struct constraintRecord *theConstraint)
271   {
272    int i = 0;
273    unsigned long count = 0;
274    unsigned long hashValue;
275    struct expr *tmpPtr;
276 
277    count += (unsigned long)
278       (theConstraint->anyAllowed * 17) +
279       (theConstraint->symbolsAllowed * 5) +
280       (theConstraint->stringsAllowed * 23) +
281       (theConstraint->floatsAllowed * 19) +
282       (theConstraint->integersAllowed * 29) +
283       (theConstraint->instanceNamesAllowed * 31) +
284       (theConstraint->instanceAddressesAllowed * 17);
285 
286    count += (unsigned long)
287       (theConstraint->externalAddressesAllowed * 29) +
288       (theConstraint->voidAllowed * 29) +
289       (theConstraint->multifieldsAllowed * 29) +
290       (theConstraint->factAddressesAllowed * 79) +
291       (theConstraint->anyRestriction * 59) +
292       (theConstraint->symbolRestriction * 61);
293 
294    count += (unsigned long)
295       (theConstraint->stringRestriction * 3) +
296       (theConstraint->floatRestriction * 37) +
297       (theConstraint->integerRestriction * 9) +
298       (theConstraint->classRestriction * 11) +
299       (theConstraint->instanceNameRestriction * 7);
300 
301    for (tmpPtr = theConstraint->classList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg)
302      { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); }
303 
304    for (tmpPtr = theConstraint->restrictionList; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg)
305      { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); }
306 
307    for (tmpPtr = theConstraint->minValue; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg)
308      { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); }
309 
310    for (tmpPtr = theConstraint->maxValue; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg)
311      { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); }
312 
313    for (tmpPtr = theConstraint->minFields; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg)
314      { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); }
315 
316    for (tmpPtr = theConstraint->maxFields; tmpPtr != NULL; tmpPtr = tmpPtr->nextArg)
317      { count += GetAtomicHashValue(tmpPtr->type,tmpPtr->value,i++); }
318 
319    if (theConstraint->multifield != NULL)
320      { count += HashConstraint(theConstraint->multifield); }
321 
322    hashValue = (unsigned long) (count % SIZE_CONSTRAINT_HASH);
323 
324    return(hashValue);
325   }
326 
327 /**********************************************/
328 /* ConstraintCompare: Compares two constraint */
329 /*   records and returns TRUE if they are     */
330 /*   identical, otherwise FALSE.              */
331 /**********************************************/
ConstraintCompare(struct constraintRecord * constraint1,struct constraintRecord * constraint2)332 static int ConstraintCompare(
333   struct constraintRecord *constraint1,
334   struct constraintRecord *constraint2)
335   {
336    struct expr *tmpPtr1, *tmpPtr2;
337 
338    if ((constraint1->anyAllowed != constraint2->anyAllowed) ||
339        (constraint1->symbolsAllowed != constraint2->symbolsAllowed) ||
340        (constraint1->stringsAllowed != constraint2->stringsAllowed) ||
341        (constraint1->floatsAllowed != constraint2->floatsAllowed) ||
342        (constraint1->integersAllowed != constraint2->integersAllowed) ||
343        (constraint1->instanceNamesAllowed != constraint2->instanceNamesAllowed) ||
344        (constraint1->instanceAddressesAllowed != constraint2->instanceAddressesAllowed) ||
345        (constraint1->externalAddressesAllowed != constraint2->externalAddressesAllowed) ||
346        (constraint1->voidAllowed != constraint2->voidAllowed) ||
347        (constraint1->multifieldsAllowed != constraint2->multifieldsAllowed) ||
348        (constraint1->singlefieldsAllowed != constraint2->singlefieldsAllowed) ||
349        (constraint1->factAddressesAllowed != constraint2->factAddressesAllowed) ||
350        (constraint1->anyRestriction != constraint2->anyRestriction) ||
351        (constraint1->symbolRestriction != constraint2->symbolRestriction) ||
352        (constraint1->stringRestriction != constraint2->stringRestriction) ||
353        (constraint1->floatRestriction != constraint2->floatRestriction) ||
354        (constraint1->integerRestriction != constraint2->integerRestriction) ||
355        (constraint1->classRestriction != constraint2->classRestriction) ||
356        (constraint1->instanceNameRestriction != constraint2->instanceNameRestriction))
357      { return(FALSE); }
358 
359    for (tmpPtr1 = constraint1->classList, tmpPtr2 = constraint2->classList;
360         (tmpPtr1 != NULL) && (tmpPtr2 != NULL);
361         tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg)
362      {
363       if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value))
364         { return(FALSE); }
365      }
366    if (tmpPtr1 != tmpPtr2) return(FALSE);
367 
368    for (tmpPtr1 = constraint1->restrictionList, tmpPtr2 = constraint2->restrictionList;
369         (tmpPtr1 != NULL) && (tmpPtr2 != NULL);
370         tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg)
371      {
372       if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value))
373         { return(FALSE); }
374      }
375    if (tmpPtr1 != tmpPtr2) return(FALSE);
376 
377    for (tmpPtr1 = constraint1->minValue, tmpPtr2 = constraint2->minValue;
378         (tmpPtr1 != NULL) && (tmpPtr2 != NULL);
379         tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg)
380      {
381       if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value))
382         { return(FALSE); }
383      }
384    if (tmpPtr1 != tmpPtr2) return(FALSE);
385 
386    for (tmpPtr1 = constraint1->maxValue, tmpPtr2 = constraint2->maxValue;
387         (tmpPtr1 != NULL) && (tmpPtr2 != NULL);
388         tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg)
389      {
390       if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value))
391         { return(FALSE); }
392      }
393    if (tmpPtr1 != tmpPtr2) return(FALSE);
394 
395    for (tmpPtr1 = constraint1->minFields, tmpPtr2 = constraint2->minFields;
396         (tmpPtr1 != NULL) && (tmpPtr2 != NULL);
397         tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg)
398      {
399       if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value))
400         { return(FALSE); }
401      }
402    if (tmpPtr1 != tmpPtr2) return(FALSE);
403 
404    for (tmpPtr1 = constraint1->maxFields, tmpPtr2 = constraint2->maxFields;
405         (tmpPtr1 != NULL) && (tmpPtr2 != NULL);
406         tmpPtr1 = tmpPtr1->nextArg, tmpPtr2 = tmpPtr2->nextArg)
407      {
408       if ((tmpPtr1->type != tmpPtr2->type) || (tmpPtr1->value != tmpPtr2->value))
409         { return(FALSE); }
410      }
411    if (tmpPtr1 != tmpPtr2) return(FALSE);
412 
413    if (((constraint1->multifield == NULL) && (constraint2->multifield != NULL)) ||
414        ((constraint1->multifield != NULL) && (constraint2->multifield == NULL)))
415      { return(FALSE); }
416    else if (constraint1->multifield == constraint2->multifield)
417      { return(TRUE); }
418 
419    return(ConstraintCompare(constraint1->multifield,constraint2->multifield));
420   }
421 
422 /************************************/
423 /* AddConstraint: Adds a constraint */
424 /*   to the constraint hash table.  */
425 /************************************/
AddConstraint(void * theEnv,struct constraintRecord * theConstraint)426 globle struct constraintRecord *AddConstraint(
427   void *theEnv,
428   struct constraintRecord *theConstraint)
429   {
430    struct constraintRecord *tmpPtr;
431    unsigned long hashValue;
432 
433    if (theConstraint == NULL) return(NULL);
434 
435    hashValue = HashConstraint(theConstraint);
436 
437    for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[hashValue];
438         tmpPtr != NULL;
439         tmpPtr = tmpPtr->next)
440      {
441       if (ConstraintCompare(theConstraint,tmpPtr))
442         {
443          tmpPtr->count++;
444          ReturnConstraintRecord(theEnv,theConstraint);
445          return(tmpPtr);
446         }
447      }
448 
449    InstallConstraintRecord(theEnv,theConstraint);
450    theConstraint->count = 1;
451    theConstraint->bucket = hashValue;
452    theConstraint->next = ConstraintData(theEnv)->ConstraintHashtable[hashValue];
453    ConstraintData(theEnv)->ConstraintHashtable[hashValue] = theConstraint;
454    return(theConstraint);
455   }
456 
457 /*************************************************/
458 /* InstallConstraintRecord: Increments the count */
459 /*   values of all occurrences of primitive data */
460 /*   types found in a constraint record.         */
461 /*************************************************/
InstallConstraintRecord(void * theEnv,CONSTRAINT_RECORD * constraints)462 static void InstallConstraintRecord(
463   void *theEnv,
464   CONSTRAINT_RECORD *constraints)
465   {
466    struct expr *tempExpr;
467 
468    tempExpr = AddHashedExpression(theEnv,constraints->classList);
469    ReturnExpression(theEnv,constraints->classList);
470    constraints->classList = tempExpr;
471 
472    tempExpr = AddHashedExpression(theEnv,constraints->restrictionList);
473    ReturnExpression(theEnv,constraints->restrictionList);
474    constraints->restrictionList = tempExpr;
475 
476    tempExpr = AddHashedExpression(theEnv,constraints->maxValue);
477    ReturnExpression(theEnv,constraints->maxValue);
478    constraints->maxValue = tempExpr;
479 
480    tempExpr = AddHashedExpression(theEnv,constraints->minValue);
481    ReturnExpression(theEnv,constraints->minValue);
482    constraints->minValue = tempExpr;
483 
484    tempExpr = AddHashedExpression(theEnv,constraints->minFields);
485    ReturnExpression(theEnv,constraints->minFields);
486    constraints->minFields = tempExpr;
487 
488    tempExpr = AddHashedExpression(theEnv,constraints->maxFields);
489    ReturnExpression(theEnv,constraints->maxFields);
490    constraints->maxFields = tempExpr;
491 
492    if (constraints->multifield != NULL)
493      { InstallConstraintRecord(theEnv,constraints->multifield); }
494   }
495 
496 #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */
497 
498 /**********************************************/
499 /* SDCCommand: H/L access routine for the     */
500 /*   set-dynamic-constraint-checking command. */
501 /**********************************************/
SDCCommand(void * theEnv)502 globle int SDCCommand(
503   void *theEnv)
504   {
505    int oldValue;
506    DATA_OBJECT arg_ptr;
507 
508    oldValue = EnvGetDynamicConstraintChecking(theEnv);
509 
510    if (EnvArgCountCheck(theEnv,"set-dynamic-constraint-checking",EXACTLY,1) == -1)
511      { return(oldValue); }
512 
513    EnvRtnUnknown(theEnv,1,&arg_ptr);
514 
515    if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL))
516      { EnvSetDynamicConstraintChecking(theEnv,FALSE); }
517    else
518      { EnvSetDynamicConstraintChecking(theEnv,TRUE); }
519 
520    return(oldValue);
521   }
522 
523 /**********************************************/
524 /* GDCCommand: H/L access routine for the     */
525 /*   get-dynamic-constraint-checking command. */
526 /**********************************************/
GDCCommand(void * theEnv)527 globle int GDCCommand(
528   void *theEnv)
529   {
530    int oldValue;
531 
532    oldValue = EnvGetDynamicConstraintChecking(theEnv);
533 
534    if (EnvArgCountCheck(theEnv,"get-dynamic-constraint-checking",EXACTLY,0) == -1)
535      { return(oldValue); }
536 
537    return(oldValue);
538   }
539 
540 /*********************************************/
541 /* SSCCommand: H/L access routine for the    */
542 /*   set-static-constraint-checking command. */
543 /*********************************************/
SSCCommand(void * theEnv)544 globle int SSCCommand(
545   void *theEnv)
546   {
547    int oldValue;
548    DATA_OBJECT arg_ptr;
549 
550    oldValue = EnvGetStaticConstraintChecking(theEnv);
551 
552    if (EnvArgCountCheck(theEnv,"set-static-constraint-checking",EXACTLY,1) == -1)
553      { return(oldValue); }
554 
555    EnvRtnUnknown(theEnv,1,&arg_ptr);
556 
557    if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL))
558      { EnvSetStaticConstraintChecking(theEnv,FALSE); }
559    else
560      { EnvSetStaticConstraintChecking(theEnv,TRUE); }
561 
562    return(oldValue);
563   }
564 
565 /*********************************************/
566 /* GSCCommand: H/L access routine for the    */
567 /*   get-static-constraint-checking command. */
568 /*********************************************/
GSCCommand(void * theEnv)569 globle int GSCCommand(
570   void *theEnv)
571   {
572    int oldValue;
573 
574    oldValue = EnvGetStaticConstraintChecking(theEnv);
575 
576    if (EnvArgCountCheck(theEnv,"get-static-constraint-checking",EXACTLY,0) == -1)
577      { return(oldValue); }
578 
579    return(oldValue);
580   }
581 
582 /******************************************************/
583 /* EnvSetDynamicConstraintChecking: C access routine  */
584 /*   for the set-dynamic-constraint-checking command. */
585 /******************************************************/
EnvSetDynamicConstraintChecking(void * theEnv,int value)586 globle intBool EnvSetDynamicConstraintChecking(
587   void *theEnv,
588   int value)
589   {
590    int ov;
591    ov = ConstraintData(theEnv)->DynamicConstraintChecking;
592    ConstraintData(theEnv)->DynamicConstraintChecking = value;
593    return(ov);
594   }
595 
596 /******************************************************/
597 /* EnvGetDynamicConstraintChecking: C access routine  */
598 /*   for the get-dynamic-constraint-checking command. */
599 /******************************************************/
EnvGetDynamicConstraintChecking(void * theEnv)600 globle intBool EnvGetDynamicConstraintChecking(
601   void *theEnv)
602   {
603    return(ConstraintData(theEnv)->DynamicConstraintChecking);
604   }
605 
606 /*****************************************************/
607 /* EnvSetStaticConstraintChecking: C access routine  */
608 /*   for the set-static-constraint-checking command. */
609 /*****************************************************/
EnvSetStaticConstraintChecking(void * theEnv,int value)610 globle intBool EnvSetStaticConstraintChecking(
611   void *theEnv,
612   int value)
613   {
614    int ov;
615 
616    ov = ConstraintData(theEnv)->StaticConstraintChecking;
617    ConstraintData(theEnv)->StaticConstraintChecking = value;
618    return(ov);
619   }
620 
621 /*****************************************************/
622 /* EnvGetStaticConstraintChecking: C access routine  */
623 /*   for the get-static-constraint-checking command. */
624 /*****************************************************/
EnvGetStaticConstraintChecking(void * theEnv)625 globle intBool EnvGetStaticConstraintChecking(
626   void *theEnv)
627   {
628    return(ConstraintData(theEnv)->StaticConstraintChecking);
629   }
630 
631 /*#####################################*/
632 /* ALLOW_ENVIRONMENT_GLOBALS Functions */
633 /*#####################################*/
634 
635 #if ALLOW_ENVIRONMENT_GLOBALS
636 
SetDynamicConstraintChecking(int value)637 globle intBool SetDynamicConstraintChecking(
638   int value)
639   {
640    return EnvSetDynamicConstraintChecking(GetCurrentEnvironment(),value);
641   }
642 
GetDynamicConstraintChecking()643 globle intBool GetDynamicConstraintChecking()
644   {
645    return EnvGetDynamicConstraintChecking(GetCurrentEnvironment());
646   }
647 
SetStaticConstraintChecking(int value)648 globle intBool SetStaticConstraintChecking(
649   int value)
650   {
651    return EnvSetStaticConstraintChecking(GetCurrentEnvironment(),value);
652   }
653 
GetStaticConstraintChecking()654 globle intBool GetStaticConstraintChecking()
655   {
656    return EnvGetStaticConstraintChecking(GetCurrentEnvironment());
657   }
658 
659 #endif
660