1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 08/16/14 */
5 /* */
6 /* DEFMODULE PARSER MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Parses a defmodule construct. */
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 /* 6.30: GetConstructNameAndComment API change. */
23 /* */
24 /* Added const qualifiers to remove C++ */
25 /* deprecation warnings. */
26 /* */
27 /* Fixed linkage issue when DEFMODULE_CONSTRUCT */
28 /* compiler flag is set to 0. */
29 /* */
30 /*************************************************************/
31
32 #define _MODULPSR_SOURCE_
33
34 #include "setup.h"
35
36 #if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY)
37
38 #include <stdio.h>
39 #include <string.h>
40 #define _STDIO_INCLUDED_
41
42 #include "memalloc.h"
43 #include "constant.h"
44 #include "router.h"
45 #include "extnfunc.h"
46 #include "argacces.h"
47 #include "cstrcpsr.h"
48 #include "constrct.h"
49 #include "modulutl.h"
50 #include "utility.h"
51 #include "envrnmnt.h"
52
53 #if BLOAD || BLOAD_AND_BSAVE
54 #include "bload.h"
55 #endif
56
57 #include "modulpsr.h"
58
59 /***************************************/
60 /* LOCAL INTERNAL FUNCTION DEFINITIONS */
61 /***************************************/
62
63 static int ParsePortSpecifications(void *,
64 const char *,struct token *,
65 struct defmodule *);
66 static int ParseImportSpec(void *,const char *,struct token *,
67 struct defmodule *);
68 static int ParseExportSpec(void *,const char *,struct token *,
69 struct defmodule *,
70 struct defmodule *);
71 static intBool DeleteDefmodule(void *,void *);
72 static int FindMultiImportConflict(void *,struct defmodule *);
73 static void NotExportedErrorMessage(void *,const char *,const char *,const char *);
74
75 /******************************************/
76 /* SetNumberOfDefmodules: Sets the number */
77 /* of defmodules currently defined. */
78 /******************************************/
SetNumberOfDefmodules(void * theEnv,long value)79 globle void SetNumberOfDefmodules(
80 void *theEnv,
81 long value)
82 {
83 DefmoduleData(theEnv)->NumberOfDefmodules = value;
84 }
85
86 /****************************************************/
87 /* AddAfterModuleChangeFunction: Adds a function to */
88 /* the list of functions that are to be called */
89 /* after a module change occurs. */
90 /****************************************************/
AddAfterModuleDefinedFunction(void * theEnv,const char * name,void (* func)(void *),int priority)91 globle void AddAfterModuleDefinedFunction(
92 void *theEnv,
93 const char *name,
94 void (*func)(void *),
95 int priority)
96 {
97 DefmoduleData(theEnv)->AfterModuleDefinedFunctions =
98 AddFunctionToCallList(theEnv,name,priority,func,DefmoduleData(theEnv)->AfterModuleDefinedFunctions,TRUE);
99 }
100
101 /******************************************************/
102 /* AddPortConstructItem: Adds an item to the list of */
103 /* items that can be imported/exported by a module. */
104 /******************************************************/
AddPortConstructItem(void * theEnv,const char * theName,int theType)105 globle void AddPortConstructItem(
106 void *theEnv,
107 const char *theName,
108 int theType)
109 {
110 struct portConstructItem *newItem;
111
112 newItem = get_struct(theEnv,portConstructItem);
113 newItem->constructName = theName;
114 newItem->typeExpected = theType;
115 newItem->next = DefmoduleData(theEnv)->ListOfPortConstructItems;
116 DefmoduleData(theEnv)->ListOfPortConstructItems = newItem;
117 }
118
119 /******************************************************/
120 /* ParseDefmodule: Coordinates all actions necessary */
121 /* for the parsing and creation of a defmodule into */
122 /* the current environment. */
123 /******************************************************/
ParseDefmodule(void * theEnv,const char * readSource)124 globle int ParseDefmodule(
125 void *theEnv,
126 const char *readSource)
127 {
128 SYMBOL_HN *defmoduleName;
129 struct defmodule *newDefmodule;
130 struct token inputToken;
131 int i;
132 struct moduleItem *theItem;
133 struct portItem *portSpecs, *nextSpec;
134 struct defmoduleItemHeader *theHeader;
135 struct callFunctionItem *defineFunctions;
136 struct defmodule *redefiningMainModule = NULL;
137 int parseError;
138 struct portItem *oldImportList = NULL, *oldExportList = NULL;
139 short overwrite = FALSE;
140
141 /*================================================*/
142 /* Flush the buffer which stores the pretty print */
143 /* representation for a module. Add the already */
144 /* parsed keyword defmodule to this buffer. */
145 /*================================================*/
146
147 SetPPBufferStatus(theEnv,ON);
148 FlushPPBuffer(theEnv);
149 SetIndentDepth(theEnv,3);
150 SavePPBuffer(theEnv,"(defmodule ");
151
152 /*===============================*/
153 /* Modules cannot be loaded when */
154 /* a binary load is in effect. */
155 /*===============================*/
156
157 #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
158 if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
159 {
160 CannotLoadWithBloadMessage(theEnv,"defmodule");
161 return(TRUE);
162 }
163 #endif
164
165 /*=====================================================*/
166 /* Parse the name and comment fields of the defmodule. */
167 /* Remove the defmodule if it already exists. */
168 /*=====================================================*/
169
170 defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule",
171 EnvFindDefmodule,DeleteDefmodule,"+",
172 TRUE,TRUE,FALSE,FALSE);
173 if (defmoduleName == NULL) { return(TRUE); }
174
175 if (strcmp(ValueToString(defmoduleName),"MAIN") == 0)
176 { redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); }
177
178 /*==============================================*/
179 /* Create the defmodule structure if necessary. */
180 /*==============================================*/
181
182 if (redefiningMainModule == NULL)
183 {
184 newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName));
185 if (newDefmodule)
186 { overwrite = TRUE; }
187 else
188 {
189 newDefmodule = get_struct(theEnv,defmodule);
190 newDefmodule->name = defmoduleName;
191 newDefmodule->usrData = NULL;
192 newDefmodule->next = NULL;
193 }
194 }
195 else
196 {
197 overwrite = TRUE;
198 newDefmodule = redefiningMainModule;
199 }
200
201 if (overwrite)
202 {
203 oldImportList = newDefmodule->importList;
204 oldExportList = newDefmodule->exportList;
205 }
206
207 newDefmodule->importList = NULL;
208 newDefmodule->exportList = NULL;
209
210 /*===================================*/
211 /* Finish parsing the defmodule (its */
212 /* import/export specifications). */
213 /*===================================*/
214
215 parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule);
216
217 /*====================================*/
218 /* Check for import/export conflicts. */
219 /*====================================*/
220
221 if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule);
222
223 /*======================================================*/
224 /* If an error occured in parsing or an import conflict */
225 /* was detected, abort the definition of the defmodule. */
226 /* If we're only checking syntax, then we want to exit */
227 /* at this point as well. */
228 /*======================================================*/
229
230 if (parseError || ConstructData(theEnv)->CheckSyntaxMode)
231 {
232 while (newDefmodule->importList != NULL)
233 {
234 nextSpec = newDefmodule->importList->next;
235 rtn_struct(theEnv,portItem,newDefmodule->importList);
236 newDefmodule->importList = nextSpec;
237 }
238
239 while (newDefmodule->exportList != NULL)
240 {
241 nextSpec = newDefmodule->exportList->next;
242 rtn_struct(theEnv,portItem,newDefmodule->exportList);
243 newDefmodule->exportList = nextSpec;
244 }
245
246 if ((redefiningMainModule == NULL) && (! overwrite))
247 { rtn_struct(theEnv,defmodule,newDefmodule); }
248
249 if (overwrite)
250 {
251 newDefmodule->importList = oldImportList;
252 newDefmodule->exportList = oldExportList;
253 }
254
255 if (parseError) return(TRUE);
256 return(FALSE);
257 }
258
259 /*===============================================*/
260 /* Increment the symbol table counts for symbols */
261 /* used in the defmodule data structures. */
262 /*===============================================*/
263
264 if (redefiningMainModule == NULL)
265 { IncrementSymbolCount(newDefmodule->name); }
266 else
267 {
268 if ((newDefmodule->importList != NULL) ||
269 (newDefmodule->exportList != NULL))
270 { DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; }
271 }
272
273 for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next)
274 {
275 if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
276 if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
277 if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
278 }
279
280 for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next)
281 {
282 if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
283 if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
284 if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
285 }
286
287 /*====================================================*/
288 /* Allocate storage for the module's construct lists. */
289 /*====================================================*/
290
291 if (redefiningMainModule != NULL) { /* Do nothing */ }
292 else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
293 else
294 {
295 newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
296 for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
297 (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
298 i++, theItem = theItem->next)
299 {
300 if (theItem->allocateFunction == NULL)
301 { newDefmodule->itemsArray[i] = NULL; }
302 else
303 {
304 newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
305 (*theItem->allocateFunction)(theEnv);
306 theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
307 theHeader->theModule = newDefmodule;
308 theHeader->firstItem = NULL;
309 theHeader->lastItem = NULL;
310 }
311 }
312 }
313
314 /*=======================================*/
315 /* Save the pretty print representation. */
316 /*=======================================*/
317
318 SavePPBuffer(theEnv,"\n");
319
320 if (EnvGetConserveMemory(theEnv) == TRUE)
321 { newDefmodule->ppForm = NULL; }
322 else
323 { newDefmodule->ppForm = CopyPPBuffer(theEnv); }
324
325 /*==============================================*/
326 /* Add the defmodule to the list of defmodules. */
327 /*==============================================*/
328
329 if (redefiningMainModule == NULL)
330 {
331 if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
332 else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule;
333 DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
334 newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++;
335 }
336
337 EnvSetCurrentModule(theEnv,(void *) newDefmodule);
338
339 /*=========================================*/
340 /* Call any functions required by other */
341 /* constructs when a new module is defined */
342 /*=========================================*/
343
344 for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions;
345 defineFunctions != NULL;
346 defineFunctions = defineFunctions->next)
347 { (* (void (*)(void *)) defineFunctions->func)(theEnv); }
348
349 /*===============================================*/
350 /* Defmodule successfully parsed with no errors. */
351 /*===============================================*/
352
353 return(FALSE);
354 }
355
356 /*************************************************************/
357 /* DeleteDefmodule: Used by the parsing routine to determine */
358 /* if a module can be redefined. Only the MAIN module can */
359 /* be redefined (and it can only be redefined once). */
360 /*************************************************************/
DeleteDefmodule(void * theEnv,void * theConstruct)361 static intBool DeleteDefmodule(
362 void *theEnv,
363 void *theConstruct)
364 {
365 if (strcmp(EnvGetDefmoduleName(theEnv,theConstruct),"MAIN") == 0)
366 { return(DefmoduleData(theEnv)->MainModuleRedefinable); }
367
368 return(FALSE);
369 }
370
371 /*********************************************************/
372 /* ParsePortSpecifications: Parses the import and export */
373 /* specifications found in a defmodule construct. */
374 /*********************************************************/
ParsePortSpecifications(void * theEnv,const char * readSource,struct token * theToken,struct defmodule * theDefmodule)375 static int ParsePortSpecifications(
376 void *theEnv,
377 const char *readSource,
378 struct token *theToken,
379 struct defmodule *theDefmodule)
380 {
381 int error;
382
383 /*=============================*/
384 /* The import and export lists */
385 /* are initially empty. */
386 /*=============================*/
387
388 theDefmodule->importList = NULL;
389 theDefmodule->exportList = NULL;
390
391 /*==========================================*/
392 /* Parse import/export specifications until */
393 /* a right parenthesis is encountered. */
394 /*==========================================*/
395
396 while (theToken->type != RPAREN)
397 {
398 /*========================================*/
399 /* Look for the opening left parenthesis. */
400 /*========================================*/
401
402 if (theToken->type != LPAREN)
403 {
404 SyntaxErrorMessage(theEnv,"defmodule");
405 return(TRUE);
406 }
407
408 /*====================================*/
409 /* Look for the import/export keyword */
410 /* and call the appropriate functions */
411 /* for parsing the specification. */
412 /*====================================*/
413
414 GetToken(theEnv,readSource,theToken);
415
416 if (theToken->type != SYMBOL)
417 {
418 SyntaxErrorMessage(theEnv,"defmodule");
419 return(TRUE);
420 }
421
422 if (strcmp(ValueToString(theToken->value),"import") == 0)
423 {
424 error = ParseImportSpec(theEnv,readSource,theToken,theDefmodule);
425 }
426 else if (strcmp(ValueToString(theToken->value),"export") == 0)
427 {
428 error = ParseExportSpec(theEnv,readSource,theToken,theDefmodule,NULL);
429 }
430 else
431 {
432 SyntaxErrorMessage(theEnv,"defmodule");
433 return(TRUE);
434 }
435
436 if (error) return(TRUE);
437
438 /*============================================*/
439 /* Begin parsing the next port specification. */
440 /*============================================*/
441
442 PPCRAndIndent(theEnv);
443 GetToken(theEnv,readSource,theToken);
444
445 if (theToken->type == RPAREN)
446 {
447 PPBackup(theEnv);
448 PPBackup(theEnv);
449 SavePPBuffer(theEnv,")");
450 }
451 }
452
453 /*===================================*/
454 /* Return FALSE to indicate no error */
455 /* occurred while parsing the */
456 /* import/export specifications. */
457 /*===================================*/
458
459 return(FALSE);
460 }
461
462 /**********************************************************/
463 /* ParseImportSpec: Parses import specifications found in */
464 /* a defmodule construct. */
465 /* */
466 /* <import-spec> ::= (import <module-name> <port-item>) */
467 /* */
468 /* <port-item> ::= ?ALL | */
469 /* ?NONE | */
470 /* <construct-name> ?ALL | */
471 /* <construct-name> ?NONE | */
472 /* <construct-name> <names>* */
473 /**********************************************************/
ParseImportSpec(void * theEnv,const char * readSource,struct token * theToken,struct defmodule * newModule)474 static int ParseImportSpec(
475 void *theEnv,
476 const char *readSource,
477 struct token *theToken,
478 struct defmodule *newModule)
479 {
480 struct defmodule *theModule;
481 struct portItem *thePort, *oldImportSpec;
482 int found, count;
483
484 /*===========================*/
485 /* Look for the module name. */
486 /*===========================*/
487
488 SavePPBuffer(theEnv," ");
489
490 GetToken(theEnv,readSource,theToken);
491
492 if (theToken->type != SYMBOL)
493 {
494 SyntaxErrorMessage(theEnv,"defmodule import specification");
495 return(TRUE);
496 }
497
498 /*=====================================*/
499 /* Verify the existence of the module. */
500 /*=====================================*/
501
502 if ((theModule = (struct defmodule *)
503 EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL)
504 {
505 CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value));
506 return(TRUE);
507 }
508
509 /*========================================*/
510 /* If the specified module doesn't export */
511 /* any constructs, then the import */
512 /* specification is meaningless. */
513 /*========================================*/
514
515 if (theModule->exportList == NULL)
516 {
517 NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL);
518 return(TRUE);
519 }
520
521 /*==============================================*/
522 /* Parse the remaining portion of the import */
523 /* specification and return if an error occurs. */
524 /*==============================================*/
525
526 oldImportSpec = newModule->importList;
527 if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE);
528
529 /*========================================================*/
530 /* If the ?NONE keyword was used with the import spec, */
531 /* then no constructs were actually imported and the */
532 /* import spec does not need to be checked for conflicts. */
533 /*========================================================*/
534
535 if (newModule->importList == oldImportSpec) return(FALSE);
536
537 /*======================================================*/
538 /* Check to see if the construct being imported can be */
539 /* by the specified module. This check exported doesn't */
540 /* guarantee that a specific named construct actually */
541 /* exists. It just checks that it could be exported if */
542 /* it does exists. */
543 /*======================================================*/
544
545 if (newModule->importList->constructType != NULL)
546 {
547 /*=============================*/
548 /* Look for the construct in */
549 /* the module that exports it. */
550 /*=============================*/
551
552 found = FALSE;
553 for (thePort = theModule->exportList;
554 (thePort != NULL) && (! found);
555 thePort = thePort->next)
556 {
557 if (thePort->constructType == NULL) found = TRUE;
558 else if (thePort->constructType == newModule->importList->constructType)
559 {
560 if (newModule->importList->constructName == NULL) found = TRUE;
561 else if (thePort->constructName == NULL) found = TRUE;
562 else if (thePort->constructName == newModule->importList->constructName)
563 { found = TRUE; }
564 }
565 }
566
567 /*=======================================*/
568 /* If it's not exported by the specified */
569 /* module, print an error message. */
570 /*=======================================*/
571
572 if (! found)
573 {
574 if (newModule->importList->constructName == NULL)
575 {
576 NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
577 ValueToString(newModule->importList->constructType),
578 NULL);
579 }
580 else
581 {
582 NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
583 ValueToString(newModule->importList->constructType),
584 ValueToString(newModule->importList->constructName));
585 }
586 return(TRUE);
587 }
588 }
589
590 /*======================================================*/
591 /* Verify that specific named constructs actually exist */
592 /* and can be seen from the module importing them. */
593 /*======================================================*/
594
595 SaveCurrentModule(theEnv);
596 EnvSetCurrentModule(theEnv,(void *) newModule);
597
598 for (thePort = newModule->importList;
599 thePort != NULL;
600 thePort = thePort->next)
601 {
602 if ((thePort->constructType == NULL) || (thePort->constructName == NULL))
603 { continue; }
604
605 theModule = (struct defmodule *)
606 EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName));
607 EnvSetCurrentModule(theEnv,theModule);
608 if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL,
609 ValueToString(thePort->constructName),&count,
610 TRUE,FALSE) == NULL)
611 {
612 NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
613 ValueToString(thePort->constructType),
614 ValueToString(thePort->constructName));
615 RestoreCurrentModule(theEnv);
616 return(TRUE);
617 }
618 }
619
620 RestoreCurrentModule(theEnv);
621
622 /*===============================================*/
623 /* The import list has been successfully parsed. */
624 /*===============================================*/
625
626 return(FALSE);
627 }
628
629 /**********************************************************/
630 /* ParseExportSpec: Parses export specifications found in */
631 /* a defmodule construct. This includes parsing the */
632 /* remaining specification found in an import */
633 /* specification after the module name. */
634 /**********************************************************/
ParseExportSpec(void * theEnv,const char * readSource,struct token * theToken,struct defmodule * newModule,struct defmodule * importModule)635 static int ParseExportSpec(
636 void *theEnv,
637 const char *readSource,
638 struct token *theToken,
639 struct defmodule *newModule,
640 struct defmodule *importModule)
641 {
642 struct portItem *newPort;
643 SYMBOL_HN *theConstruct, *moduleName;
644 struct portConstructItem *thePortConstruct;
645 const char *errorMessage;
646
647 /*===========================================*/
648 /* Set up some variables for error messages. */
649 /*===========================================*/
650
651 if (importModule != NULL)
652 {
653 errorMessage = "defmodule import specification";
654 moduleName = importModule->name;
655 }
656 else
657 {
658 errorMessage = "defmodule export specification";
659 moduleName = NULL;
660 }
661
662 /*=============================================*/
663 /* Handle the special variables ?ALL and ?NONE */
664 /* in the import/export specification. */
665 /*=============================================*/
666
667 SavePPBuffer(theEnv," ");
668 GetToken(theEnv,readSource,theToken);
669
670 if (theToken->type == SF_VARIABLE)
671 {
672 /*==============================*/
673 /* Check to see if the variable */
674 /* is either ?ALL or ?NONE. */
675 /*==============================*/
676
677 if (strcmp(ValueToString(theToken->value),"ALL") == 0)
678 {
679 newPort = (struct portItem *) get_struct(theEnv,portItem);
680 newPort->moduleName = moduleName;
681 newPort->constructType = NULL;
682 newPort->constructName = NULL;
683 newPort->next = NULL;
684 }
685 else if (strcmp(ValueToString(theToken->value),"NONE") == 0)
686 { newPort = NULL; }
687 else
688 {
689 SyntaxErrorMessage(theEnv,errorMessage);
690 return(TRUE);
691 }
692
693 /*=======================================================*/
694 /* The export/import specification must end with a right */
695 /* parenthesis after ?ALL or ?NONE at this point. */
696 /*=======================================================*/
697
698 GetToken(theEnv,readSource,theToken);
699
700 if (theToken->type != RPAREN)
701 {
702 if (newPort != NULL) rtn_struct(theEnv,portItem,newPort);
703 PPBackup(theEnv);
704 SavePPBuffer(theEnv," ");
705 SavePPBuffer(theEnv,theToken->printForm);
706 SyntaxErrorMessage(theEnv,errorMessage);
707 return(TRUE);
708 }
709
710 /*=====================================*/
711 /* Add the new specification to either */
712 /* the import or export list. */
713 /*=====================================*/
714
715 if (newPort != NULL)
716 {
717 if (importModule != NULL)
718 {
719 newPort->next = newModule->importList;
720 newModule->importList = newPort;
721 }
722 else
723 {
724 newPort->next = newModule->exportList;
725 newModule->exportList = newPort;
726 }
727 }
728
729 /*============================================*/
730 /* Return FALSE to indicate the import/export */
731 /* specification was successfully parsed. */
732 /*============================================*/
733
734 return(FALSE);
735 }
736
737 /*========================================================*/
738 /* If the ?ALL and ?NONE keywords were not used, then the */
739 /* token must be the name of an importable construct. */
740 /*========================================================*/
741
742 if (theToken->type != SYMBOL)
743 {
744 SyntaxErrorMessage(theEnv,errorMessage);
745 return(TRUE);
746 }
747
748 theConstruct = (SYMBOL_HN *) theToken->value;
749
750 if ((thePortConstruct = ValidPortConstructItem(theEnv,ValueToString(theConstruct))) == NULL)
751 {
752 SyntaxErrorMessage(theEnv,errorMessage);
753 return(TRUE);
754 }
755
756 /*=============================================================*/
757 /* If the next token is the special variable ?ALL, then all */
758 /* constructs of the specified type are imported/exported. If */
759 /* the next token is the special variable ?NONE, then no */
760 /* constructs of the specified type will be imported/exported. */
761 /*=============================================================*/
762
763 SavePPBuffer(theEnv," ");
764 GetToken(theEnv,readSource,theToken);
765
766 if (theToken->type == SF_VARIABLE)
767 {
768 /*==============================*/
769 /* Check to see if the variable */
770 /* is either ?ALL or ?NONE. */
771 /*==============================*/
772
773 if (strcmp(ValueToString(theToken->value),"ALL") == 0)
774 {
775 newPort = (struct portItem *) get_struct(theEnv,portItem);
776 newPort->moduleName = moduleName;
777 newPort->constructType = theConstruct;
778 newPort->constructName = NULL;
779 newPort->next = NULL;
780 }
781 else if (strcmp(ValueToString(theToken->value),"NONE") == 0)
782 { newPort = NULL; }
783 else
784 {
785 SyntaxErrorMessage(theEnv,errorMessage);
786 return(TRUE);
787 }
788
789 /*=======================================================*/
790 /* The export/import specification must end with a right */
791 /* parenthesis after ?ALL or ?NONE at this point. */
792 /*=======================================================*/
793
794 GetToken(theEnv,readSource,theToken);
795
796 if (theToken->type != RPAREN)
797 {
798 if (newPort != NULL) rtn_struct(theEnv,portItem,newPort);
799 PPBackup(theEnv);
800 SavePPBuffer(theEnv," ");
801 SavePPBuffer(theEnv,theToken->printForm);
802 SyntaxErrorMessage(theEnv,errorMessage);
803 return(TRUE);
804 }
805
806 /*=====================================*/
807 /* Add the new specification to either */
808 /* the import or export list. */
809 /*=====================================*/
810
811 if (newPort != NULL)
812 {
813 if (importModule != NULL)
814 {
815 newPort->next = newModule->importList;
816 newModule->importList = newPort;
817 }
818 else
819 {
820 newPort->next = newModule->exportList;
821 newModule->exportList = newPort;
822 }
823 }
824
825 /*============================================*/
826 /* Return FALSE to indicate the import/export */
827 /* specification was successfully parsed. */
828 /*============================================*/
829
830 return(FALSE);
831 }
832
833 /*============================================*/
834 /* There must be at least one named construct */
835 /* in the import/export list at this point. */
836 /*============================================*/
837
838 if (theToken->type == RPAREN)
839 {
840 SyntaxErrorMessage(theEnv,errorMessage);
841 return(TRUE);
842 }
843
844 /*=====================================*/
845 /* Read in the list of imported items. */
846 /*=====================================*/
847
848 while (theToken->type != RPAREN)
849 {
850 if (theToken->type != thePortConstruct->typeExpected)
851 {
852 SyntaxErrorMessage(theEnv,errorMessage);
853 return(TRUE);
854 }
855
856 /*========================================*/
857 /* Create the data structure to represent */
858 /* the import/export specification for */
859 /* the named construct. */
860 /*========================================*/
861
862 newPort = (struct portItem *) get_struct(theEnv,portItem);
863 newPort->moduleName = moduleName;
864 newPort->constructType = theConstruct;
865 newPort->constructName = (SYMBOL_HN *) theToken->value;
866
867 /*=====================================*/
868 /* Add the new specification to either */
869 /* the import or export list. */
870 /*=====================================*/
871
872 if (importModule != NULL)
873 {
874 newPort->next = newModule->importList;
875 newModule->importList = newPort;
876 }
877 else
878 {
879 newPort->next = newModule->exportList;
880 newModule->exportList = newPort;
881 }
882
883 /*===================================*/
884 /* Move on to the next import/export */
885 /* specification. */
886 /*===================================*/
887
888 SavePPBuffer(theEnv," ");
889 GetToken(theEnv,readSource,theToken);
890 }
891
892 /*=============================*/
893 /* Fix up pretty print buffer. */
894 /*=============================*/
895
896 PPBackup(theEnv);
897 PPBackup(theEnv);
898 SavePPBuffer(theEnv,")");
899
900 /*============================================*/
901 /* Return FALSE to indicate the import/export */
902 /* specification was successfully parsed. */
903 /*============================================*/
904
905 return(FALSE);
906 }
907
908 /*************************************************************/
909 /* ValidPortConstructItem: Returns TRUE if a given construct */
910 /* name is in the list of constructs which can be exported */
911 /* and imported, otherwise FALSE is returned. */
912 /*************************************************************/
ValidPortConstructItem(void * theEnv,const char * theName)913 globle struct portConstructItem *ValidPortConstructItem(
914 void *theEnv,
915 const char *theName)
916 {
917 struct portConstructItem *theItem;
918
919 for (theItem = DefmoduleData(theEnv)->ListOfPortConstructItems;
920 theItem != NULL;
921 theItem = theItem->next)
922 { if (strcmp(theName,theItem->constructName) == 0) return(theItem); }
923
924 return(NULL);
925 }
926
927 /***********************************************************/
928 /* FindMultiImportConflict: Determines if a module imports */
929 /* the same named construct from more than one module */
930 /* (i.e. an ambiguous reference which is not allowed). */
931 /***********************************************************/
FindMultiImportConflict(void * theEnv,struct defmodule * theModule)932 static int FindMultiImportConflict(
933 void *theEnv,
934 struct defmodule *theModule)
935 {
936 struct defmodule *testModule;
937 int count;
938 struct portConstructItem *thePCItem;
939 struct construct *theConstruct;
940 void *theCItem;
941
942 /*==========================*/
943 /* Save the current module. */
944 /*==========================*/
945
946 SaveCurrentModule(theEnv);
947
948 /*============================*/
949 /* Loop through every module. */
950 /*============================*/
951
952 for (testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
953 testModule != NULL;
954 testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,testModule))
955 {
956 /*========================================*/
957 /* Loop through every construct type that */
958 /* can be imported/exported by a module. */
959 /*========================================*/
960
961 for (thePCItem = DefmoduleData(theEnv)->ListOfPortConstructItems;
962 thePCItem != NULL;
963 thePCItem = thePCItem->next)
964 {
965 EnvSetCurrentModule(theEnv,(void *) testModule);
966
967 /*=====================================================*/
968 /* Loop through every construct of the specified type. */
969 /*=====================================================*/
970
971 theConstruct = FindConstruct(theEnv,thePCItem->constructName);
972
973 for (theCItem = (*theConstruct->getNextItemFunction)(theEnv,NULL);
974 theCItem != NULL;
975 theCItem = (*theConstruct->getNextItemFunction)(theEnv,theCItem))
976 {
977 /*===============================================*/
978 /* Check to see if the specific construct in the */
979 /* module can be imported with more than one */
980 /* reference into the module we're examining for */
981 /* ambiguous import specifications. */
982 /*===============================================*/
983
984 EnvSetCurrentModule(theEnv,(void *) theModule);
985 FindImportedConstruct(theEnv,thePCItem->constructName,NULL,
986 ValueToString((*theConstruct->getConstructNameFunction)
987 ((struct constructHeader *) theCItem)),
988 &count,FALSE,NULL);
989 if (count > 1)
990 {
991 ImportExportConflictMessage(theEnv,"defmodule",EnvGetDefmoduleName(theEnv,theModule),
992 thePCItem->constructName,
993 ValueToString((*theConstruct->getConstructNameFunction)
994 ((struct constructHeader *) theCItem)));
995 RestoreCurrentModule(theEnv);
996 return(TRUE);
997 }
998
999 EnvSetCurrentModule(theEnv,(void *) testModule);
1000 }
1001 }
1002 }
1003
1004 /*=============================*/
1005 /* Restore the current module. */
1006 /*=============================*/
1007
1008 RestoreCurrentModule(theEnv);
1009
1010 /*=======================================*/
1011 /* Return FALSE to indicate no ambiguous */
1012 /* references were found. */
1013 /*=======================================*/
1014
1015 return(FALSE);
1016 }
1017
1018 /******************************************************/
1019 /* NotExportedErrorMessage: Generalized error message */
1020 /* for indicating that a construct type or specific */
1021 /* named construct is not exported. */
1022 /******************************************************/
NotExportedErrorMessage(void * theEnv,const char * theModule,const char * theConstruct,const char * theName)1023 static void NotExportedErrorMessage(
1024 void *theEnv,
1025 const char *theModule,
1026 const char *theConstruct,
1027 const char *theName)
1028 {
1029 PrintErrorID(theEnv,"MODULPSR",1,TRUE);
1030 EnvPrintRouter(theEnv,WERROR,"Module ");
1031 EnvPrintRouter(theEnv,WERROR,theModule);
1032 EnvPrintRouter(theEnv,WERROR," does not export ");
1033
1034 if (theConstruct == NULL) EnvPrintRouter(theEnv,WERROR,"any constructs");
1035 else if (theName == NULL)
1036 {
1037 EnvPrintRouter(theEnv,WERROR,"any ");
1038 EnvPrintRouter(theEnv,WERROR,theConstruct);
1039 EnvPrintRouter(theEnv,WERROR," constructs");
1040 }
1041 else
1042 {
1043 EnvPrintRouter(theEnv,WERROR,"the ");
1044 EnvPrintRouter(theEnv,WERROR,theConstruct);
1045 EnvPrintRouter(theEnv,WERROR," ");
1046 EnvPrintRouter(theEnv,WERROR,theName);
1047 }
1048
1049 EnvPrintRouter(theEnv,WERROR,".\n");
1050 }
1051
1052 /*************************************************************/
1053 /* FindImportExportConflict: Determines if the definition of */
1054 /* a construct would cause an import/export conflict. The */
1055 /* construct is not yet defined when this function is */
1056 /* called. TRUE is returned if an import/export conflicts */
1057 /* is found, otherwise FALSE is returned. */
1058 /*************************************************************/
FindImportExportConflict(void * theEnv,const char * constructName,struct defmodule * matchModule,const char * findName)1059 globle int FindImportExportConflict(
1060 void *theEnv,
1061 const char *constructName,
1062 struct defmodule *matchModule,
1063 const char *findName)
1064 {
1065 struct defmodule *theModule;
1066 struct moduleItem *theModuleItem;
1067 int count;
1068
1069 /*===========================================================*/
1070 /* If the construct type can't be imported or exported, then */
1071 /* it's not possible to have an import/export conflict. */
1072 /*===========================================================*/
1073
1074 if (ValidPortConstructItem(theEnv,constructName) == NULL) return(FALSE);
1075
1076 /*============================================*/
1077 /* There module name should already have been */
1078 /* separated fromthe construct's name. */
1079 /*============================================*/
1080
1081 if (FindModuleSeparator(findName)) return(FALSE);
1082
1083 /*===============================================================*/
1084 /* The construct must be capable of being stored within a module */
1085 /* (this test should never fail). The construct must also have */
1086 /* a find function associated with it so we can actually look */
1087 /* for import/export conflicts. */
1088 /*===============================================================*/
1089
1090 if ((theModuleItem = FindModuleItem(theEnv,constructName)) == NULL) return(FALSE);
1091
1092 if (theModuleItem->findFunction == NULL) return(FALSE);
1093
1094 /*==========================*/
1095 /* Save the current module. */
1096 /*==========================*/
1097
1098 SaveCurrentModule(theEnv);
1099
1100 /*================================================================*/
1101 /* Look at each module and count each definition of the specified */
1102 /* construct which is visible to the module. If more than one */
1103 /* definition is visible, then an import/export conflict exists */
1104 /* and TRUE is returned. */
1105 /*================================================================*/
1106
1107 for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
1108 theModule != NULL;
1109 theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
1110 {
1111 EnvSetCurrentModule(theEnv,(void *) theModule);
1112
1113 FindImportedConstruct(theEnv,constructName,NULL,findName,&count,TRUE,matchModule);
1114 if (count > 1)
1115 {
1116 RestoreCurrentModule(theEnv);
1117 return(TRUE);
1118 }
1119 }
1120
1121 /*==========================================*/
1122 /* Restore the current module. No conflicts */
1123 /* were detected so FALSE is returned. */
1124 /*==========================================*/
1125
1126 RestoreCurrentModule(theEnv);
1127 return(FALSE);
1128 }
1129
1130 #endif /* DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY) */
1131
1132 /*********************************************/
1133 /* GetNumberOfDefmodules: Returns the number */
1134 /* of defmodules currently defined. */
1135 /*********************************************/
GetNumberOfDefmodules(void * theEnv)1136 globle long GetNumberOfDefmodules(
1137 void *theEnv)
1138 {
1139 #if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY)
1140 return(DefmoduleData(theEnv)->NumberOfDefmodules);
1141 #else
1142 return 1L;
1143 #endif
1144 }
1145
1146
1147