1 /* -----------------------------------------------------------------------------
2  * This file is part of SWIG, which is licensed as a whole under version 3
3  * (or any later version) of the GNU General Public License. Some additional
4  * terms also apply to certain portions of SWIG. The full details of the SWIG
5  * license and copyrights can be found in the LICENSE and COPYRIGHT files
6  * included with the SWIG source code as distributed by the SWIG developers
7  * and at http://www.swig.org/legal.html.
8  *
9  * modula3.cxx
10  *
11  * Modula3 language module for SWIG.
12  * ----------------------------------------------------------------------------- */
13 
14 /*
15   Text formatted with
16     indent -sob -br -ce -nut -npsl
17 */
18 
19 /*
20   Report:
21    - It's not a good concept to use member variables or global variables
22      for passing parameters to functions.
23      It's not a good concept to use functions of superclasses for specific services.
24      E.g. For SWIG this means: Generating accessor functions for member variables
25      is the most common but no general task to be processed in membervariableHandler.
26      Better provide a service function which generates accessor function code
27      and equip this service function with all parameters needed for input (parse node)
28      and output (generated code).
29    - How can I make globalvariableHandler not to generate
30      interface functions to two accessor functions
31      (that don't exist) ?
32    - How can I generate a typemap that turns every C reference argument into
33      its Modula 3 counterpart, that is
34        void test(Complex &z);
35        PROCEDURE test(VAR z:Complex);
36    - neither $*n_mangle nor $*n_type nor $*n_ltype return the type without
37      pointer converted to Modula3 equivalent,
38      $*n_mangle is the variant closest to what I expect
39    - using a typemap like
40          typemap(m3wrapintype) int * %{VAR $1_name: INTEGER%}
41      has the advantages:
42        - one C parameter can be turned into multiple M3 parameters
43        - the argument can be renamed
44    - using typemaps like
45          typemap(m3wrapinmode) int * "VAR"
46          typemap(m3wrapintype) int * "INTEGER"
47      has the advantages:
48        - multiple parameters with same type and default value can be bundled
49        - more conform to the other language modules
50    - Where takes the reduction of multi-typemaps place?
51      How can I preserve all parameters for functions of the intermediary class?
52      The answer is Getattrs(n,"tmap:m3rawintype:next")
53    - Char() can be used to transform a String to (char *)
54      which can be used for output with printf
55    - What is the while (checkAttribute()) loop in functionWrapper good for?
56      Appearently for skipping (numinputs=0) typemaps.
57    - SWIGTYPE const * - typemap is ignored, whereas
58      SWIGTYPE *       - typemap is invoked, why?
59      Had it been (const SWIGTYPE *) instead?
60    - enumeration items should definitely be equipped
61      with its plain numerical value
62      One could add tag 'numvalue' in CParse/parser.y,
63      but it is still possible that someone declares an
64      enumeration using a symbolic constant.
65      I have quickly hacked
66      that the successive number is assigned
67      if "enumvalue" has suffix "+1".
68      The ultimate solution would be to generate a C program
69      which includes the header and outputs all constants.
70      This program might be compiled and run
71      by 'make' or by SWIG and the resulting output is fed back to SWIG.
72    - It's a bad idea to interpret feature value ""
73      'disable feature' because the value ""
74      might be sensible in case of feature:modula3:oldprefix.
75    - What's the difference between "sym:name" and "name" ?
76      "name" is the original name and
77      "sym:name" is probably modified by the user using %rename
78    - Is it possible for 'configure' to find out if m3pp is installed
79      and to invoke it for generated Modula3 files?
80    - It would be better to separate an arguments purpose and its name,
81      because an output variable with name "OUTPUT" is not very descriptive.
82      In case of PLPlot this could be solved by typedefs
83      that assign special purposes to the array types.
84    - Can one interpret $n_basetype as the identifier matched with SWIGTYPE ?
85 
86   SWIG's odds:
87    - arguments of type (Node *) for SWIG functions
88      should be most often better (const Node *):
89      Swig_symbol_qualified, Getattr, nodeType, parentNode
90    - unique identifier style instead of
91      NewString, Getattr, firstChild
92    - 'class'.name is qualified,
93      'enum'.name and 'enumitem'.name is not
94    - Swig_symbol_qualified() returns NIL for enumeration nodes
95 
96    - Is there a function that creates a C representation of a SWIG type string?
97 
98   ToDo:
99    - create WeakRefs only for resources returned by function marked with %newobject
100       -> part of output conversion
101    - clean typemap conception
102       - should a multi-typemap for m3wrapouttype skip the corresponding input parameters?
103         when yes - How to handle inout-arguments? In this case like in-argument.
104    - C++ classes
105    - C++ exceptions
106    - allow for moving RECORD and OBJECT definitions
107      to separate files, with the main type called T
108    - call-back functions
109    - special option: fast access to class members by pointer arithmetic,
110        member offsets can be determined by a C++ program that print them.
111    - emit enumeration definitions when its first item is declared,
112        currently enumerations are emitted at the beginning of the file
113 
114   Done:
115    - addThrow should convert the typemap by itself
116       - not possible because routine for attaching mapped types to parameter nodes
117         won't work for the function node
118    - turning error codes into exceptions
119       -> part of output value checking
120    - create WeakRefs for resources allocated by the library
121       -> part of output conversion
122    - TRY..FINALLY..END; can be omitted
123       - if there is no m3wrapfreearg
124       - no exception can be raised in the body (empty RAISES) list
125 */
126 
127 #include "swigmod.h"
128 
129 #include <limits.h>		// for INT_MAX
130 #include <ctype.h>
131 
132 #define USAGE_ARG_DIR "m3wrapargdir typemap expect values: in, out, inout\n"
133 
134 class MODULA3:public Language {
135 public:
136   enum block_type { no_block, constant, variable, blocktype, revelation };
137 
138 private:
139   struct M3File {
140     String *f;
141     Hash *import;
142     block_type bt;
143     /* VC++ 6 doesn't allow the access to 'no_block'
144        if it is a private member of MODULA3 class */
M3FileMODULA3::M3File145     M3File():f(NewString("")), import(NewHash()), bt(no_block) {
146     }
~M3FileMODULA3::M3File147     ~M3File() {
148       Delete(f);
149       Delete(import);
150     }
151 
152     /* -----------------------------------------------------------------------------
153      * enterBlock()
154      *
155      * Make sure that a given declaration is written to the right declaration block,
156      * that is constants are written after "CONST" and so on ...
157      * ----------------------------------------------------------------------------- */
enterBlockMODULA3::M3File158     void enterBlock(block_type newbt) {
159       static const char *ident[] = { "", "\nCONST\n", "\nVAR\n", "\nTYPE\n", "\nREVEAL\n" };
160 #ifdef DEBUG
161       if ((bt < 0) || (4 < bt)) {
162 	printf("bt %d out of range\n", bt);
163       }
164 #endif
165       if (newbt != bt) {
166 	Append(f, ident[newbt]);
167 	bt = newbt;
168       }
169     }
170 
171   };
172 
173   static const char *usage;
174   const String *empty_string;
175 
176   Hash *swig_types_hash;
177   File *f_begin;
178   File *f_runtime;
179   File *f_header;
180   File *f_wrappers;
181   File *f_init;
182 
183   bool proxy_flag;		// Flag for generating proxy classes
184   bool have_default_constructor_flag;
185   bool native_function_flag;	// Flag for when wrapping a native function
186   bool enum_constant_flag;	// Flag for when wrapping an enum or constant
187   bool static_flag;		// Flag for when wrapping a static functions or member variables
188   bool variable_wrapper_flag;	// Flag for when wrapping a nonstatic member variable
189   bool wrapping_member_flag;	// Flag for when wrapping a member variable/enum/const
190   bool global_variable_flag;	// Flag for when wrapping a global variable
191   bool old_variable_names;	// Flag for old style variable names in the intermediary class
192   bool unsafe_module;
193 
194   String *m3raw_name;		// raw interface name
195   M3File m3raw_intf;		// raw interface
196   M3File m3raw_impl;		// raw implementation (usually empty)
197   String *m3wrap_name;		// wrapper module
198   M3File m3wrap_intf;
199   M3File m3wrap_impl;
200   String *m3makefile;
201   String *targetlibrary;
202   String *proxy_class_def;
203   String *proxy_class_code;
204   String *proxy_class_name;
205   String *variable_name;	//Name of a variable being wrapped
206   String *variable_type;	//Type of this variable
207   Hash *enumeration_coll;	//Collection of all enumerations.
208   /* The items are nodes with members:
209      "items"  - hash of with key 'itemname' and content 'itemvalue'
210      "max"    - maximum value in item list
211    */
212   String *constant_values;
213   String *constantfilename;
214   String *renamefilename;
215   String *typemapfilename;
216   String *m3raw_imports;	//intermediary class imports from %pragma
217   String *module_imports;	//module imports from %pragma
218   String *m3raw_baseclass;	//inheritance for intermediary class class from %pragma
219   String *module_baseclass;	//inheritance for module class from %pragma
220   String *m3raw_interfaces;	//interfaces for intermediary class class from %pragma
221   String *module_interfaces;	//interfaces for module class from %pragma
222   String *m3raw_class_modifiers;	//class modifiers for intermediary class overridden by %pragma
223   String *m3wrap_modifiers;	//class modifiers for module class overridden by %pragma
224   String *upcasts_code;		//C++ casts for inheritance hierarchies C++ code
225   String *m3raw_cppcasts_code;	//C++ casts up inheritance hierarchies intermediary class code
226   String *destructor_call;	//C++ destructor call if any
227   String *outfile;
228 
229   enum type_additions { none, pointer, reference };
230 
231 public:
232 
233   /* -----------------------------------------------------------------------------
234    * MODULA3()
235    * ----------------------------------------------------------------------------- */
236 
MODULA3()237 MODULA3():
238   empty_string(NewString("")),
239       swig_types_hash(NULL),
240       f_begin(NULL),
241       f_runtime(NULL),
242       f_header(NULL),
243       f_wrappers(NULL),
244       f_init(NULL),
245       proxy_flag(true),
246       have_default_constructor_flag(false),
247       native_function_flag(false),
248       enum_constant_flag(false),
249       static_flag(false),
250       variable_wrapper_flag(false),
251       wrapping_member_flag(false),
252       global_variable_flag(false),
253       old_variable_names(false),
254       unsafe_module(false),
255       m3raw_name(NULL),
256       m3raw_intf(),
257       m3raw_impl(),
258       m3wrap_name(NULL),
259       m3wrap_intf(),
260       m3wrap_impl(),
261       m3makefile(NULL),
262       targetlibrary(NULL),
263       proxy_class_def(NULL),
264       proxy_class_code(NULL),
265       proxy_class_name(NULL),
266       variable_name(NULL),
267       variable_type(NULL),
268       enumeration_coll(NULL),
269       constant_values(NULL),
270       constantfilename(NULL),
271       renamefilename(NULL),
272       typemapfilename(NULL),
273       m3raw_imports(NULL),
274       module_imports(NULL),
275       m3raw_baseclass(NULL),
276       module_baseclass(NULL),
277       m3raw_interfaces(NULL),
278       module_interfaces(NULL),
279       m3raw_class_modifiers(NULL),
280       m3wrap_modifiers(NULL),
281       upcasts_code(NULL),
282       m3raw_cppcasts_code(NULL),
283       destructor_call(NULL),
284       outfile(NULL) {
285   }
286 
287   /************** some utility functions ***************/
288 
289   /* -----------------------------------------------------------------------------
290    * getMappedType()
291    *
292    * Return the type of 'p' mapped by 'map'.
293    * Print a standard warning if 'p' can't be mapped.
294    * ----------------------------------------------------------------------------- */
295 
getMappedType(Node * p,const char * map)296   String *getMappedType(Node *p, const char *map) {
297     String *mapattr = NewString("tmap:");
298     Append(mapattr, map);
299 
300     String *tm = Getattr(p, mapattr);
301     if (tm == NIL) {
302       Swig_warning(WARN_MODULA3_TYPEMAP_TYPE_UNDEF, input_file, line_number,
303 		   "No '%s' typemap defined for type '%s'\n", map, SwigType_str(Getattr(p, "type"), 0));
304     }
305     Delete(mapattr);
306     return tm;
307   }
308 
309   /* -----------------------------------------------------------------------------
310    * getMappedTypeNew()
311    *
312    * Similar to getMappedType but uses Swig_type_lookup_new.
313    * ----------------------------------------------------------------------------- */
314 
getMappedTypeNew(Node * n,const char * map,const char * lname="",bool warn=true)315   String *getMappedTypeNew(Node *n, const char *map, const char *lname = "", bool warn = true) {
316     String *tm = Swig_typemap_lookup(map, n, lname, 0);
317     if ((tm == NIL) && warn) {
318       Swig_warning(WARN_MODULA3_TYPEMAP_TYPE_UNDEF, input_file, line_number,
319 		   "No '%s' typemap defined for type '%s'\n", map, SwigType_str(Getattr(n, "type"), 0));
320     }
321     return tm;
322   }
323 
324   /* -----------------------------------------------------------------------------
325    * attachMappedType()
326    *
327    * Obtain the type mapped by 'map' and attach it to the node
328    * ----------------------------------------------------------------------------- */
329 
attachMappedType(Node * n,const char * map,const char * lname="")330   void attachMappedType(Node *n, const char *map, const char *lname = "") {
331     String *tm = Swig_typemap_lookup(map, n, lname, 0);
332     if (tm != NIL) {
333       String *attr = NewStringf("tmap:%s", map);
334       Setattr(n, attr, tm);
335       Delete(attr);
336     }
337   }
338 
339   /* -----------------------------------------------------------------------------
340    * skipIgnored()
341    *
342    * Skip all parameters that have 'numinputs=0'
343    * with respect to a given typemap.
344    * ----------------------------------------------------------------------------- */
345 
skipIgnored(Node * p,const char * map)346   Node *skipIgnored(Node *p, const char *map) {
347     String *niattr = NewStringf("tmap:%s:numinputs", map);
348     String *nextattr = NewStringf("tmap:%s:next", map);
349 
350     while ((p != NIL) && checkAttribute(p, niattr, "0")) {
351       p = Getattr(p, nextattr);
352     }
353 
354     Delete(nextattr);
355     Delete(niattr);
356     return p;
357   }
358 
359   /* -----------------------------------------------------------------------------
360    * isInParam()
361    * isOutParam()
362    *
363    * Check if the parameter is intended for input or for output.
364    * ----------------------------------------------------------------------------- */
365 
isInParam(Node * p)366   bool isInParam(Node *p) {
367     String *dir = Getattr(p, "tmap:m3wrapargdir");
368 //printf("dir for %s: %s\n", Char(Getattr(p,"name")), Char(dir));
369     if ((dir == NIL) || (Strcmp(dir, "in") == 0)
370 	|| (Strcmp(dir, "inout") == 0)) {
371       return true;
372     } else if (Strcmp(dir, "out") == 0) {
373       return false;
374     } else {
375       printf("%s", USAGE_ARG_DIR);
376       return false;
377     }
378   }
379 
isOutParam(Node * p)380   bool isOutParam(Node *p) {
381     String *dir = Getattr(p, "tmap:m3wrapargdir");
382     if ((dir == NIL) || (Strcmp(dir, "in") == 0)) {
383       return false;
384     } else if ((Strcmp(dir, "out") == 0) || (Strcmp(dir, "inout") == 0)) {
385       return true;
386     } else {
387       printf("%s", USAGE_ARG_DIR);
388       return false;
389     }
390   }
391 
392   /* -----------------------------------------------------------------------------
393    * printAttrs()
394    *
395    * For debugging: Show all attributes of a node and their values.
396    * ----------------------------------------------------------------------------- */
printAttrs(Node * n)397   void printAttrs(Node *n) {
398     Iterator it;
399     for (it = First(n); it.key != NIL; it = Next(it)) {
400       printf("%s = %s\n", Char(it.key), Char(Getattr(n, it.key)));
401     }
402   }
403 
404   /* -----------------------------------------------------------------------------
405    * hasPrefix()
406    *
407    * Check if a string have a given prefix.
408    * ----------------------------------------------------------------------------- */
hasPrefix(const String * str,const String * prefix)409   bool hasPrefix(const String *str, const String *prefix) {
410     int len_prefix = Len(prefix);
411     return (Len(str) > len_prefix)
412 	&& (Strncmp(str, prefix, len_prefix) == 0);
413   }
414 
415   /* -----------------------------------------------------------------------------
416    * getQualifiedName()
417    *
418    * Return fully qualified identifier of n.
419    * ----------------------------------------------------------------------------- */
420 #if 0
421   // Swig_symbol_qualified returns NIL for enumeration nodes
422   String *getQualifiedName(Node *n) {
423     String *qual = Swig_symbol_qualified(n);
424     String *name = Getattr(n, "name");
425     if (hasContent(qual)) {
426       return NewStringf("%s::%s", qual, name);
427     } else {
428       return name;
429     }
430   }
431 #else
getQualifiedName(Node * n)432   String *getQualifiedName(Node *n) {
433     String *name = Copy(Getattr(n, "name"));
434     n = parentNode(n);
435     while (n != NIL) {
436       const String *type = nodeType(n);
437       if ((Strcmp(type, "class") == 0) || (Strcmp(type, "struct") == 0) || (Strcmp(type, "namespace") == 0)) {
438 	String *newname = NewStringf("%s::%s", Getattr(n, "name"), name);
439 	Delete(name);
440 	//name = newname;
441 	// Hmpf, the class name is already qualified.
442 	return newname;
443       }
444       n = parentNode(n);
445     }
446     //printf("qualified name: %s\n", Char(name));
447     return name;
448   }
449 #endif
450 
451   /* -----------------------------------------------------------------------------
452    * nameToModula3()
453    *
454    * Turn usual C identifiers like "this_is_an_identifier"
455    * into usual Modula 3 identifier like "thisIsAnIdentifier"
456    * ----------------------------------------------------------------------------- */
nameToModula3(const String * sym,bool leadingCap)457   String *nameToModula3(const String *sym, bool leadingCap) {
458     int len_sym = Len(sym);
459     char *csym = Char(sym);
460     char *m3sym = new char[len_sym + 1];
461     int i, j;
462     bool cap = leadingCap;
463     for (i = 0, j = 0; j < len_sym; j++) {
464       char c = csym[j];
465       if ((c == '_') || (c == ':')) {
466 	cap = true;
467       } else {
468 	if (isdigit(c)) {
469 	  m3sym[i] = c;
470 	  cap = true;
471 	} else {
472 	  if (cap) {
473 	    m3sym[i] = (char)toupper(c);
474 	  } else {
475 	    m3sym[i] = (char)tolower(c);
476 	  }
477 	  cap = false;
478 	}
479 	i++;
480       }
481     }
482     m3sym[i] = 0;
483     String *result = NewString(m3sym);
484     delete[]m3sym;
485     return result;
486   }
487 
488   /* -----------------------------------------------------------------------------
489    * capitalizeFirst()
490    *
491    * Make the first character upper case.
492    * ----------------------------------------------------------------------------- */
capitalizeFirst(const String * str)493   String *capitalizeFirst(const String *str) {
494     return NewStringf("%c%s", toupper(*Char(str)), Char(str) + 1);
495   }
496 
497   /* -----------------------------------------------------------------------------
498    * prefixedNameToModula3()
499    *
500    * If feature modula3:oldprefix and modula3:newprefix is present
501    * and the C identifier has leading 'oldprefix'
502    * then it is replaced by the 'newprefix'.
503    * The rest is converted to Modula style.
504    * ----------------------------------------------------------------------------- */
prefixedNameToModula3(Node * n,const String * sym,bool leadingCap)505   String *prefixedNameToModula3(Node *n, const String *sym, bool leadingCap) {
506     String *oldPrefix = Getattr(n, "feature:modula3:oldprefix");
507     String *newPrefix = Getattr(n, "feature:modula3:newprefix");
508     String *result = NewString("");
509     char *short_sym = Char(sym);
510     // if at least one prefix feature is present
511     // the replacement takes place
512     if ((oldPrefix != NIL) || (newPrefix != NIL)) {
513       if ((oldPrefix == NIL) || hasPrefix(sym, oldPrefix)) {
514 	short_sym += Len(oldPrefix);
515 	if (newPrefix != NIL) {
516 	  Append(result, newPrefix);
517 	}
518       }
519     }
520     String *suffix = nameToModula3(short_sym, leadingCap || hasContent(newPrefix));
521     Append(result, suffix);
522     Delete(suffix);
523     return result;
524   }
525 
526   /* -----------------------------------------------------------------------------
527    * hasContent()
528    *
529    * Check if the string exists and contains something.
530    * ----------------------------------------------------------------------------- */
hasContent(const String * str)531   bool hasContent(const String *str) {
532     return (str != NIL) && (Strcmp(str, "") != 0);
533   }
534 
535   /* -----------------------------------------------------------------------------
536    * openWriteFile()
537    *
538    * Caution: The file must be freshly allocated and will be destroyed
539    *          by this routine.
540    * ----------------------------------------------------------------------------- */
541 
openWriteFile(String * name)542   File *openWriteFile(String *name) {
543     File *file = NewFile(name, "w", SWIG_output_files());
544     if (!file) {
545       FileErrorDisplay(name);
546       SWIG_exit(EXIT_FAILURE);
547     }
548     Delete(name);
549     return file;
550   }
551 
552   /* -----------------------------------------------------------------------------
553    * aToL()
554    *
555    * like atol but with additional user warning
556    * ----------------------------------------------------------------------------- */
557 
aToL(const String * value)558   long aToL(const String *value) {
559     char *endptr;
560     long numvalue = strtol(Char(value), &endptr, 0);
561     if (*endptr != 0) {
562       Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "The string <%s> does not denote a numeric value.\n", value);
563     }
564     return numvalue;
565   }
566 
567   /* -----------------------------------------------------------------------------
568    * strToL()
569    *
570    * like strtol but returns if the conversion was successful
571    * ----------------------------------------------------------------------------- */
572 
strToL(const String * value,long & numvalue)573   bool strToL(const String *value, long &numvalue) {
574     char *endptr;
575     numvalue = strtol(Char(value), &endptr, 0);
576     return (*endptr == 0);
577   }
578 
579   /* -----------------------------------------------------------------------------
580    * evalExpr()
581    *
582    * Evaluate simple expression as they may occur in "enumvalue" attributes.
583    * ----------------------------------------------------------------------------- */
584 
evalExpr(String * value,long & numvalue)585   bool evalExpr(String *value, long &numvalue) {
586     // Split changes file status of String and thus cannot receive 'const' strings
587 //printf("evaluate <%s>\n", Char(value));
588     List *summands = Split(value, '+', INT_MAX);
589     Iterator sm = First(summands);
590     numvalue = 0;
591     for (; sm.item != NIL; sm = Next(sm)) {
592       String *smvalue = Getattr(constant_values, sm.item);
593       long smnumvalue;
594       if (smvalue != NIL) {
595 	if (!strToL(smvalue, smnumvalue)) {
596 //printf("evaluation: abort 0 <%s>\n", Char(smvalue));
597 	  return false;
598 	}
599       } else {
600 	if (!strToL(sm.item, smnumvalue)) {
601 //printf("evaluation: abort 1 <%s>\n", Char(sm));
602 	  return false;
603 	}
604       }
605       numvalue += smnumvalue;
606     }
607 //printf("evaluation: return %ld\n", numvalue);
608     return true;
609   }
610 
611   /* -----------------------------------------------------------------------------
612    * log2()
613    *
614    * Determine the position of the single bit of a power of two.
615    * Returns true if the given number is a power of two.
616    * ----------------------------------------------------------------------------- */
617 
log2(long n,long & exp)618   bool log2(long n, long &exp) {
619     exp = 0;
620     while (n > 0) {
621       if ((n & 1) != 0) {
622 	return n == 1;
623       }
624       exp++;
625       n >>= 1;
626     }
627     return false;
628   }
629 
630   /* -----------------------------------------------------------------------------
631    * writeArg
632    *
633    * Write a function argument or RECORD entry definition.
634    * Bundles arguments of same type and default value.
635    * 'name.next==NIL' denotes the end of the entry or argument list.
636    * ----------------------------------------------------------------------------- */
637 
equalNilStr(const String * str0,const String * str1)638   bool equalNilStr(const String *str0, const String *str1) {
639     if (str0 == NIL) {
640       return (str1 == NIL);
641       //return (str0==NIL) == (str1==NIL);
642     } else {
643       return (str1 != NIL) && (Cmp(str0, str1) == 0);
644       //return Cmp(str0,str1)==0;
645     }
646   }
647 
648   struct writeArgState {
649     String *mode, *name, *type, *value;
650     bool hold;
writeArgStateMODULA3::writeArgState651      writeArgState():mode(NIL), name(NIL), type(NIL), value(NIL), hold(false) {
652     }
653   };
654 
writeArg(File * f,writeArgState & state,String * mode,String * name,String * type,String * value)655   void writeArg(File *f, writeArgState & state, String *mode, String *name, String *type, String *value) {
656     /* skip the first argument,
657        only store the information for the next call in this case */
658     if (state.name != NIL) {
659       if ((!state.hold) && (state.mode != NIL)) {
660 	Printf(f, "%s ", state.mode);
661       }
662       if ((name != NIL) && equalNilStr(state.mode, mode) && equalNilStr(state.type, type) && (state.value == NIL) && (value == NIL)
663 	  /* the same expression may have different values
664 	     due to side effects of the called function */
665 	  /*equalNilStr(state.value,value) */
666 	  ) {
667 	Printf(f, "%s, ", state.name);
668 	state.hold = true;
669       } else {
670 	Append(f, state.name);
671 	if (state.type != NIL) {
672 	  Printf(f, ": %s", state.type);
673 	}
674 	if (state.value != NIL) {
675 	  Printf(f, ":= %s", state.value);
676 	}
677 	Append(f, ";\n");
678 	state.hold = false;
679       }
680     }
681     /* at the next call the current argument will be the previous one */
682     state.mode = mode;
683     state.name = name;
684     state.type = type;
685     state.value = value;
686   }
687 
688   /* -----------------------------------------------------------------------------
689    * getProxyName()
690    *
691    * Test to see if a type corresponds to something wrapped with a proxy class
692    * Return NULL if not otherwise the proxy class name
693    * ----------------------------------------------------------------------------- */
694 
getProxyName(SwigType * t)695   String *getProxyName(SwigType *t) {
696     if (proxy_flag) {
697       Node *n = classLookup(t);
698       if (n) {
699 	return Getattr(n, "sym:name");
700       }
701     }
702     return NULL;
703   }
704 
705   /*************** language processing ********************/
706 
707   /* ------------------------------------------------------------
708    * main()
709    * ------------------------------------------------------------ */
710 
main(int argc,char * argv[])711   virtual void main(int argc, char *argv[]) {
712 
713     SWIG_library_directory("modula3");
714 
715     // Look for certain command line options
716     for (int i = 1; i < argc; i++) {
717       if (argv[i]) {
718 	if (strcmp(argv[i], "-generateconst") == 0) {
719 	  if (argv[i + 1]) {
720 	    constantfilename = NewString(argv[i + 1]);
721 	    Swig_mark_arg(i);
722 	    Swig_mark_arg(i + 1);
723 	    i++;
724 	  } else {
725 	    Swig_arg_error();
726 	  }
727 	} else if (strcmp(argv[i], "-generaterename") == 0) {
728 	  if (argv[i + 1]) {
729 	    renamefilename = NewString(argv[i + 1]);
730 	    Swig_mark_arg(i);
731 	    Swig_mark_arg(i + 1);
732 	    i++;
733 	  } else {
734 	    Swig_arg_error();
735 	  }
736 	} else if (strcmp(argv[i], "-generatetypemap") == 0) {
737 	  if (argv[i + 1]) {
738 	    typemapfilename = NewString(argv[i + 1]);
739 	    Swig_mark_arg(i);
740 	    Swig_mark_arg(i + 1);
741 	    i++;
742 	  } else {
743 	    Swig_arg_error();
744 	  }
745 	} else if (strcmp(argv[i], "-noproxy") == 0) {
746 	  Swig_mark_arg(i);
747 	  proxy_flag = false;
748 	} else if (strcmp(argv[i], "-oldvarnames") == 0) {
749 	  Swig_mark_arg(i);
750 	  old_variable_names = true;
751 	} else if (strcmp(argv[i], "-help") == 0) {
752 	  Printf(stdout, "%s\n", usage);
753 	}
754       }
755     }
756 
757     // Add a symbol to the parser for conditional compilation
758     Preprocessor_define("SWIGMODULA3 1", 0);
759 
760     // Add typemap definitions
761     SWIG_typemap_lang("modula3");
762     SWIG_config_file("modula3.swg");
763 
764     allow_overloading();
765   }
766 
767   /* ---------------------------------------------------------------------
768    * top()
769    * --------------------------------------------------------------------- */
770 
top(Node * n)771   virtual int top(Node *n) {
772     if (hasContent(constantfilename) || hasContent(renamefilename) || hasContent(typemapfilename)) {
773       int result = SWIG_OK;
774       if (hasContent(constantfilename)) {
775 	result = generateConstantTop(n) && result;
776       }
777       if (hasContent(renamefilename)) {
778 	result = generateRenameTop(n) && result;
779       }
780       if (hasContent(typemapfilename)) {
781 	result = generateTypemapTop(n) && result;
782       }
783       return result;
784     } else {
785       return generateM3Top(n);
786     }
787   }
788 
scanConstant(File * file,Node * n)789   void scanConstant(File *file, Node *n) {
790     Node *child = firstChild(n);
791     while (child != NIL) {
792       String *constname = NIL;
793       String *type = nodeType(child);
794       if ((Strcmp(type, "enumitem") == 0)
795 	  || (Strcmp(type, "constant") == 0)) {
796 #if 1
797 	constname = getQualifiedName(child);
798 #else
799 	constname = Getattr(child, "value");
800 	if ((!hasContent(constname))
801 	    || (('0' <= *Char(constname)) && (*Char(constname) <= '9'))) {
802 	  constname = Getattr(child, "name");
803 	}
804 #endif
805       }
806       if (constname != NIL) {
807 	Printf(file, "  printf(\"%%%%constnumeric(%%Lg) %s;\\n\", (long double)%s);\n", constname, constname);
808       }
809       scanConstant(file, child);
810       child = nextSibling(child);
811     }
812   }
813 
generateConstantTop(Node * n)814   int generateConstantTop(Node *n) {
815     File *file = openWriteFile(NewStringf("%s.c", constantfilename));
816     if (CPlusPlus) {
817       Printf(file, "#include <cstdio>\n");
818     } else {
819       Printf(file, "#include <stdio.h>\n");
820     }
821     Printf(file, "#include \"%s\"\n", input_file);
822     Printf(file, "\n");
823     Printf(file, "int main (int argc, char *argv[]) {\n");
824     Printf(file, "\
825 /*This program must work for floating point numbers and integers.\n\
826   Thus all numbers are converted to double precision floating point format.*/\n");
827     scanConstant(file, n);
828     Printf(file, "  return 0;\n");
829     Printf(file, "}\n");
830     Delete(file);
831     return SWIG_OK;
832   }
833 
scanRename(File * file,Node * n)834   void scanRename(File *file, Node *n) {
835     Node *child = firstChild(n);
836     while (child != NIL) {
837       String *type = nodeType(child);
838       if (Strcmp(type, "cdecl") == 0) {
839 	ParmList *p = Getattr(child, "parms");
840 	if (p != NIL) {
841 	  String *name = getQualifiedName(child);
842 	  String *m3name = nameToModula3(name, true);
843 	  /*don't know how to get the original C type identifiers */
844 	  //String *arguments = createCSignature (child);
845 	  Printf(file, "%%rename(\"%s\") %s;\n", m3name, name);
846 	  /*Printf(file, "%%rename(\"%s\") %s %s(%s);\n",
847 	     m3name, Getattr(n,"type"), name, arguments); */
848 	  Delete(name);
849 	  Delete(m3name);
850 	  //Delete (arguments);
851 	}
852       }
853       scanRename(file, child);
854       child = nextSibling(child);
855     }
856   }
857 
generateRenameTop(Node * n)858   int generateRenameTop(Node *n) {
859     File *file = openWriteFile(NewStringf("%s.i", renamefilename));
860     Printf(file, "\
861 /* This file was generated from %s\n\
862    by SWIG with option -generaterename. */\n\
863 \n", input_file);
864     scanRename(file, n);
865     Delete(file);
866     return SWIG_OK;
867   }
868 
scanTypemap(File * file,Node * n)869   void scanTypemap(File *file, Node *n) {
870     Node *child = firstChild(n);
871     while (child != NIL) {
872       String *type = nodeType(child);
873       //printf("nodetype %s\n", Char(type));
874       String *storage = Getattr(child, "storage");
875       if ((Strcmp(type, "class") == 0) || ((Strcmp(type, "cdecl") == 0) && (storage != NIL)
876 					   && (Strcmp(storage, "typedef") == 0))) {
877 	String *name = getQualifiedName(child);
878 	String *m3name = nameToModula3(name, true);
879 	Printf(file, "%%typemap(\"m3wrapintype\") %s %%{%s%%}\n", name, m3name);
880 	Printf(file, "%%typemap(\"m3rawintype\") %s %%{%s%%}\n", name, m3name);
881 	Printf(file, "\n");
882       }
883       scanTypemap(file, child);
884       child = nextSibling(child);
885     }
886   }
887 
generateTypemapTop(Node * n)888   int generateTypemapTop(Node *n) {
889     File *file = openWriteFile(NewStringf("%s.i", typemapfilename));
890     Printf(file, "\
891 /* This file was generated from %s\n\
892    by SWIG with option -generatetypemap. */\n\
893 \n", input_file);
894     scanTypemap(file, n);
895     Delete(file);
896     return SWIG_OK;
897   }
898 
generateM3Top(Node * n)899   int generateM3Top(Node *n) {
900     /* Initialize all of the output files */
901     outfile = Getattr(n, "outfile");
902 
903     f_begin = NewFile(outfile, "w", SWIG_output_files());
904     if (!f_begin) {
905       FileErrorDisplay(outfile);
906       SWIG_exit(EXIT_FAILURE);
907     }
908     f_runtime = NewString("");
909     f_init = NewString("");
910     f_header = NewString("");
911     f_wrappers = NewString("");
912 
913     m3makefile = NewString("");
914 
915     /* Register file targets with the SWIG file handler */
916     Swig_register_filebyname("header", f_header);
917     Swig_register_filebyname("wrapper", f_wrappers);
918     Swig_register_filebyname("begin", f_begin);
919     Swig_register_filebyname("runtime", f_runtime);
920     Swig_register_filebyname("init", f_init);
921 
922     Swig_register_filebyname("m3rawintf", m3raw_intf.f);
923     Swig_register_filebyname("m3rawimpl", m3raw_impl.f);
924     Swig_register_filebyname("m3wrapintf", m3wrap_intf.f);
925     Swig_register_filebyname("m3wrapimpl", m3wrap_impl.f);
926     Swig_register_filebyname("m3makefile", m3makefile);
927 
928     swig_types_hash = NewHash();
929 
930     String *name = Getattr(n, "name");
931     // Make the intermediary class and module class names. The intermediary class name can be set in the module directive.
932     Node *optionsnode = Getattr(Getattr(n, "module"), "options");
933     if (optionsnode != NIL) {
934       String *m3raw_name_tmp = Getattr(optionsnode, "m3rawname");
935       if (m3raw_name_tmp != NIL) {
936 	m3raw_name = Copy(m3raw_name_tmp);
937       }
938     }
939     if (m3raw_name == NIL) {
940       m3raw_name = NewStringf("%sRaw", name);
941     }
942     Setattr(m3wrap_impl.import, m3raw_name, "");
943 
944     m3wrap_name = Copy(name);
945 
946     proxy_class_def = NewString("");
947     proxy_class_code = NewString("");
948     m3raw_baseclass = NewString("");
949     m3raw_interfaces = NewString("");
950     m3raw_class_modifiers = NewString("");	// package access only to the intermediary class by default
951     m3raw_imports = NewString("");
952     m3raw_cppcasts_code = NewString("");
953     m3wrap_modifiers = NewString("public");
954     module_baseclass = NewString("");
955     module_interfaces = NewString("");
956     module_imports = NewString("");
957     upcasts_code = NewString("");
958 
959     Swig_banner(f_begin);
960 
961     Printf(f_runtime, "\n\n#ifndef SWIGMODULA3\n#define SWIGMODULA3\n#endif\n\n");
962 
963     Swig_name_register("wrapper", "Modula3_%f");
964     if (old_variable_names) {
965       Swig_name_register("set", "set_%n%v");
966       Swig_name_register("get", "get_%n%v");
967     }
968 
969     Printf(f_wrappers, "\n#ifdef __cplusplus\n");
970     Printf(f_wrappers, "extern \"C\" {\n");
971     Printf(f_wrappers, "#endif\n\n");
972 
973     constant_values = NewHash();
974     scanForConstPragmas(n);
975     enumeration_coll = NewHash();
976     collectEnumerations(enumeration_coll, n);
977 
978     /* Emit code */
979     Language::top(n);
980 
981     // Generate m3makefile
982     // This will be unnecessary if SWIG is invoked from Quake.
983     {
984       File *file = openWriteFile(NewStringf("%sm3makefile", SWIG_output_directory()));
985 
986       Printf(file, "%% automatically generated quake file for %s\n\n", name);
987 
988       /* Write the fragments written by '%insert'
989          collected while 'top' processed the parse tree */
990       Printv(file, m3makefile, NIL);
991 
992       Printf(file, "import(\"libm3\")\n");
993       //Printf(file, "import_lib(\"%s\",\"/usr/lib\")\n", name);
994       Printf(file, "module(\"%s\")\n", m3raw_name);
995       Printf(file, "module(\"%s\")\n\n", m3wrap_name);
996 
997       if (targetlibrary != NIL) {
998 	Printf(file, "library(\"%s\")\n", targetlibrary);
999       } else {
1000 	Printf(file, "library(\"m3%s\")\n", name);
1001       }
1002       Delete(file);
1003     }
1004 
1005     // Generate the raw interface
1006     {
1007       File *file = openWriteFile(NewStringf("%s%s.i3", SWIG_output_directory(), m3raw_name));
1008 
1009       emitBanner(file);
1010 
1011       Printf(file, "INTERFACE %s;\n\n", m3raw_name);
1012 
1013       emitImportStatements(m3raw_intf.import, file);
1014       Printf(file, "\n");
1015 
1016       // Write the interface generated within 'top'
1017       Printv(file, m3raw_intf.f, NIL);
1018 
1019       Printf(file, "\nEND %s.\n", m3raw_name);
1020       Delete(file);
1021     }
1022 
1023     // Generate the raw module
1024     {
1025       File *file = openWriteFile(NewStringf("%s%s.m3", SWIG_output_directory(), m3raw_name));
1026 
1027       emitBanner(file);
1028 
1029       Printf(file, "MODULE %s;\n\n", m3raw_name);
1030 
1031       emitImportStatements(m3raw_impl.import, file);
1032       Printf(file, "\n");
1033 
1034       // will be empty usually
1035       Printv(file, m3raw_impl.f, NIL);
1036 
1037       Printf(file, "BEGIN\nEND %s.\n", m3raw_name);
1038       Delete(file);
1039     }
1040 
1041     // Generate the interface for the comfort wrappers
1042     {
1043       File *file = openWriteFile(NewStringf("%s%s.i3", SWIG_output_directory(), m3wrap_name));
1044 
1045       emitBanner(file);
1046 
1047       Printf(file, "INTERFACE %s;\n", m3wrap_name);
1048 
1049       emitImportStatements(m3wrap_intf.import, file);
1050       Printf(file, "\n");
1051 
1052       {
1053 	Iterator it = First(enumeration_coll);
1054 	if (it.key != NIL) {
1055 	  Printf(file, "TYPE\n");
1056 	}
1057 	for (; it.key != NIL; it = Next(it)) {
1058 	  Printf(file, "\n");
1059 	  emitEnumeration(file, it.key, it.item);
1060 	}
1061       }
1062 
1063       // Add the wrapper methods
1064       Printv(file, m3wrap_intf.f, NIL);
1065 
1066       // Finish off the class
1067       Printf(file, "\nEND %s.\n", m3wrap_name);
1068       Delete(file);
1069     }
1070 
1071     // Generate the wrapper routines implemented in Modula 3
1072     {
1073       File *file = openWriteFile(NewStringf("%s%s.m3", SWIG_output_directory(), m3wrap_name));
1074 
1075       emitBanner(file);
1076 
1077       if (unsafe_module) {
1078 	Printf(file, "UNSAFE ");
1079       }
1080       Printf(file, "MODULE %s;\n\n", m3wrap_name);
1081 
1082       emitImportStatements(m3wrap_impl.import, file);
1083       Printf(file, "\n");
1084 
1085       // Add the wrapper methods
1086       Printv(file, m3wrap_impl.f, NIL);
1087 
1088       Printf(file, "\nBEGIN\nEND %s.\n", m3wrap_name);
1089       Delete(file);
1090     }
1091 
1092     if (upcasts_code)
1093       Printv(f_wrappers, upcasts_code, NIL);
1094 
1095     Printf(f_wrappers, "#ifdef __cplusplus\n");
1096     Printf(f_wrappers, "}\n");
1097     Printf(f_wrappers, "#endif\n");
1098 
1099     // Output a Modula 3 type wrapper class for each SWIG type
1100     for (Iterator swig_type = First(swig_types_hash); swig_type.item != NIL; swig_type = Next(swig_type)) {
1101       emitTypeWrapperClass(swig_type.key, swig_type.item);
1102     }
1103 
1104     Delete(swig_types_hash);
1105     swig_types_hash = NULL;
1106     Delete(constant_values);
1107     constant_values = NULL;
1108     Delete(enumeration_coll);
1109     enumeration_coll = NULL;
1110     Delete(m3raw_name);
1111     m3raw_name = NULL;
1112     Delete(m3raw_baseclass);
1113     m3raw_baseclass = NULL;
1114     Delete(m3raw_interfaces);
1115     m3raw_interfaces = NULL;
1116     Delete(m3raw_class_modifiers);
1117     m3raw_class_modifiers = NULL;
1118     Delete(m3raw_imports);
1119     m3raw_imports = NULL;
1120     Delete(m3raw_cppcasts_code);
1121     m3raw_cppcasts_code = NULL;
1122     Delete(proxy_class_def);
1123     proxy_class_def = NULL;
1124     Delete(proxy_class_code);
1125     proxy_class_code = NULL;
1126     Delete(m3wrap_name);
1127     m3wrap_name = NULL;
1128     Delete(m3wrap_modifiers);
1129     m3wrap_modifiers = NULL;
1130     Delete(targetlibrary);
1131     targetlibrary = NULL;
1132     Delete(module_baseclass);
1133     module_baseclass = NULL;
1134     Delete(module_interfaces);
1135     module_interfaces = NULL;
1136     Delete(module_imports);
1137     module_imports = NULL;
1138     Delete(upcasts_code);
1139     upcasts_code = NULL;
1140     Delete(constantfilename);
1141     constantfilename = NULL;
1142     Delete(renamefilename);
1143     renamefilename = NULL;
1144     Delete(typemapfilename);
1145     typemapfilename = NULL;
1146 
1147     /* Close all of the files */
1148     Dump(f_runtime, f_begin);
1149     Dump(f_header, f_begin);
1150     Dump(f_wrappers, f_begin);
1151     Wrapper_pretty_print(f_init, f_begin);
1152     Delete(f_header);
1153     Delete(f_wrappers);
1154     Delete(f_init);
1155     Delete(f_runtime);
1156     Delete(f_begin);
1157     return SWIG_OK;
1158   }
1159 
1160   /* -----------------------------------------------------------------------------
1161    * emitBanner()
1162    * ----------------------------------------------------------------------------- */
1163 
emitBanner(File * f)1164   void emitBanner(File *f) {
1165     Printf(f, "(*******************************************************************************\n");
1166     Swig_banner_target_lang(f, " *");
1167     Printf(f, "*******************************************************************************)\n\n");
1168   }
1169 
1170   /* ----------------------------------------------------------------------
1171    * nativeWrapper()
1172    * ---------------------------------------------------------------------- */
1173 
nativeWrapper(Node * n)1174   virtual int nativeWrapper(Node *n) {
1175     String *wrapname = Getattr(n, "wrap:name");
1176 
1177     if (!addSymbol(wrapname, n))
1178       return SWIG_ERROR;
1179 
1180     if (Getattr(n, "type")) {
1181       Swig_save("nativeWrapper", n, "name", NIL);
1182       Setattr(n, "name", wrapname);
1183       native_function_flag = true;
1184       functionWrapper(n);
1185       Swig_restore(n);
1186       native_function_flag = false;
1187     } else {
1188       Swig_error(input_file, line_number, "No return type for %%native method %s.\n", Getattr(n, "wrap:name"));
1189     }
1190 
1191     return SWIG_OK;
1192   }
1193 
1194   /* ----------------------------------------------------------------------
1195    * functionWrapper()
1196    * ---------------------------------------------------------------------- */
1197 
functionWrapper(Node * n)1198   virtual int functionWrapper(Node *n) {
1199     String *type = nodeType(n);
1200     String *funcType = Getattr(n, "modula3:functype");
1201     String *rawname = Getattr(n, "name");
1202     String *symname = Getattr(n, "sym:name");
1203     String *capname = capitalizeFirst(symname);
1204     //String *wname = Swig_name_wrapper(symname);
1205 
1206     //printf("function: %s\n", Char(symname));
1207     //printf(" purpose: %s\n", Char(funcType));
1208 
1209     if (Strcmp(type, "cdecl") == 0) {
1210       if (funcType == NIL) {
1211 	// no wrapper needed for plain functions
1212 	emitM3RawPrototype(n, rawname, symname);
1213 	emitM3Wrapper(n, symname);
1214       } else if (Strcmp(funcType, "method") == 0) {
1215 	Setattr(n, "modula3:funcname", capname);
1216 	emitCWrapper(n, capname);
1217 	emitM3RawPrototype(n, capname, capname);
1218 	emitM3Wrapper(n, capname);
1219       } else if (Strcmp(funcType, "accessor") == 0) {
1220 	/*
1221 	 * Generate the proxy class properties for public member variables.
1222 	 * Not for enums and constants.
1223 	 */
1224 	if (proxy_flag && wrapping_member_flag && !enum_constant_flag) {
1225 	  // Capitalize the first letter in the function name
1226 	  Setattr(n, "proxyfuncname", capname);
1227 	  Setattr(n, "imfuncname", symname);
1228 	  if (hasPrefix(capname, "Set")) {
1229 	    Setattr(n, "modula3:setname", capname);
1230 	  } else {
1231 	    Setattr(n, "modula3:getname", capname);
1232 	  }
1233 
1234 	  emitCWrapper(n, capname);
1235 	  emitM3RawPrototype(n, capname, capname);
1236 	  emitM3Wrapper(n, capname);
1237 	  //proxyClassFunctionHandler(n);
1238 	}
1239 #ifdef DEBUG
1240       } else {
1241 	Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Function type <%s> unknown.\n", Char(funcType));
1242 #endif
1243       }
1244     } else if ((Strcmp(type, "constructor") == 0) || (Strcmp(type, "destructor") == 0)) {
1245       emitCWrapper(n, capname);
1246       emitM3RawPrototype(n, capname, capname);
1247       emitM3Wrapper(n, capname);
1248     }
1249 // a Java relict
1250 #if 0
1251     if (!(proxy_flag && is_wrapping_class()) && !enum_constant_flag) {
1252       emitM3Wrapper(n, capname);
1253     }
1254 #endif
1255 
1256     Delete(capname);
1257 
1258     return SWIG_OK;
1259   }
1260 
1261   /* ----------------------------------------------------------------------
1262    * emitCWrapper()
1263    *
1264    * Generate the wrapper in C which calls C++ methods.
1265    * ---------------------------------------------------------------------- */
1266 
emitCWrapper(Node * n,const String * wname)1267   virtual int emitCWrapper(Node *n, const String *wname) {
1268     String *rawname = Getattr(n, "name");
1269     String *c_return_type = NewString("");
1270     String *cleanup = NewString("");
1271     String *outarg = NewString("");
1272     String *body = NewString("");
1273     Hash *throws_hash = NewHash();
1274     ParmList *l = Getattr(n, "parms");
1275     SwigType *t = Getattr(n, "type");
1276     String *symname = Getattr(n, "sym:name");
1277 
1278     if (!Getattr(n, "sym:overloaded")) {
1279       if (!addSymbol(wname, n)) {
1280 	return SWIG_ERROR;
1281       }
1282     }
1283     // A new wrapper function object
1284     Wrapper *f = NewWrapper();
1285 
1286     /* Attach the non-standard typemaps to the parameter list. */
1287     Swig_typemap_attach_parms("ctype", l, f);
1288 
1289     /* Get return types */
1290     {
1291       String *tm = getMappedTypeNew(n, "ctype", "");
1292       if (tm != NIL) {
1293 	Printf(c_return_type, "%s", tm);
1294       }
1295     }
1296 
1297     bool is_void_return = (Cmp(c_return_type, "void") == 0);
1298     if (!is_void_return) {
1299       Wrapper_add_localv(f, "cresult", c_return_type, "cresult = 0", NIL);
1300     }
1301 
1302     Printv(f->def, " SWIGEXPORT ", c_return_type, " ", wname, "(", NIL);
1303 
1304     // Emit all of the local variables for holding arguments.
1305     emit_parameter_variables(l, f);
1306 
1307     /* Attach the standard typemaps */
1308     emit_attach_parmmaps(l, f);
1309     Setattr(n, "wrap:parms", l);
1310 
1311     // Generate signature and argument conversion for C wrapper
1312     {
1313       Parm *p;
1314       attachParameterNames(n, "tmap:name", "c:wrapname", "m3arg%d");
1315       bool gencomma = false;
1316       for (p = skipIgnored(l, "in"); p; p = skipIgnored(p, "in")) {
1317 
1318 	String *arg = Getattr(p, "c:wrapname");
1319 	{
1320 	  /* Get the ctype types of the parameter */
1321 	  String *c_param_type = getMappedType(p, "ctype");
1322 	  // Add parameter to C function
1323 	  Printv(f->def, gencomma ? ", " : "", c_param_type, " ", arg, NIL);
1324 	  Delete(c_param_type);
1325 	  gencomma = true;
1326 	}
1327 
1328 	// Get typemap for this argument
1329 	String *tm = getMappedType(p, "in");
1330 	if (tm != NIL) {
1331 	  addThrows(throws_hash, "in", p);
1332 	  Replaceall(tm, "$input", arg);
1333 	  Setattr(p, "emit:input", arg);	/*??? */
1334 	  Printf(f->code, "%s\n", tm);
1335 	  p = Getattr(p, "tmap:in:next");
1336 	} else {
1337 	  p = nextSibling(p);
1338 	}
1339       }
1340     }
1341 
1342     /* Insert constraint checking code */
1343     {
1344       Parm *p;
1345       for (p = l; p;) {
1346 	String *tm = Getattr(p, "tmap:check");
1347 	if (tm != NIL) {
1348 	  addThrows(throws_hash, "check", p);
1349 	  Replaceall(tm, "$target", Getattr(p, "lname"));	/* deprecated */
1350 	  Replaceall(tm, "$arg", Getattr(p, "emit:input"));	/* deprecated? */
1351 	  Replaceall(tm, "$input", Getattr(p, "emit:input"));
1352 	  Printv(f->code, tm, "\n", NIL);
1353 	  p = Getattr(p, "tmap:check:next");
1354 	} else {
1355 	  p = nextSibling(p);
1356 	}
1357       }
1358     }
1359 
1360     /* Insert cleanup code */
1361     {
1362       Parm *p;
1363       for (p = l; p;) {
1364 	String *tm = Getattr(p, "tmap:freearg");
1365 	if (tm != NIL) {
1366 	  addThrows(throws_hash, "freearg", p);
1367 	  Replaceall(tm, "$source", Getattr(p, "emit:input"));	/* deprecated */
1368 	  Replaceall(tm, "$arg", Getattr(p, "emit:input"));	/* deprecated? */
1369 	  Replaceall(tm, "$input", Getattr(p, "emit:input"));
1370 	  Printv(cleanup, tm, "\n", NIL);
1371 	  p = Getattr(p, "tmap:freearg:next");
1372 	} else {
1373 	  p = nextSibling(p);
1374 	}
1375       }
1376     }
1377 
1378     /* Insert argument output code */
1379     {
1380       Parm *p;
1381       for (p = l; p;) {
1382 	String *tm = Getattr(p, "tmap:argout");
1383 	if (tm != NIL) {
1384 	  addThrows(throws_hash, "argout", p);
1385 	  Replaceall(tm, "$source", Getattr(p, "emit:input"));	/* deprecated */
1386 	  Replaceall(tm, "$target", Getattr(p, "lname"));	/* deprecated */
1387 	  Replaceall(tm, "$arg", Getattr(p, "emit:input"));	/* deprecated? */
1388 	  Replaceall(tm, "$result", "cresult");
1389 	  Replaceall(tm, "$input", Getattr(p, "emit:input"));
1390 	  Printv(outarg, tm, "\n", NIL);
1391 	  p = Getattr(p, "tmap:argout:next");
1392 	} else {
1393 	  p = nextSibling(p);
1394 	}
1395       }
1396     }
1397 
1398     // Get any Modula 3 exception classes in the throws typemap
1399     ParmList *throw_parm_list = NULL;
1400     if ((throw_parm_list = Getattr(n, "catchlist"))) {
1401       Swig_typemap_attach_parms("throws", throw_parm_list, f);
1402       Parm *p;
1403       for (p = throw_parm_list; p; p = nextSibling(p)) {
1404 	addThrows(throws_hash, "throws", p);
1405       }
1406     }
1407 
1408     Setattr(n, "wrap:name", wname);
1409 
1410     // Now write code to make the function call
1411     if (!native_function_flag) {
1412       String *actioncode = emit_action(n);
1413 
1414       /* Return value if necessary  */
1415       String *tm;
1416       if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
1417 	addThrows(throws_hash, "out", n);
1418 	Replaceall(tm, "$source", Swig_cresult_name());	/* deprecated */
1419 	Replaceall(tm, "$target", "cresult");	/* deprecated */
1420 	Replaceall(tm, "$result", "cresult");
1421 	Printf(f->code, "%s", tm);
1422 	if (hasContent(tm))
1423 	  Printf(f->code, "\n");
1424       } else {
1425 	Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, "Unable to use return type %s in function %s.\n", SwigType_str(t, 0), rawname);
1426       }
1427       emit_return_variable(n, t, f);
1428     }
1429 
1430     /* Output argument output code */
1431     Printv(f->code, outarg, NIL);
1432 
1433     /* Output cleanup code */
1434     Printv(f->code, cleanup, NIL);
1435 
1436     /* Look to see if there is any newfree cleanup code */
1437     if (GetFlag(n, "feature:new")) {
1438       String *tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0);
1439       if (tm != NIL) {
1440 	addThrows(throws_hash, "newfree", n);
1441 	Replaceall(tm, "$source", Swig_cresult_name());	/* deprecated */
1442 	Printf(f->code, "%s\n", tm);
1443       }
1444     }
1445 
1446     /* See if there is any return cleanup code */
1447     if (!native_function_flag) {
1448       String *tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0);
1449       if (tm != NIL) {
1450 	Replaceall(tm, "$source", Swig_cresult_name());	/* deprecated */
1451 	Printf(f->code, "%s\n", tm);
1452       }
1453     }
1454 
1455     /* Finish C wrapper */
1456     Printf(f->def, ") {");
1457 
1458     if (!is_void_return)
1459       Printv(f->code, "    return cresult;\n", NIL);
1460     Printf(f->code, "}\n");
1461 
1462     /* Substitute the cleanup code */
1463     Replaceall(f->code, "$cleanup", cleanup);
1464 
1465     /* Substitute the function name */
1466     Replaceall(f->code, "$symname", symname);
1467 
1468     if (!is_void_return) {
1469       Replaceall(f->code, "$null", "0");
1470     } else {
1471       Replaceall(f->code, "$null", "");
1472     }
1473 
1474     /* Dump the function out */
1475     if (!native_function_flag) {
1476       Wrapper_print(f, f_wrappers);
1477     }
1478 
1479     Delete(c_return_type);
1480     Delete(cleanup);
1481     Delete(outarg);
1482     Delete(body);
1483     Delete(throws_hash);
1484     DelWrapper(f);
1485     return SWIG_OK;
1486   }
1487 
1488   /* ----------------------------------------------------------------------
1489    * emitM3RawPrototype()
1490    *
1491    * Generate an EXTERNAL procedure declaration in Modula 3
1492    * which is the interface to an existing C routine or a C wrapper.
1493    * ---------------------------------------------------------------------- */
1494 
emitM3RawPrototype(Node * n,const String * cname,const String * m3name)1495   virtual int emitM3RawPrototype(Node *n, const String *cname, const String *m3name) {
1496     String *im_return_type = NewString("");
1497     //String   *symname = Getattr(n,"sym:name");
1498     ParmList *l = Getattr(n, "parms");
1499 
1500     /* Attach the non-standard typemaps to the parameter list. */
1501     Swig_typemap_attach_parms("m3rawinmode", l, NULL);
1502     Swig_typemap_attach_parms("m3rawintype", l, NULL);
1503 
1504     /* Get return types */
1505     bool has_return;
1506     {
1507       String *tm = getMappedTypeNew(n, "m3rawrettype", "");
1508       if (tm != NIL) {
1509 	Printf(im_return_type, "%s", tm);
1510       }
1511       has_return = hasContent(tm);
1512     }
1513 
1514     /* cname is the original name if 'n' denotes a C function
1515        and it is the relabeled name (sym:name) if 'n' denotes a C++ method or similar */
1516     m3raw_intf.enterBlock(no_block);
1517     Printf(m3raw_intf.f, "\n<* EXTERNAL %s *>\nPROCEDURE %s (", cname, m3name);
1518 
1519     // Generate signature for raw interface
1520     {
1521       Parm *p;
1522       writeArgState state;
1523       attachParameterNames(n, "tmap:rawinname", "modula3:rawname", "arg%d");
1524       for (p = skipIgnored(l, "m3rawintype"); p; p = skipIgnored(p, "m3rawintype")) {
1525 
1526 	/* Get argument passing mode, should be one of VALUE, VAR, READONLY */
1527 	String *mode = Getattr(p, "tmap:m3rawinmode");
1528 	String *argname = Getattr(p, "modula3:rawname");
1529 	String *im_param_type = getMappedType(p, "m3rawintype");
1530 	addImports(m3raw_intf.import, "m3rawintype", p);
1531 
1532 	writeArg(m3raw_intf.f, state, mode, argname, im_param_type, NIL);
1533 	if (im_param_type != NIL) {
1534 	  p = Getattr(p, "tmap:m3rawintype:next");
1535 	} else {
1536 	  p = nextSibling(p);
1537 	}
1538       }
1539       writeArg(m3raw_intf.f, state, NIL, NIL, NIL, NIL);
1540     }
1541 
1542     /* Finish M3 raw prototype */
1543     Printf(m3raw_intf.f, ")");
1544     // neither a C wrapper nor a plain C function may throw an exception
1545     //generateThrowsClause(throws_hash, m3raw_intf.f);
1546     if (has_return) {
1547       Printf(m3raw_intf.f, ": %s", im_return_type);
1548     }
1549     Printf(m3raw_intf.f, ";\n");
1550 
1551     Delete(im_return_type);
1552     return SWIG_OK;
1553   }
1554 
1555   /* -----------------------------------------------------------------------
1556    * variableWrapper()
1557    * ----------------------------------------------------------------------- */
1558 
variableWrapper(Node * n)1559   virtual int variableWrapper(Node *n) {
1560     Language::variableWrapper(n);
1561     return SWIG_OK;
1562   }
1563 
1564   /* -----------------------------------------------------------------------
1565    * globalvariableHandler()
1566    * ----------------------------------------------------------------------- */
1567 
globalvariableHandler(Node * n)1568   virtual int globalvariableHandler(Node *n) {
1569     SwigType *t = Getattr(n, "type");
1570     String *tm;
1571 
1572     // Get the variable type
1573     if ((tm = getMappedTypeNew(n, "m3wraptype", ""))) {
1574       substituteClassname(t, tm);
1575     }
1576 
1577     variable_name = Getattr(n, "sym:name");
1578     variable_type = Copy(tm);
1579 
1580     // Get the variable type expressed in terms of Modula 3 equivalents of C types
1581     if ((tm = getMappedTypeNew(n, "m3rawtype", ""))) {
1582       m3raw_intf.enterBlock(no_block);
1583       Printf(m3raw_intf.f, "\n<* EXTERNAL *> VAR %s: %s;\n", variable_name, tm);
1584     }
1585     // Output the property's accessor methods
1586     /*
1587        global_variable_flag = true;
1588        int ret = Language::globalvariableHandler(n);
1589        global_variable_flag = false;
1590      */
1591 
1592     Printf(m3wrap_impl.f, "\n\n");
1593 
1594     //return ret;
1595     return 1;
1596   }
1597 
getConstNumeric(Node * n)1598   long getConstNumeric(Node *n) {
1599     String *constnumeric = Getfeature(n, "constnumeric");
1600     String *name = Getattr(n, "name");
1601     long numvalue;
1602     if (constnumeric == NIL) {
1603       Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Feature 'constnumeric' is necessary to obtain value of %s.\n", name);
1604       return 0;
1605     } else if (!strToL(constnumeric, numvalue)) {
1606       Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number,
1607 		   "The feature 'constnumeric' of %s specifies value <%s> which is not an integer constant.\n", name, constnumeric);
1608       return 0;
1609     } else {
1610       return numvalue;
1611     }
1612   }
1613 
1614   /* ------------------------------------------------------------------------
1615    * generateIntConstant()
1616    *
1617    * Considers node as an integer constant definition
1618    * and generate a Modula 3 constant definition.
1619    * ------------------------------------------------------------------------ */
generateIntConstant(Node * n,String * name)1620   void generateIntConstant(Node *n, String *name) {
1621     String *value = Getattr(n, "value");
1622     String *type = Getfeature(n, "modula3:constint:type");
1623     String *conv = Getfeature(n, "modula3:constint:conv");
1624 
1625     if (name == NIL) {
1626       name = Getattr(n, "sym:name");
1627     }
1628 
1629     long numvalue;
1630     bool isSimpleNum = strToL(value, numvalue);
1631     if (!isSimpleNum) {
1632       numvalue = getConstNumeric(n);
1633     }
1634 
1635     String *m3value;
1636     if ((conv == NIL) || ((Strcmp(conv, "set:int") != 0) && (Strcmp(conv, "int:set") != 0))) {
1637       /* The original value of the constant has precedence over
1638          'constnumeric' feature since we like to keep
1639          the style (that is the base) of simple numeric constants */
1640       if (isSimpleNum) {
1641 	if (hasPrefix(value, "0x")) {
1642 	  m3value = NewStringf("16_%s", Char(value) + 2);
1643 	} else if ((Len(value) > 1) && (*Char(value) == '0')) {
1644 	  m3value = NewStringf("8_%s", Char(value) + 1);
1645 	} else {
1646 	  m3value = Copy(value);
1647 	}
1648 	/* If we cannot easily obtain the value of a numeric constant,
1649 	   we use the results given by a C compiler. */
1650       } else {
1651 	m3value = Copy(Getfeature(n, "constnumeric"));
1652       }
1653     } else {
1654       // if the value can't be converted, it is ignored
1655       if (convertInt(numvalue, numvalue, conv)) {
1656 	m3value = NewStringf("%d", numvalue);
1657       } else {
1658 	m3value = NIL;
1659       }
1660     }
1661 
1662     if (m3value != NIL) {
1663       m3wrap_intf.enterBlock(constant);
1664       Printf(m3wrap_intf.f, "%s", name);
1665       if (hasContent(type)) {
1666 	Printf(m3wrap_intf.f, ": %s", type);
1667       }
1668       Printf(m3wrap_intf.f, " = %s;\n", m3value);
1669       Delete(m3value);
1670     }
1671   }
1672 
1673   /* -----------------------------------------------------------------------
1674    * generateSetConstant()
1675    *
1676    * Considers node as a set constant definition
1677    * and generate a Modula 3 constant definition.
1678    * ------------------------------------------------------------------------ */
generateSetConstant(Node * n,String * name)1679   void generateSetConstant(Node *n, String *name) {
1680     String *value = Getattr(n, "value");
1681     String *type = Getfeature(n, "modula3:constset:type");
1682     String *setname = Getfeature(n, "modula3:constset:set");
1683     String *basename = Getfeature(n, "modula3:constset:base");
1684     String *conv = Getfeature(n, "modula3:constset:conv");
1685 
1686     m3wrap_intf.enterBlock(constant);
1687 
1688     Printf(m3wrap_intf.f, "%s", name);
1689     if (type != NIL) {
1690       Printf(m3wrap_intf.f, ":%s ", type);
1691     }
1692     Printf(m3wrap_intf.f, " = %s{", setname);
1693 
1694     long numvalue = 0;
1695     if (!strToL(value, numvalue)) {
1696       numvalue = getConstNumeric(n);
1697     }
1698     convertInt(numvalue, numvalue, conv);
1699 
1700     bool isIntType = Strcmp(basename, "CARDINAL") == 0;
1701     Hash *items = NIL;
1702     if (!isIntType) {
1703       Hash *enumeration = Getattr(enumeration_coll, basename);
1704       if (enumeration == NIL) {
1705 	Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "There is no enumeration <%s> as needed for the set.\n", setname);
1706 	isIntType = true;
1707       } else {
1708 	items = Getattr(enumeration, "items");
1709       }
1710     }
1711 
1712     bool gencomma = false;
1713     int bitpos = 0;
1714     while (numvalue > 0) {
1715       if ((numvalue & 1) != 0) {
1716 	if (isIntType) {
1717 	  if (gencomma) {
1718 	    Printv(m3wrap_intf.f, ",", NIL);
1719 	  }
1720 	  gencomma = true;
1721 	  Printf(m3wrap_intf.f, "%d", bitpos);
1722 	} else {
1723 	  char bitval[15];
1724 	  sprintf(bitval, "%d", bitpos);
1725 	  String *bitname = Getattr(items, bitval);
1726 	  if (bitname == NIL) {
1727 	    Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Enumeration <%s> has no value <%s>.\n", setname, bitval);
1728 	  } else {
1729 	    if (gencomma) {
1730 	      Printv(m3wrap_intf.f, ",", NIL);
1731 	    }
1732 	    gencomma = true;
1733 	    Printf(m3wrap_intf.f, "%s.%s", basename, bitname);
1734 	  }
1735 	}
1736       }
1737       numvalue >>= 1;
1738       bitpos++;
1739     }
1740     Printf(m3wrap_intf.f, "};\n");
1741   }
1742 
generateConstant(Node * n)1743   void generateConstant(Node *n) {
1744     // any of the special interpretation disables the default behaviour
1745     String *enumitem = Getfeature(n, "modula3:enumitem:name");
1746     String *constset = Getfeature(n, "modula3:constset:name");
1747     String *constint = Getfeature(n, "modula3:constint:name");
1748     if (hasContent(enumitem) || hasContent(constset) || hasContent(constint)) {
1749       if (hasContent(constset)) {
1750 	generateSetConstant(n, constset);
1751       }
1752       if (hasContent(constint)) {
1753 	generateIntConstant(n, constint);
1754       }
1755     } else {
1756       String *value = Getattr(n, "value");
1757       String *name = Getattr(n, "sym:name");
1758       if (name == NIL) {
1759 	name = Getattr(n, "name");
1760       }
1761       m3wrap_intf.enterBlock(constant);
1762       Printf(m3wrap_intf.f, "%s = %s;\n", name, value);
1763     }
1764   }
1765 
emitEnumeration(File * file,String * name,Node * n)1766   void emitEnumeration(File *file, String *name, Node *n) {
1767     Printf(file, "%s = {", name);
1768     int i;
1769     bool gencomma = false;
1770     int max = aToL(Getattr(n, "max"));
1771     Hash *items = Getattr(n, "items");
1772     for (i = 0; i <= max; i++) {
1773       if (gencomma) {
1774 	Printf(file, ",");
1775       }
1776       Printf(file, "\n");
1777       gencomma = true;
1778       char numstr[15];
1779       sprintf(numstr, "%d", i);
1780       String *name = Getattr(items, numstr);
1781       if (name != NIL) {
1782 	Printv(file, name, NIL);
1783       } else {
1784 	Printf(file, "Dummy%d", i);
1785       }
1786     }
1787     Printf(file, "\n};\n");
1788   }
1789 
1790   /* -----------------------------------------------------------------------
1791    * constantWrapper()
1792    *
1793    * Handles constants and enumeration items.
1794    * ------------------------------------------------------------------------ */
1795 
constantWrapper(Node * n)1796   virtual int constantWrapper(Node *n) {
1797     generateConstant(n);
1798     return SWIG_OK;
1799   }
1800 
1801 #if 0
1802 // enumerations are handled like constant definitions
1803   /* -----------------------------------------------------------------------------
1804    * enumDeclaration()
1805    * ----------------------------------------------------------------------------- */
1806 
1807   virtual int enumDeclaration(Node *n) {
1808     String *symname = nameToModula3(Getattr(n, "sym:name"), true);
1809     enumerationStart(symname);
1810     int result = Language::enumDeclaration(n);
1811     enumerationStop();
1812     Delete(symname);
1813     return result;
1814   }
1815 #endif
1816 
1817   /* -----------------------------------------------------------------------------
1818    * enumvalueDeclaration()
1819    * ----------------------------------------------------------------------------- */
1820 
enumvalueDeclaration(Node * n)1821   virtual int enumvalueDeclaration(Node *n) {
1822     generateConstant(n);
1823     /*
1824        This call would continue processing in the constantWrapper
1825        which cannot handle values like "RED+1".
1826        return Language::enumvalueDeclaration(n);
1827      */
1828     return SWIG_OK;
1829   }
1830 
1831   /* -----------------------------------------------------------------------------
1832    * pragmaDirective()
1833    *
1834    * Valid Pragmas:
1835    * imclassbase            - base (extends) for the intermediary class
1836    * imclassclassmodifiers  - class modifiers for the intermediary class
1837    * imclasscode            - text (Modula 3 code) is copied verbatim to the intermediary class
1838    * imclassimports         - import statements for the intermediary class
1839    * imclassinterfaces      - interface (implements) for the intermediary class
1840    *
1841    * modulebase              - base (extends) for the module class
1842    * moduleclassmodifiers    - class modifiers for the module class
1843    * modulecode              - text (Modula 3 code) is copied verbatim to the module class
1844    * moduleimports           - import statements for the module class
1845    * moduleinterfaces        - interface (implements) for the module class
1846    *
1847    * ----------------------------------------------------------------------------- */
1848 
pragmaDirective(Node * n)1849   virtual int pragmaDirective(Node *n) {
1850     if (!ImportMode) {
1851       String *lang = Getattr(n, "lang");
1852       String *code = Getattr(n, "name");
1853       String *value = Getattr(n, "value");
1854 
1855       if (Strcmp(lang, "modula3") == 0) {
1856 
1857 	String *strvalue = NewString(value);
1858 	Replaceall(strvalue, "\\\"", "\"");
1859 /*
1860         bool isEnumItem = Strcmp(code, "enumitem") == 0;
1861         bool isSetItem  = Strcmp(code, "setitem")  == 0;
1862 */
1863 	if (Strcmp(code, "imclassbase") == 0) {
1864 	  Delete(m3raw_baseclass);
1865 	  m3raw_baseclass = Copy(strvalue);
1866 	} else if (Strcmp(code, "imclassclassmodifiers") == 0) {
1867 	  Delete(m3raw_class_modifiers);
1868 	  m3raw_class_modifiers = Copy(strvalue);
1869 	} else if (Strcmp(code, "imclasscode") == 0) {
1870 	  Printf(m3raw_intf.f, "%s\n", strvalue);
1871 	} else if (Strcmp(code, "imclassimports") == 0) {
1872 	  Delete(m3raw_imports);
1873 	  m3raw_imports = Copy(strvalue);
1874 	} else if (Strcmp(code, "imclassinterfaces") == 0) {
1875 	  Delete(m3raw_interfaces);
1876 	  m3raw_interfaces = Copy(strvalue);
1877 	} else if (Strcmp(code, "modulebase") == 0) {
1878 	  Delete(module_baseclass);
1879 	  module_baseclass = Copy(strvalue);
1880 	} else if (Strcmp(code, "moduleclassmodifiers") == 0) {
1881 	  Delete(m3wrap_modifiers);
1882 	  m3wrap_modifiers = Copy(strvalue);
1883 	} else if (Strcmp(code, "modulecode") == 0) {
1884 	  Printf(m3wrap_impl.f, "%s\n", strvalue);
1885 	} else if (Strcmp(code, "moduleimports") == 0) {
1886 	  Delete(module_imports);
1887 	  module_imports = Copy(strvalue);
1888 	} else if (Strcmp(code, "moduleinterfaces") == 0) {
1889 	  Delete(module_interfaces);
1890 	  module_interfaces = Copy(strvalue);
1891 	} else if (Strcmp(code, "unsafe") == 0) {
1892 	  unsafe_module = true;
1893 	} else if (Strcmp(code, "library") == 0) {
1894 	  if (targetlibrary) {
1895 	    Delete(targetlibrary);
1896 	  }
1897 	  targetlibrary = Copy(strvalue);
1898 	} else if (Strcmp(code, "enumitem") == 0) {
1899 	} else if (Strcmp(code, "constset") == 0) {
1900 	} else if (Strcmp(code, "constint") == 0) {
1901 	} else if (Strcmp(code, "makesetofenum") == 0) {
1902 	  m3wrap_intf.enterBlock(blocktype);
1903 	  Printf(m3wrap_intf.f, "%sSet = SET OF %s;\n", value, value);
1904 	} else {
1905 	  Swig_warning(WARN_MODULA3_UNKNOWN_PRAGMA, input_file, line_number, "Unrecognized pragma <%s>.\n", code);
1906 	}
1907 	Delete(strvalue);
1908       }
1909     }
1910     return Language::pragmaDirective(n);
1911   }
1912 
Setfeature(Node * n,const char * feature,const String * value,bool warn=false)1913   void Setfeature(Node *n, const char *feature, const String *value, bool warn = false) {
1914     //printf("tag feature <%s> with value <%s>\n", feature, Char(value));
1915     String *attr = NewStringf("feature:%s", feature);
1916     if ((Setattr(n, attr, value) != 0) && warn) {
1917       Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Feature <%s> of %s did already exist.\n", feature, Getattr(n, "name"));
1918     }
1919     Delete(attr);
1920   }
1921 
Getfeature(Node * n,const char * feature)1922   String *Getfeature(Node *n, const char *feature) {
1923     //printf("retrieve feature <%s> with value <%s>\n", feature, Char(value));
1924     String *attr = NewStringf("feature:%s", feature);
1925     String *result = Getattr(n, attr);
1926     Delete(attr);
1927     return result;
1928   }
1929 
convertInt(long in,long & out,const String * mode)1930   bool convertInt(long in, long &out, const String *mode) {
1931     if ((mode == NIL) || (Strcmp(mode, "int:int") == 0) || (Strcmp(mode, "set:set") == 0)) {
1932       out = in;
1933       return true;
1934     } else if (Strcmp(mode, "set:int") == 0) {
1935       return log2(in, out);
1936     } else if (Strcmp(mode, "int:set") == 0) {
1937       out = 1L << in;
1938       return unsigned (in) < (sizeof(out) * 8);
1939     } else {
1940       Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Unknown integer conversion method <%s>.\n", mode);
1941       return false;
1942     }
1943   }
1944 
collectEnumerations(Hash * enums,Node * n)1945   void collectEnumerations(Hash *enums, Node *n) {
1946     Node *child = firstChild(n);
1947     while (child != NIL) {
1948       String *name = Getattr(child, "name");
1949       const bool isConstant = Strcmp(nodeType(child), "constant") == 0;
1950       const bool isEnumItem = Strcmp(nodeType(child), "enumitem") == 0;
1951       if (isConstant || isEnumItem) {
1952 //printf("%s%s name %s\n", isConstant?"constant":"", isEnumItem?"enumitem":"", Char(name));
1953 	{
1954 	  String *m3name = Getfeature(child, "modula3:enumitem:name");
1955 	  String *m3enum = Getfeature(child, "modula3:enumitem:enum");
1956 	  String *conv = Getfeature(child, "modula3:enumitem:conv");
1957 
1958 	  if (m3enum != NIL) {
1959 //printf("m3enum %s\n", Char(m3enum));
1960 	    if (m3name == NIL) {
1961 	      m3name = name;
1962 	    }
1963 
1964 	    long max = -1;
1965 	    Hash *items;
1966 	    Hash *enumnode = Getattr(enums, m3enum);
1967 	    if (enumnode == NIL) {
1968 	      enumnode = NewHash();
1969 	      items = NewHash();
1970 	      Setattr(enumnode, "items", items);
1971 	      Setattr(enums, m3enum, enumnode);
1972 	    } else {
1973 	      String *maxstr = Getattr(enumnode, "max");
1974 	      if (maxstr != NIL) {
1975 		max = aToL(maxstr);
1976 	      }
1977 	      items = Getattr(enumnode, "items");
1978 	    }
1979 	    long numvalue;
1980 	    String *value = Getattr(child, "value");
1981 //printf("value: %s\n", Char(value));
1982 	    if ((value == NIL) || (!strToL(value, numvalue))) {
1983 	      value = Getattr(child, "enumvalue");
1984 	      if ((value == NIL) || (!evalExpr(value, numvalue))) {
1985 		numvalue = getConstNumeric(child);
1986 	      }
1987 //printf("constnumeric: %s\n", Char(value));
1988 	    }
1989 	    Setattr(constant_values, name, NewStringf("%d", numvalue));
1990 	    if (convertInt(numvalue, numvalue, conv)) {
1991 	      String *newvalue = NewStringf("%d", numvalue);
1992 	      String *oldname = Getattr(items, newvalue);
1993 	      if (oldname != NIL) {
1994 		Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "The value <%s> is already assigned to <%s>.\n", value, oldname);
1995 	      }
1996 //printf("items %p, set %s = %s\n", items, Char(newvalue), Char(m3name));
1997 	      Setattr(items, newvalue, m3name);
1998 	      if (max < numvalue) {
1999 		max = numvalue;
2000 	      }
2001 	      Setattr(enumnode, "max", NewStringf("%d", max));
2002 	    }
2003 	  }
2004 	}
2005       }
2006 
2007       collectEnumerations(enums, child);
2008       child = nextSibling(child);
2009     }
2010   }
2011 
2012   enum const_pragma_type { cpt_none, cpt_constint, cpt_constset, cpt_enumitem };
2013 
2014   struct const_id_pattern {
2015     String *prefix, *parentEnum;
2016   };
2017 
tagConstants(Node * first,String * parentEnum,const const_id_pattern & pat,const String * pragma,List * convdesc)2018   void tagConstants(Node *first, String *parentEnum, const const_id_pattern & pat, const String *pragma, List *convdesc) {
2019     Node *n = first;
2020     while (n != NIL) {
2021       String *name = getQualifiedName(n);
2022       bool isConstant = Strcmp(nodeType(n), "constant") == 0;
2023       bool isEnumItem = Strcmp(nodeType(n), "enumitem") == 0;
2024       if ((isConstant || isEnumItem) && ((pat.prefix == NIL) || (hasPrefix(name, pat.prefix))) && ((pat.parentEnum == NIL) || ((parentEnum != NIL)
2025 															       &&
2026 															       (Strcmp
2027 																(pat.parentEnum, parentEnum)
2028 																== 0)))) {
2029 	//printf("tag %s\n", Char(name));
2030 	String *srctype = Getitem(convdesc, 1);
2031 	String *relationstr = Getitem(convdesc, 3);
2032 	List *relationdesc = Split(relationstr, ',', 2);
2033 
2034 	// transform name from C to Modula3 style
2035 	String *srcstyle = NIL;
2036 	String *newprefix = NIL;
2037 	{
2038 	  //printf("name conversion <%s>\n", Char(Getitem(convdesc,2)));
2039 	  List *namedesc = Split(Getitem(convdesc, 2), ',', INT_MAX);
2040 	  Iterator nameit = First(namedesc);
2041 	  for (; nameit.item != NIL; nameit = Next(nameit)) {
2042 	    List *nameassign = Split(nameit.item, '=', 2);
2043 	    String *tag = Getitem(nameassign, 0);
2044 	    String *data = Getitem(nameassign, 1);
2045 	    //printf("name conv <%s> = <%s>\n", Char(tag), Char(data));
2046 	    if (Strcmp(tag, "srcstyle") == 0) {
2047 	      srcstyle = Copy(data);
2048 	    } else if (Strcmp(tag, "prefix") == 0) {
2049 	      newprefix = Copy(data);
2050 	    } else {
2051 	      Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Unknown name conversion tag <%s> with value <%s>.\n", tag, data);
2052 	    }
2053 	    Delete(nameassign);
2054 	  }
2055 	  Delete(namedesc);
2056 	}
2057 	const char *stem = Char(name);
2058 	if (pat.prefix != NIL) {
2059 	  //printf("pat.prefix %s for %s\n", Char(pat.prefix), Char(name));
2060 	  stem += Len(pat.prefix);
2061 	}
2062 	String *newname;
2063 	if (srcstyle && Strcmp(srcstyle, "underscore") == 0) {
2064 	  if (newprefix != NIL) {
2065 	    String *newstem = nameToModula3(stem, true);
2066 	    newname = NewStringf("%s%s", newprefix, newstem);
2067 	    Delete(newstem);
2068 	  } else {
2069 	    newname = nameToModula3(stem, true);
2070 	  }
2071 	} else {
2072 	  if (srcstyle != NIL) {
2073 	    Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Unknown C identifier style <%s>.\n", srcstyle);
2074 	  }
2075 	  newname = Copy(name);
2076 	}
2077 
2078 	if (Strcmp(pragma, "enumitem") == 0) {
2079 	  if (Len(relationdesc) != 1) {
2080 	    Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Expected <enumeration>, got <%s>.\n", relationstr);
2081 	  }
2082 	  Setfeature(n, "modula3:enumitem:name", newname, true);
2083 	  Setfeature(n, "modula3:enumitem:enum", relationstr, true);
2084 	  Setfeature(n, "modula3:enumitem:conv", NewStringf("%s:int", srctype), true);
2085 	} else if (Strcmp(pragma, "constint") == 0) {
2086 	  if (Len(relationdesc) != 1) {
2087 	    Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Expected <ordinal type>, got <%s>.\n", relationstr);
2088 	  }
2089 	  Setfeature(n, "modula3:constint:name", newname, true);
2090 	  Setfeature(n, "modula3:constint:type", Getitem(relationdesc, 0), true);
2091 	  Setfeature(n, "modula3:constint:conv", NewStringf("%s:int", srctype), true);
2092 	} else if (Strcmp(pragma, "constset") == 0) {
2093 	  if (Len(relationdesc) != 2) {
2094 	    Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Expected <set type,base type>, got <%s>.\n", relationstr);
2095 	  }
2096 	  String *settype = Getitem(relationdesc, 0);
2097 	  Setfeature(n, "modula3:constset:name", newname, true);
2098 	  //Setfeature(n,"modula3:constset:type",settype,true);
2099 	  Setfeature(n, "modula3:constset:set", settype, true);
2100 	  Setfeature(n, "modula3:constset:base", Getitem(relationdesc, 1), true);
2101 	  Setfeature(n, "modula3:constset:conv", NewStringf("%s:set", srctype), true);
2102 	}
2103 
2104 	Delete(newname);
2105 	Delete(relationdesc);
2106       }
2107 
2108       if (Strcmp(nodeType(n), "enum") == 0) {
2109 	//printf("explore enum %s, qualification %s\n", Char(name), Char(Swig_symbol_qualified(n)));
2110 	tagConstants(firstChild(n), name, pat, pragma, convdesc);
2111       } else {
2112 	tagConstants(firstChild(n), NIL, pat, pragma, convdesc);
2113       }
2114       n = nextSibling(n);
2115     }
2116   }
2117 
scanForConstPragmas(Node * n)2118   void scanForConstPragmas(Node *n) {
2119     Node *child = firstChild(n);
2120     while (child != NIL) {
2121       const String *type = nodeType(child);
2122       if (Strcmp(type, "pragma") == 0) {
2123 	const String *lang = Getattr(child, "lang");
2124 	const String *code = Getattr(child, "name");
2125 	String *value = Getattr(child, "value");
2126 
2127 	if (Strcmp(lang, "modula3") == 0) {
2128 	  const_pragma_type cpt = cpt_none;
2129 	  if (Strcmp(code, "constint") == 0) {
2130 	    cpt = cpt_constint;
2131 	  } else if (Strcmp(code, "constset") == 0) {
2132 	    cpt = cpt_constset;
2133 	  } else if (Strcmp(code, "enumitem") == 0) {
2134 	    cpt = cpt_enumitem;
2135 	  }
2136 	  if (cpt != cpt_none) {
2137 	    const_id_pattern pat = { NIL, NIL };
2138 
2139 	    List *convdesc = Split(value, ';', 4);
2140 	    List *patterndesc = Split(Getitem(convdesc, 0), ',', INT_MAX);
2141 	    Iterator patternit;
2142 	    for (patternit = First(patterndesc); patternit.item != NIL; patternit = Next(patternit)) {
2143 	      List *patternassign = Split(patternit.item, '=', 2);
2144 	      String *tag = Getitem(patternassign, 0);
2145 	      String *data = Getitem(patternassign, 1);
2146 	      if (Strcmp(tag, "prefix") == 0) {
2147 		pat.prefix = Copy(data);
2148 	      } else if (Strcmp(tag, "enum") == 0) {
2149 		pat.parentEnum = Copy(data);
2150 	      } else {
2151 		Swig_warning(WARN_MODULA3_BAD_ENUMERATION, input_file, line_number, "Unknown identification tag <%s> with value <%s>.\n", tag, data);
2152 	      }
2153 	      Delete(patternassign);
2154 	    }
2155 	    tagConstants(child, NIL, pat, code, convdesc);
2156 
2157 	    Delete(patterndesc);
2158 	  }
2159 	}
2160       }
2161       scanForConstPragmas(child);
2162       child = nextSibling(child);
2163     }
2164   }
2165 
2166   /* -----------------------------------------------------------------------------
2167    * emitProxyClassDefAndCPPCasts()
2168    * ----------------------------------------------------------------------------- */
2169 
emitProxyClassDefAndCPPCasts(Node * n)2170   void emitProxyClassDefAndCPPCasts(Node *n) {
2171     String *c_classname = SwigType_namestr(Getattr(n, "name"));
2172     String *c_baseclass = NULL;
2173     String *baseclass = NULL;
2174     String *c_baseclassname = NULL;
2175     String *name = Getattr(n, "name");
2176 
2177     /* Deal with inheritance */
2178     List *baselist = Getattr(n, "bases");
2179     if (baselist) {
2180       Iterator base = First(baselist);
2181       while (base.item) {
2182 	if (!GetFlag(base.item, "feature:ignore")) {
2183 	  String *baseclassname = Getattr(base.item, "name");
2184 	  if (!c_baseclassname) {
2185 	    c_baseclassname = baseclassname;
2186 	    baseclass = Copy(getProxyName(baseclassname));
2187 	    if (baseclass)
2188 	      c_baseclass = SwigType_namestr(baseclassname);
2189 	  } else {
2190 	    /* Warn about multiple inheritance for additional base class(es) */
2191 	    String *proxyclassname = Getattr(n, "classtypeobj");
2192 	    Swig_warning(WARN_MODULA3_MULTIPLE_INHERITANCE, Getfile(n), Getline(n),
2193 		"Warning for %s, base %s ignored. Multiple inheritance is not supported in Modula 3.\n", SwigType_namestr(proxyclassname), SwigType_namestr(baseclassname));
2194 	  }
2195 	}
2196 	base = Next(base);
2197       }
2198     }
2199 
2200     bool derived = baseclass && getProxyName(c_baseclassname);
2201     if (!baseclass)
2202       baseclass = NewString("");
2203 
2204     // Inheritance from pure Modula 3 classes
2205     const String *pure_baseclass = typemapLookup(n, "m3base", name, WARN_NONE);
2206     if (hasContent(pure_baseclass) && hasContent(baseclass)) {
2207       Swig_warning(WARN_MODULA3_MULTIPLE_INHERITANCE, Getfile(n), Getline(n),
2208 		   "Warning for %s, base %s ignored. Multiple inheritance is not supported in Modula 3.\n", name, pure_baseclass);
2209     }
2210     // Pure Modula 3 interfaces
2211     const String *pure_interfaces = typemapLookup(n, derived ? "m3interfaces_derived" : "m3interfaces",
2212 						  name, WARN_NONE);
2213 
2214     // Start writing the proxy class
2215     Printv(proxy_class_def, typemapLookup(n, "m3imports", name, WARN_NONE),	// Import statements
2216 	   "\n", typemapLookup(n, "m3classmodifiers", name, WARN_MODULA3_TYPEMAP_CLASSMOD_UNDEF),	// Class modifiers
2217 	   " class $m3classname",	// Class name and bases
2218 	   (derived || *Char(pure_baseclass) || *Char(pure_interfaces)) ? " : " : "", baseclass, pure_baseclass, ((derived || *Char(pure_baseclass)) && *Char(pure_interfaces)) ?	// Interfaces
2219 	   ", " : "", pure_interfaces, " {\n", "  private IntPtr swigCPtr;\n",	// Member variables for memory handling
2220 	   derived ? "" : "  protected bool swigCMemOwn;\n", "\n", "  ", typemapLookup(n, "m3ptrconstructormodifiers", name, WARN_MODULA3_TYPEMAP_PTRCONSTMOD_UNDEF),	// pointer constructor modifiers
2221 	   " $m3classname(IntPtr cPtr, bool cMemoryOwn) ",	// Constructor used for wrapping pointers
2222 	   derived ?
2223 	   ": base($imclassname.$m3classnameTo$baseclass(cPtr), cMemoryOwn) {\n"
2224 	   : "{\n    swigCMemOwn = cMemoryOwn;\n", "    swigCPtr = cPtr;\n", "  }\n", NIL);
2225 
2226     if (!have_default_constructor_flag) {	// All proxy classes need a constructor
2227       Printv(proxy_class_def, "\n", "  protected $m3classname() : this(IntPtr.Zero, false) {\n", "  }\n", NIL);
2228     }
2229     // C++ destructor is wrapped by the Dispose method
2230     // Note that the method name is specified in a typemap attribute called methodname
2231     String *destruct = NewString("");
2232     const String *tm = NULL;
2233     Node *attributes = NewHash();
2234     String *destruct_methodname = NULL;
2235     if (derived) {
2236       tm = typemapLookup(n, "m3destruct_derived", name, WARN_NONE, attributes);
2237       destruct_methodname = Getattr(attributes, "tmap:m3destruct_derived:methodname");
2238     } else {
2239       tm = typemapLookup(n, "m3destruct", name, WARN_NONE, attributes);
2240       destruct_methodname = Getattr(attributes, "tmap:m3destruct:methodname");
2241     }
2242     if (!destruct_methodname) {
2243       Swig_error(Getfile(n), Getline(n), "No methodname attribute defined in m3destruct%s typemap for %s\n", (derived ? "_derived" : ""), proxy_class_name);
2244     }
2245     // Emit the Finalize and Dispose methods
2246     if (tm) {
2247       // Finalize method
2248       if (*Char(destructor_call)) {
2249 	Printv(proxy_class_def, typemapLookup(n, "m3finalize", name, WARN_NONE), NIL);
2250       }
2251       // Dispose method
2252       Printv(destruct, tm, NIL);
2253       if (*Char(destructor_call))
2254 	Replaceall(destruct, "$imcall", destructor_call);
2255       else
2256 	Replaceall(destruct, "$imcall", "throw new MethodAccessException(\"C++ destructor does not have public access\")");
2257       if (*Char(destruct))
2258 	Printv(proxy_class_def, "\n  public ", derived ? "override" : "virtual", " void ", destruct_methodname, "() ", destruct, "\n", NIL);
2259     }
2260     Delete(attributes);
2261     Delete(destruct);
2262 
2263     // Emit various other methods
2264     Printv(proxy_class_def, typemapLookup(n, "m3getcptr", name, WARN_MODULA3_TYPEMAP_GETCPTR_UNDEF),	// getCPtr method
2265 	   typemapLookup(n, "m3code", name, WARN_NONE),	// extra Modula 3 code
2266 	   "\n", NIL);
2267 
2268     // Substitute various strings into the above template
2269     Replaceall(proxy_class_def, "$m3classname", proxy_class_name);
2270     Replaceall(proxy_class_code, "$m3classname", proxy_class_name);
2271 
2272     Replaceall(proxy_class_def, "$baseclass", baseclass);
2273     Replaceall(proxy_class_code, "$baseclass", baseclass);
2274 
2275     Replaceall(proxy_class_def, "$imclassname", m3raw_name);
2276     Replaceall(proxy_class_code, "$imclassname", m3raw_name);
2277 
2278     // Add code to do C++ casting to base class (only for classes in an inheritance hierarchy)
2279     if (derived) {
2280       Printv(m3raw_cppcasts_code, "\n  [DllImport(\"", m3wrap_name, "\", EntryPoint=\"Modula3_", proxy_class_name, "To", baseclass, "\")]\n", NIL);
2281       Printv(m3raw_cppcasts_code, "  public static extern IntPtr ", "$m3classnameTo$baseclass(IntPtr objectRef);\n", NIL);
2282 
2283       Replaceall(m3raw_cppcasts_code, "$m3classname", proxy_class_name);
2284       Replaceall(m3raw_cppcasts_code, "$baseclass", baseclass);
2285 
2286       Printv(upcasts_code,
2287 	     "SWIGEXPORT long Modula3_$imclazznameTo$imbaseclass",
2288 	     "(long objectRef) {\n",
2289 	     "    long baseptr = 0;\n" "    *($cbaseclass **)&baseptr = *($cclass **)&objectRef;\n" "    return baseptr;\n" "}\n", "\n", NIL);
2290 
2291       Replaceall(upcasts_code, "$imbaseclass", baseclass);
2292       Replaceall(upcasts_code, "$cbaseclass", c_baseclass);
2293       Replaceall(upcasts_code, "$imclazzname", proxy_class_name);
2294       Replaceall(upcasts_code, "$cclass", c_classname);
2295     }
2296     Delete(baseclass);
2297   }
2298 
2299   /* ----------------------------------------------------------------------
2300    * getAttrString()
2301    *
2302    * If necessary create and return the string
2303    * associated with a certain attribute of 'n'.
2304    * ---------------------------------------------------------------------- */
2305 
getAttrString(Node * n,const char * attr)2306   String *getAttrString(Node *n, const char *attr) {
2307     String *str = Getattr(n, attr);
2308     if (str == NIL) {
2309       str = NewString("");
2310       Setattr(n, attr, str);
2311     }
2312     return str;
2313   }
2314 
2315   /* ----------------------------------------------------------------------
2316    * getMethodDeclarations()
2317    *
2318    * If necessary create and return the handle
2319    * where the methods of the current access can be written to.
2320    * 'n' must be a member of a struct or a class.
2321    * ---------------------------------------------------------------------- */
2322 
getMethodDeclarations(Node * n)2323   String *getMethodDeclarations(Node *n) {
2324     String *acc_str = Getattr(n, "access");
2325     String *methodattr;
2326     if (acc_str == NIL) {
2327       methodattr = NewString("modula3:method:public");
2328     } else {
2329       methodattr = NewStringf("modula3:method:%s", acc_str);
2330     }
2331     String *methods = getAttrString(parentNode(n), Char(methodattr));
2332     Delete(methodattr);
2333     return methods;
2334   }
2335 
2336   /* ----------------------------------------------------------------------
2337    * classHandler()
2338    * ---------------------------------------------------------------------- */
2339 
classHandler(Node * n)2340   virtual int classHandler(Node *n) {
2341 
2342     File *f_proxy = NULL;
2343     proxy_class_name = Copy(Getattr(n, "sym:name"));
2344     //String *rawname = Getattr(n,"name");
2345 
2346     if (proxy_flag) {
2347       if (!addSymbol(proxy_class_name, n))
2348 	return SWIG_ERROR;
2349 
2350       if (Cmp(proxy_class_name, m3raw_name) == 0) {
2351 	Printf(stderr, "Class name cannot be equal to intermediary class name: %s\n", proxy_class_name);
2352 	SWIG_exit(EXIT_FAILURE);
2353       }
2354 
2355       if (Cmp(proxy_class_name, m3wrap_name) == 0) {
2356 	Printf(stderr, "Class name cannot be equal to module class name: %s\n", proxy_class_name);
2357 	SWIG_exit(EXIT_FAILURE);
2358       }
2359 
2360       String *filen = NewStringf("%s%s.m3", SWIG_output_directory(), proxy_class_name);
2361       f_proxy = NewFile(filen, "w", SWIG_output_files());
2362       if (!f_proxy) {
2363 	FileErrorDisplay(filen);
2364 	SWIG_exit(EXIT_FAILURE);
2365       }
2366       Delete(filen);
2367       filen = NULL;
2368 
2369       emitBanner(f_proxy);
2370 
2371       Clear(proxy_class_def);
2372       Clear(proxy_class_code);
2373 
2374       have_default_constructor_flag = false;
2375       destructor_call = NewString("");
2376     }
2377 
2378     /* This will invoke memberfunctionHandler, membervariableHandler ...
2379        and finally it may invoke functionWrapper
2380        for wrappers and member variable accessors.
2381        It will invoke Language:constructorDeclaration
2382        which decides whether to call MODULA3::constructorHandler */
2383     Language::classHandler(n);
2384 
2385     {
2386       String *kind = Getattr(n, "kind");
2387       if (Cmp(kind, "struct") == 0) {
2388 	String *entries = NewString("");
2389 	Node *child;
2390 	writeArgState state;
2391 	for (child = firstChild(n); child != NIL; child = nextSibling(child)) {
2392 	  String *childType = nodeType(child);
2393 	  if (Strcmp(childType, "cdecl") == 0) {
2394 	    String *member = Getattr(child, "sym:name");
2395 	    ParmList *pl = Getattr(child, "parms");
2396 	    if (pl == NIL) {
2397 	      // Get the variable type in Modula 3 type equivalents
2398 	      String *m3ct = getMappedTypeNew(child, "m3rawtype", "");
2399 
2400 	      writeArg(entries, state, NIL, member, m3ct, NIL);
2401 	    }
2402 	  }
2403 	}
2404 	writeArg(entries, state, NIL, NIL, NIL, NIL);
2405 
2406 	m3raw_intf.enterBlock(blocktype);
2407 	Printf(m3raw_intf.f, "%s =\nRECORD\n%sEND;\n", proxy_class_name, entries);
2408 
2409 	Delete(entries);
2410 
2411       } else if (Cmp(kind, "class") == 0) {
2412 	enum access_privilege { acc_public, acc_protected, acc_private };
2413 	int max_acc = acc_public;
2414 
2415 	const char *acc_name[3] = { "public", "protected", "private" };
2416 	String *methods[3];
2417 	int acc;
2418 	for (acc = acc_public; acc <= acc_private; acc++) {
2419 	  String *methodattr = NewStringf("modula3:method:%s", acc_name[acc]);
2420 	  methods[acc] = Getattr(n, methodattr);
2421 	  Delete(methodattr);
2422 	  max_acc = max_acc > acc ? max_acc : acc;
2423 	}
2424 
2425 	/* Determine the name of the base class */
2426 	String *baseclassname = NewString("");
2427 	{
2428 	  List *baselist = Getattr(n, "bases");
2429 	  if (baselist) {
2430 	    /* Look for the first (principal?) base class -
2431 	       Modula 3 does not support multiple inheritance */
2432 	    Iterator base = First(baselist);
2433 	    if (base.item) {
2434 	      Append(baseclassname, Getattr(base.item, "sym:name"));
2435 	      base = Next(base);
2436 	      if (base.item) {
2437 		Swig_warning(WARN_MODULA3_MULTIPLE_INHERITANCE, Getfile(n), Getline(n),
2438 		    "Warning for %s, base %s ignored. Multiple inheritance is not supported in Modula 3.\n",
2439 		    proxy_class_name, Getattr(base.item, "name"));
2440 	      }
2441 	    }
2442 	  }
2443 	}
2444 
2445 	/* the private class of the base class and only this
2446 	   need a pointer to the C++ object */
2447 	bool need_private = !hasContent(baseclassname);
2448 	max_acc = need_private ? acc_private : max_acc;
2449 
2450 	/* Declare C++ object as abstract pointer in Modula 3 */
2451 	/* The revelation system does not allow us
2452 	   to imitate the whole class hierarchy of the C++ library,
2453 	   but at least we can distinguish between classes of different roots. */
2454 	if (hasContent(baseclassname)) {
2455 	  m3raw_intf.enterBlock(blocktype);
2456 	  Printf(m3raw_intf.f, "%s = %s;\n", proxy_class_name, baseclassname);
2457 	} else {
2458 	  m3raw_intf.enterBlock(blocktype);
2459 	  Printf(m3raw_intf.f, "%s <: ADDRESS;\n", proxy_class_name);
2460 	  m3raw_impl.enterBlock(revelation);
2461 	  Printf(m3raw_impl.f, "%s = UNTRACED BRANDED REF RECORD (*Dummy*) END;\n", proxy_class_name);
2462 	}
2463 
2464 	String *superclass;
2465 	m3wrap_intf.enterBlock(blocktype);
2466 	if (hasContent(methods[acc_public])) {
2467 	  superclass = NewStringf("%sPublic", proxy_class_name);
2468 	} else if (hasContent(baseclassname)) {
2469 	  superclass = Copy(baseclassname);
2470 	} else {
2471 	  superclass = NewString("ROOT");
2472 	}
2473 	Printf(m3wrap_intf.f, "%s <: %s;\n", proxy_class_name, superclass);
2474 	Delete(superclass);
2475 
2476 	{
2477 	  static const char *acc_m3suffix[] = { "Public", "Protected", "Private" };
2478 	  int acc;
2479 	  for (acc = acc_public; acc <= acc_private; acc++) {
2480 	    bool process_private = (acc == acc_private) && need_private;
2481 	    if (hasContent(methods[acc]) || process_private) {
2482 	      String *subclass = NewStringf("%s%s", proxy_class_name, acc_m3suffix[acc]);
2483 	      /*
2484 	         m3wrap_intf.enterBlock(revelation);
2485 	         Printf(m3wrap_intf.f, "%s <: %s;\n", proxy_class_name, subclass);
2486 	       */
2487 	      if (acc == max_acc) {
2488 		m3wrap_intf.enterBlock(revelation);
2489 		Printf(m3wrap_intf.f, "%s =\n", proxy_class_name);
2490 	      } else {
2491 		m3wrap_intf.enterBlock(blocktype);
2492 		Printf(m3wrap_intf.f, "%s =\n", subclass);
2493 	      }
2494 	      Printf(m3wrap_intf.f, "%s BRANDED OBJECT\n", baseclassname);
2495 	      if (process_private) {
2496 		Setattr(m3wrap_intf.import, m3raw_name, "");
2497 		Printf(m3wrap_intf.f, "cxxObj:%s.%s;\n", m3raw_name, proxy_class_name);
2498 	      }
2499 	      if (hasContent(methods[acc])) {
2500 		Printf(m3wrap_intf.f, "METHODS\n%s", methods[acc]);
2501 	      }
2502 	      if (acc == max_acc) {
2503 		String *overrides = Getattr(n, "modula3:override");
2504 		Printf(m3wrap_intf.f, "OVERRIDES\n%s", overrides);
2505 	      }
2506 	      Printf(m3wrap_intf.f, "END;\n");
2507 	      Delete(baseclassname);
2508 	      baseclassname = subclass;
2509 	    }
2510 	  }
2511 	}
2512 
2513 	Delete(methods[acc_public]);
2514 	Delete(methods[acc_protected]);
2515 	Delete(methods[acc_private]);
2516 
2517       } else {
2518 	Swig_warning(WARN_MODULA3_TYPECONSTRUCTOR_UNKNOWN, input_file, line_number, "Unknown type constructor %s\n", kind);
2519       }
2520     }
2521 
2522     if (proxy_flag) {
2523 
2524       emitProxyClassDefAndCPPCasts(n);
2525 
2526       Printv(f_proxy, proxy_class_def, proxy_class_code, NIL);
2527 
2528       Printf(f_proxy, "}\n");
2529       Delete(f_proxy);
2530       f_proxy = NULL;
2531 
2532       Delete(proxy_class_name);
2533       proxy_class_name = NULL;
2534       Delete(destructor_call);
2535       destructor_call = NULL;
2536     }
2537     return SWIG_OK;
2538   }
2539 
2540   /* ----------------------------------------------------------------------
2541    * memberfunctionHandler()
2542    * ---------------------------------------------------------------------- */
2543 
memberfunctionHandler(Node * n)2544   virtual int memberfunctionHandler(Node *n) {
2545     //printf("begin memberfunctionHandler(%s)\n", Char(Getattr(n,"name")));
2546     Setattr(n, "modula3:functype", "method");
2547     Language::memberfunctionHandler(n);
2548 
2549     {
2550       /* Language::memberfunctionHandler will remove the mapped types
2551          that emitM3Wrapper may attach */
2552       ParmList *pl = Getattr(n, "parms");
2553       Swig_typemap_attach_parms("m3wrapinmode", pl, NULL);
2554       Swig_typemap_attach_parms("m3wrapinname", pl, NULL);
2555       Swig_typemap_attach_parms("m3wrapintype", pl, NULL);
2556       Swig_typemap_attach_parms("m3wrapindefault", pl, NULL);
2557       attachParameterNames(n, "tmap:m3wrapinname", "autoname", "arg%d");
2558       String *rettype = getMappedTypeNew(n, "m3wrapouttype", "");
2559 
2560       String *methodname = Getattr(n, "sym:name");
2561 /*
2562       if (methodname==NIL) {
2563         methodname = Getattr(n,"name");
2564       }
2565 */
2566       String *arguments = createM3Signature(n);
2567       String *storage = Getattr(n, "storage");
2568       String *overridden = Getattr(n, "override");
2569       bool isVirtual = (storage != NIL) && (Strcmp(storage, "virtual") == 0);
2570       bool isOverridden = (overridden != NIL)
2571 	  && (Strcmp(overridden, "1") == 0);
2572       if ((!isVirtual) || (!isOverridden)) {
2573 	{
2574 	  String *methods = getMethodDeclarations(n);
2575 	  Printf(methods, "%s(%s)%s%s;%s\n",
2576 		 methodname, arguments,
2577 		 hasContent(rettype) ? ": " : "", hasContent(rettype) ? (const String *) rettype : "", isVirtual ? "  (* base method *)" : "");
2578 	}
2579 	{
2580 	  /* this was attached by functionWrapper
2581 	     invoked by Language::memberfunctionHandler */
2582 	  String *fname = Getattr(n, "modula3:funcname");
2583 	  String *overrides = getAttrString(parentNode(n), "modula3:override");
2584 	  Printf(overrides, "%s := %s;\n", methodname, fname);
2585 	}
2586       }
2587     }
2588 
2589     if (proxy_flag) {
2590       String *overloaded_name = getOverloadedName(n);
2591       String *intermediary_function_name = Swig_name_member(NSPACE_TODO, proxy_class_name, overloaded_name);
2592       Setattr(n, "proxyfuncname", Getattr(n, "sym:name"));
2593       Setattr(n, "imfuncname", intermediary_function_name);
2594       proxyClassFunctionHandler(n);
2595       Delete(overloaded_name);
2596     }
2597     //printf("end memberfunctionHandler(%s)\n", Char(Getattr(n,"name")));
2598     return SWIG_OK;
2599   }
2600 
2601   /* ----------------------------------------------------------------------
2602    * staticmemberfunctionHandler()
2603    * ---------------------------------------------------------------------- */
2604 
staticmemberfunctionHandler(Node * n)2605   virtual int staticmemberfunctionHandler(Node *n) {
2606 
2607     static_flag = true;
2608     Language::staticmemberfunctionHandler(n);
2609 
2610     if (proxy_flag) {
2611       String *overloaded_name = getOverloadedName(n);
2612       String *intermediary_function_name = Swig_name_member(NSPACE_TODO, proxy_class_name, overloaded_name);
2613       Setattr(n, "proxyfuncname", Getattr(n, "sym:name"));
2614       Setattr(n, "imfuncname", intermediary_function_name);
2615       proxyClassFunctionHandler(n);
2616       Delete(overloaded_name);
2617     }
2618     static_flag = false;
2619 
2620     return SWIG_OK;
2621   }
2622 
2623   /* -----------------------------------------------------------------------------
2624    * proxyClassFunctionHandler()
2625    *
2626    * Function called for creating a Modula 3 wrapper function around a c++ function in the
2627    * proxy class. Used for both static and non-static C++ class functions.
2628    * C++ class static functions map to Modula 3 static functions.
2629    * Two extra attributes in the Node must be available. These are "proxyfuncname" -
2630    * the name of the Modula 3 class proxy function, which in turn will call "imfuncname" -
2631    * the intermediary (PInvoke) function name in the intermediary class.
2632    * ----------------------------------------------------------------------------- */
2633 
proxyClassFunctionHandler(Node * n)2634   void proxyClassFunctionHandler(Node *n) {
2635     SwigType *t = Getattr(n, "type");
2636     ParmList *l = Getattr(n, "parms");
2637     Hash *throws_hash = NewHash();
2638     String *intermediary_function_name = Getattr(n, "imfuncname");
2639     String *proxy_function_name = Getattr(n, "proxyfuncname");
2640     String *tm;
2641     Parm *p;
2642     int i;
2643     String *imcall = NewString("");
2644     String *return_type = NewString("");
2645     String *function_code = NewString("");
2646     bool setter_flag = false;
2647 
2648     if (!proxy_flag)
2649       return;
2650 
2651     if (l) {
2652       if (SwigType_type(Getattr(l, "type")) == T_VOID) {
2653 	l = nextSibling(l);
2654       }
2655     }
2656 
2657     /* Attach the non-standard typemaps to the parameter list */
2658     Swig_typemap_attach_parms("in", l, NULL);
2659     Swig_typemap_attach_parms("m3wraptype", l, NULL);
2660     Swig_typemap_attach_parms("m3in", l, NULL);
2661 
2662     /* Get return types */
2663     if ((tm = getMappedTypeNew(n, "m3wraptype", ""))) {
2664       substituteClassname(t, tm);
2665       Printf(return_type, "%s", tm);
2666     }
2667 
2668     if (proxy_flag && wrapping_member_flag && !enum_constant_flag) {
2669       // Properties
2670       setter_flag = (Cmp(Getattr(n, "sym:name"), Swig_name_set(NSPACE_TODO, Swig_name_member(NSPACE_TODO, proxy_class_name, variable_name)))
2671 		     == 0);
2672     }
2673 
2674     /* Start generating the proxy function */
2675     Printf(function_code, "  %s ", Getattr(n, "feature:modula3:methodmodifiers"));
2676     if (static_flag)
2677       Printf(function_code, "static ");
2678     if (Getattr(n, "override"))
2679       Printf(function_code, "override ");
2680     else if (checkAttribute(n, "storage", "virtual"))
2681       Printf(function_code, "virtual ");
2682 
2683     Printf(function_code, "%s %s(", return_type, proxy_function_name);
2684 
2685     Printv(imcall, m3raw_name, ".", intermediary_function_name, "(", NIL);
2686     if (!static_flag)
2687       Printv(imcall, "swigCPtr", NIL);
2688 
2689     emit_mark_varargs(l);
2690 
2691     int gencomma = !static_flag;
2692 
2693     /* Output each parameter */
2694     for (i = 0, p = l; p; i++) {
2695 
2696       /* Ignored varargs */
2697       if (checkAttribute(p, "varargs:ignore", "1")) {
2698 	p = nextSibling(p);
2699 	continue;
2700       }
2701 
2702       /* Ignored parameters */
2703       if (checkAttribute(p, "tmap:in:numinputs", "0")) {
2704 	p = Getattr(p, "tmap:in:next");
2705 	continue;
2706       }
2707 
2708       /* Ignore the 'this' argument for variable wrappers */
2709       if (!(variable_wrapper_flag && i == 0)) {
2710 	SwigType *pt = Getattr(p, "type");
2711 	String *param_type = NewString("");
2712 
2713 	/* Get the Modula 3 parameter type */
2714 	if ((tm = getMappedType(p, "m3wraptype"))) {
2715 	  substituteClassname(pt, tm);
2716 	  Printf(param_type, "%s", tm);
2717 	}
2718 
2719 	if (gencomma)
2720 	  Printf(imcall, ", ");
2721 
2722 	String *arg = variable_wrapper_flag ? NewString("value") : makeParameterName(n,
2723 										     p,
2724 										     i);
2725 
2726 	// Use typemaps to transform type used in Modula 3 wrapper function (in proxy class) to type used in PInvoke function (in intermediary class)
2727 	if ((tm = getMappedType(p, "in"))) {
2728 	  addThrows(throws_hash, "in", p);
2729 	  substituteClassname(pt, tm);
2730 	  Replaceall(tm, "$input", arg);
2731 	  Printv(imcall, tm, NIL);
2732 	}
2733 
2734 	/* Add parameter to proxy function */
2735 	if (gencomma >= 2)
2736 	  Printf(function_code, ", ");
2737 	gencomma = 2;
2738 	Printf(function_code, "%s %s", param_type, arg);
2739 
2740 	Delete(arg);
2741 	Delete(param_type);
2742       }
2743       p = Getattr(p, "tmap:in:next");
2744     }
2745 
2746     Printf(imcall, ")");
2747     Printf(function_code, ")");
2748 
2749     // Transform return type used in PInvoke function (in intermediary class) to type used in Modula 3 wrapper function (in proxy class)
2750     if ((tm = getMappedTypeNew(n, "m3out", ""))) {
2751       addThrows(throws_hash, "m3out", n);
2752       if (GetFlag(n, "feature:new"))
2753 	Replaceall(tm, "$owner", "true");
2754       else
2755 	Replaceall(tm, "$owner", "false");
2756       substituteClassname(t, tm);
2757       Replaceall(tm, "$imcall", imcall);
2758     }
2759 
2760     generateThrowsClause(throws_hash, function_code);
2761     Printf(function_code, " %s\n\n", tm ? (const String *) tm : empty_string);
2762 
2763     if (proxy_flag && wrapping_member_flag && !enum_constant_flag) {
2764       // Properties
2765       if (setter_flag) {
2766 	// Setter method
2767 	if ((tm = getMappedTypeNew(n, "m3varin", ""))) {
2768 	  if (GetFlag(n, "feature:new"))
2769 	    Replaceall(tm, "$owner", "true");
2770 	  else
2771 	    Replaceall(tm, "$owner", "false");
2772 	  substituteClassname(t, tm);
2773 	  Replaceall(tm, "$imcall", imcall);
2774 	  Printf(proxy_class_code, "%s", tm);
2775 	}
2776       } else {
2777 	// Getter method
2778 	if ((tm = getMappedTypeNew(n, "m3varout", ""))) {
2779 	  if (GetFlag(n, "feature:new"))
2780 	    Replaceall(tm, "$owner", "true");
2781 	  else
2782 	    Replaceall(tm, "$owner", "false");
2783 	  substituteClassname(t, tm);
2784 	  Replaceall(tm, "$imcall", imcall);
2785 	  Printf(proxy_class_code, "%s", tm);
2786 	}
2787       }
2788     } else {
2789       // Normal function call
2790       Printv(proxy_class_code, function_code, NIL);
2791     }
2792 
2793     Delete(function_code);
2794     Delete(return_type);
2795     Delete(imcall);
2796     Delete(throws_hash);
2797   }
2798 
2799   /* ----------------------------------------------------------------------
2800    * constructorHandler()
2801    * ---------------------------------------------------------------------- */
2802 
constructorHandler(Node * n)2803   virtual int constructorHandler(Node *n) {
2804     // this invokes functionWrapper
2805     Language::constructorHandler(n);
2806 
2807     if (proxy_flag) {
2808       ParmList *l = Getattr(n, "parms");
2809 
2810       Hash *throws_hash = NewHash();
2811       String *overloaded_name = getOverloadedName(n);
2812       String *imcall = NewString("");
2813 
2814       Printf(proxy_class_code, "  %s %s(", Getattr(n, "feature:modula3:methodmodifiers"), proxy_class_name);
2815       Printv(imcall, " : this(", m3raw_name, ".", Swig_name_construct(NSPACE_TODO, overloaded_name), "(", NIL);
2816 
2817       /* Attach the non-standard typemaps to the parameter list */
2818       Swig_typemap_attach_parms("in", l, NULL);
2819       Swig_typemap_attach_parms("m3wraptype", l, NULL);
2820       Swig_typemap_attach_parms("m3in", l, NULL);
2821 
2822       emit_mark_varargs(l);
2823 
2824       int gencomma = 0;
2825 
2826       String *tm;
2827       Parm *p = l;
2828       int i;
2829 
2830       /* Output each parameter */
2831       for (i = 0; p; i++) {
2832 
2833 	/* Ignored varargs */
2834 	if (checkAttribute(p, "varargs:ignore", "1")) {
2835 	  p = nextSibling(p);
2836 	  continue;
2837 	}
2838 
2839 	/* Ignored parameters */
2840 	if (checkAttribute(p, "tmap:in:numinputs", "0")) {
2841 	  p = Getattr(p, "tmap:in:next");
2842 	  continue;
2843 	}
2844 
2845 	SwigType *pt = Getattr(p, "type");
2846 	String *param_type = NewString("");
2847 
2848 	/* Get the Modula 3 parameter type */
2849 	if ((tm = getMappedType(p, "m3wraptype"))) {
2850 	  substituteClassname(pt, tm);
2851 	  Printf(param_type, "%s", tm);
2852 	}
2853 
2854 	if (gencomma)
2855 	  Printf(imcall, ", ");
2856 
2857 	String *arg = makeParameterName(n, p, i);
2858 
2859 	// Use typemaps to transform type used in Modula 3 wrapper function (in proxy class) to type used in PInvoke function (in intermediary class)
2860 	if ((tm = getMappedType(p, "in"))) {
2861 	  addThrows(throws_hash, "in", p);
2862 	  substituteClassname(pt, tm);
2863 	  Replaceall(tm, "$input", arg);
2864 	  Printv(imcall, tm, NIL);
2865 	}
2866 
2867 	/* Add parameter to proxy function */
2868 	if (gencomma)
2869 	  Printf(proxy_class_code, ", ");
2870 	Printf(proxy_class_code, "%s %s", param_type, arg);
2871 	gencomma = 1;
2872 
2873 	Delete(arg);
2874 	Delete(param_type);
2875 	p = Getattr(p, "tmap:in:next");
2876       }
2877 
2878       Printf(imcall, "), true)");
2879 
2880       Printf(proxy_class_code, ")");
2881       Printf(proxy_class_code, "%s", imcall);
2882       generateThrowsClause(throws_hash, proxy_class_code);
2883       Printf(proxy_class_code, " {\n");
2884       Printf(proxy_class_code, "  }\n\n");
2885 
2886       if (!gencomma)		// We must have a default constructor
2887 	have_default_constructor_flag = true;
2888 
2889       Delete(overloaded_name);
2890       Delete(imcall);
2891       Delete(throws_hash);
2892     }
2893 
2894     return SWIG_OK;
2895   }
2896 
2897   /* ----------------------------------------------------------------------
2898    * destructorHandler()
2899    * ---------------------------------------------------------------------- */
2900 
destructorHandler(Node * n)2901   virtual int destructorHandler(Node *n) {
2902     Language::destructorHandler(n);
2903     String *symname = Getattr(n, "sym:name");
2904 
2905     if (proxy_flag) {
2906       Printv(destructor_call, m3raw_name, ".", Swig_name_destroy(NSPACE_TODO, symname), "(swigCPtr)", NIL);
2907     }
2908     return SWIG_OK;
2909   }
2910 
2911   /* ----------------------------------------------------------------------
2912    * membervariableHandler()
2913    * ---------------------------------------------------------------------- */
2914 
membervariableHandler(Node * n)2915   virtual int membervariableHandler(Node *n) {
2916     //printf("begin membervariableHandler(%s)\n", Char(Getattr(n,"name")));
2917     SwigType *t = Getattr(n, "type");
2918     String *tm;
2919 
2920     // Get the variable type
2921     if ((tm = getMappedTypeNew(n, "m3wraptype", ""))) {
2922       substituteClassname(t, tm);
2923     }
2924 
2925     variable_name = Getattr(n, "sym:name");
2926     //printf("member variable: %s\n", Char(variable_name));
2927 
2928     // Output the property's field declaration and accessor methods
2929     Printf(proxy_class_code, "  public %s %s {", tm, variable_name);
2930 
2931     Setattr(n, "modula3:functype", "accessor");
2932     wrapping_member_flag = true;
2933     variable_wrapper_flag = true;
2934     Language::membervariableHandler(n);
2935     wrapping_member_flag = false;
2936     variable_wrapper_flag = false;
2937 
2938     Printf(proxy_class_code, "\n  }\n\n");
2939 
2940     {
2941       String *methods = getMethodDeclarations(n);
2942       String *overrides = getAttrString(parentNode(n), "modula3:override");
2943       SwigType *type = Getattr(n, "type");
2944       String *m3name = capitalizeFirst(variable_name);
2945       //String *m3name    = nameToModula3(variable_name,true);
2946       if (!SwigType_isconst(type)) {
2947 	{
2948 	  String *inmode = getMappedTypeNew(n, "m3wrapinmode", "", false);
2949 	  String *intype = getMappedTypeNew(n, "m3wrapintype", "");
2950 	  Printf(methods, "set%s(%s val:%s);\n", m3name, (inmode != NIL) ? (const String *) inmode : "", intype);
2951 	}
2952 	{
2953 	  /* this was attached by functionWrapper
2954 	     invoked by Language::memberfunctionHandler */
2955 	  String *fname = Getattr(n, "modula3:setname");
2956 	  Printf(overrides, "set%s := %s;\n", m3name, fname);
2957 	}
2958       }
2959       {
2960 	{
2961 	  String *outtype = getMappedTypeNew(n, "m3wrapouttype", "");
2962 	  Printf(methods, "get%s():%s;\n", m3name, outtype);
2963 	}
2964 	{
2965 	  /* this was attached by functionWrapper
2966 	     invoked by Language::memberfunctionHandler */
2967 	  String *fname = Getattr(n, "modula3:getname");
2968 	  Printf(overrides, "get%s := %s;\n", m3name, fname);
2969 	}
2970       }
2971       Delete(m3name);
2972     }
2973     //printf("end membervariableHandler(%s)\n", Char(Getattr(n,"name")));
2974 
2975     return SWIG_OK;
2976   }
2977 
2978   /* ----------------------------------------------------------------------
2979    * staticmembervariableHandler()
2980    * ---------------------------------------------------------------------- */
2981 
staticmembervariableHandler(Node * n)2982   virtual int staticmembervariableHandler(Node *n) {
2983 
2984     bool static_const_member_flag = (Getattr(n, "value") == 0);
2985     if (static_const_member_flag) {
2986       SwigType *t = Getattr(n, "type");
2987       String *tm;
2988 
2989       // Get the variable type
2990       if ((tm = getMappedTypeNew(n, "m3wraptype", ""))) {
2991 	substituteClassname(t, tm);
2992       }
2993       // Output the property's field declaration and accessor methods
2994       Printf(proxy_class_code, "  public static %s %s {", tm, Getattr(n, "sym:name"));
2995     }
2996 
2997     variable_name = Getattr(n, "sym:name");
2998     wrapping_member_flag = true;
2999     static_flag = true;
3000     Language::staticmembervariableHandler(n);
3001     wrapping_member_flag = false;
3002     static_flag = false;
3003 
3004     if (static_const_member_flag)
3005       Printf(proxy_class_code, "\n  }\n\n");
3006 
3007     return SWIG_OK;
3008   }
3009 
3010   /* ----------------------------------------------------------------------
3011    * memberconstantHandler()
3012    * ---------------------------------------------------------------------- */
3013 
memberconstantHandler(Node * n)3014   virtual int memberconstantHandler(Node *n) {
3015     variable_name = Getattr(n, "sym:name");
3016     wrapping_member_flag = true;
3017     Language::memberconstantHandler(n);
3018     wrapping_member_flag = false;
3019     return SWIG_OK;
3020   }
3021 
3022   /* -----------------------------------------------------------------------------
3023    * getOverloadedName()
3024    * ----------------------------------------------------------------------------- */
3025 
getOverloadedName(Node * n)3026   String *getOverloadedName(Node *n) {
3027     String *overloaded_name = Copy(Getattr(n, "sym:name"));
3028 
3029     if (Getattr(n, "sym:overloaded")) {
3030       Printv(overloaded_name, Getattr(n, "sym:overname"), NIL);
3031     }
3032 
3033     return overloaded_name;
3034   }
3035 
3036   /* -----------------------------------------------------------------------------
3037    * emitM3Wrapper()
3038    * It is also used for set and get methods of global variables.
3039    * ----------------------------------------------------------------------------- */
3040 
emitM3Wrapper(Node * n,const String * func_name)3041   void emitM3Wrapper(Node *n, const String *func_name) {
3042     SwigType *t = Getattr(n, "type");
3043     ParmList *l = Getattr(n, "parms");
3044     Hash *throws_hash = NewHash();
3045     int num_exceptions = 0;
3046     int num_returns = 0;
3047     String *rawcall = NewString("");
3048     String *reccall = NewString("");
3049     String *local_variables = NewString("");
3050     String *local_constants = NewString("");
3051     String *incheck = NewString("");
3052     String *outcheck = NewString("");
3053     String *setup = NewString("");
3054     String *cleanup = NewString("");
3055     String *outarg = NewString("");	/* don't mix up with 'autark' :-] */
3056     String *storeout = NewString("");
3057     String *result_name = NewString("");
3058     String *return_variables = NewString("");
3059     const char *result_return = "ret";
3060     String *function_code = NewString("");
3061     /*several names for the same function */
3062     String *raw_name = Getattr(n, "name");	/*original C function name */
3063     //String     *func_name = Getattr(n,"sym:name");  /*final Modula3 name chosen by the user*/
3064     bool setter_flag = false;
3065     int multiretval = GetFlag(n, "feature:modula3:multiretval");
3066 
3067     if (l) {
3068       if (SwigType_type(Getattr(l, "type")) == T_VOID) {
3069 	l = nextSibling(l);
3070       }
3071     }
3072 
3073     /* Attach the non-standard typemaps to the parameter list */
3074     Swig_typemap_attach_parms("m3wrapargvar", l, NULL);
3075     Swig_typemap_attach_parms("m3wrapargconst", l, NULL);
3076     Swig_typemap_attach_parms("m3wrapargraw", l, NULL);
3077     Swig_typemap_attach_parms("m3wrapargdir", l, NULL);
3078     Swig_typemap_attach_parms("m3wrapinmode", l, NULL);
3079     Swig_typemap_attach_parms("m3wrapinname", l, NULL);
3080     Swig_typemap_attach_parms("m3wrapintype", l, NULL);
3081     Swig_typemap_attach_parms("m3wrapindefault", l, NULL);
3082     Swig_typemap_attach_parms("m3wrapinconv", l, NULL);
3083     Swig_typemap_attach_parms("m3wrapincheck", l, NULL);
3084     Swig_typemap_attach_parms("m3wrapoutname", l, NULL);
3085     Swig_typemap_attach_parms("m3wrapouttype", l, NULL);
3086     Swig_typemap_attach_parms("m3wrapoutconv", l, NULL);
3087     Swig_typemap_attach_parms("m3wrapoutcheck", l, NULL);
3088 
3089     attachMappedType(n, "m3wrapretraw");
3090     attachMappedType(n, "m3wrapretname");
3091     attachMappedType(n, "m3wraprettype");
3092     attachMappedType(n, "m3wrapretvar");
3093     attachMappedType(n, "m3wrapretconv");
3094     attachMappedType(n, "m3wrapretcheck");
3095 
3096     Swig_typemap_attach_parms("m3wrapfreearg", l, NULL);
3097 
3098 /*
3099     Swig_typemap_attach_parms("m3wrapargvar:throws", l, NULL);
3100     Swig_typemap_attach_parms("m3wrapargraw:throws", l, NULL);
3101     Swig_typemap_attach_parms("m3wrapinconv:throws", l, NULL);
3102     Swig_typemap_attach_parms("m3wrapincheck:throws", l, NULL);
3103     Swig_typemap_attach_parms("m3wrapoutconv:throws", l, NULL);
3104     Swig_typemap_attach_parms("m3wrapoutcheck:throws", l, NULL);
3105 
3106     attachMappedType(n, "m3wrapretvar:throws");
3107     attachMappedType(n, "m3wrapretconv:throws");
3108     attachMappedType(n, "m3wrapretcheck:throws");
3109 
3110     Swig_typemap_attach_parms("m3wrapfreearg:throws", l, NULL);
3111 */
3112 
3113     /* Attach argument names to the parameter list */
3114     /* should be a separate procedure making use of hashes */
3115     attachParameterNames(n, "tmap:m3wrapinname", "autoname", "arg%d");
3116 
3117     /* Get return types */
3118     String *result_m3rawtype = Copy(getMappedTypeNew(n, "m3rawrettype", ""));
3119     String *result_m3wraptype = Copy(getMappedTypeNew(n, "m3wraprettype", ""));
3120     bool has_return_raw = hasContent(result_m3rawtype);
3121     bool has_return_m3 = hasContent(result_m3wraptype);
3122     if (has_return_m3) {
3123       num_returns++;
3124       //printf("%s: %s\n", Char(func_name),Char(result_m3wraptype));
3125     }
3126 
3127     String *arguments = createM3Signature(n);
3128 
3129     /* Create local variables or RECORD fields for return values
3130        and determine return type that might result from a converted VAR argument. */
3131     {
3132       writeArgState state;
3133       if (multiretval && has_return_m3) {
3134 	writeArg(return_variables, state, NIL, NewString(result_return), result_m3wraptype, NIL);
3135       }
3136 
3137       Parm *p = skipIgnored(l, "m3wrapouttype");
3138       while (p != NIL) {
3139 
3140 	String *arg = Getattr(p, "tmap:m3wrapoutname");
3141 	if (arg == NIL) {
3142 	  arg = Getattr(p, "name");
3143 	}
3144 
3145 	String *tm = Getattr(p, "tmap:m3wrapouttype");
3146 	if (tm != NIL) {
3147 	  if (isOutParam(p)) {
3148 	    if (!multiretval) {
3149 	      if (num_returns == 0) {
3150 		Printv(result_name, arg, NIL);
3151 		Clear(result_m3wraptype);
3152 		Printv(result_m3wraptype, tm, NIL);
3153 	      } else {
3154 		Swig_warning(WARN_MODULA3_TYPEMAP_MULTIPLE_RETURN, input_file, line_number,
3155 			     "Typemap m3wrapargdir set to 'out' for %s implies a RETURN value, but the routine %s has already one.\nUse %%multiretval feature.\n",
3156 			     SwigType_str(Getattr(p, "type"), 0), raw_name);
3157 	      }
3158 	    }
3159 	    num_returns++;
3160 	    addImports(m3wrap_intf.import, "m3wrapouttype", p);
3161 	    writeArg(return_variables, state, NIL, arg, tm, NIL);
3162 	  }
3163 	  p = skipIgnored(Getattr(p, "tmap:m3wrapouttype:next"), "m3wrapouttype");
3164 	} else {
3165 	  p = nextSibling(p);
3166 	}
3167       }
3168       writeArg(return_variables, state, NIL, NIL, NIL, NIL);
3169 
3170       if (multiretval) {
3171 	Printv(result_name, Swig_cresult_name(), NIL);
3172 	Printf(result_m3wraptype, "%sResult", func_name);
3173 	m3wrap_intf.enterBlock(blocktype);
3174 	Printf(m3wrap_intf.f, "%s =\nRECORD\n%sEND;\n", result_m3wraptype, return_variables);
3175 	Printf(local_variables, "%s: %s;\n", result_name, result_m3wraptype);
3176       } else {
3177 	Append(local_variables, return_variables);
3178       }
3179     }
3180 
3181     /* Declare local constants e.g. for storing argument names. */
3182     {
3183       Parm *p = l;
3184       while (p != NIL) {
3185 
3186 	String *arg = Getattr(p, "autoname");
3187 
3188 	String *tm = Getattr(p, "tmap:m3wrapargconst");
3189 	if (tm != NIL) {
3190 	  addImports(m3wrap_impl.import, "m3wrapargconst", p);
3191 	  Replaceall(tm, "$input", arg);
3192 	  Printv(local_constants, tm, "\n", NIL);
3193 	  p = Getattr(p, "tmap:m3wrapargconst:next");
3194 	} else {
3195 	  p = nextSibling(p);
3196 	}
3197 
3198       }
3199     }
3200 
3201     /* Declare local variables e.g. for converted input values. */
3202     {
3203       String *tm = getMappedTypeNew(n, "m3wrapretvar", "", false);
3204       if (tm != NIL) {
3205 	addImports(m3wrap_impl.import, "m3wrapretvar", n);
3206 	addThrows(throws_hash, "m3wrapretvar", n);
3207 	Printv(local_variables, tm, "\n", NIL);
3208       }
3209 
3210       Parm *p = l;
3211       while (p != NIL) {
3212 
3213 	String *arg = Getattr(p, "autoname");
3214 
3215 	tm = Getattr(p, "tmap:m3wrapargvar");
3216 	if (tm != NIL) {
3217 	  /* exceptions that may be raised but can't be caught,
3218 	     thus we won't count them in num_exceptions */
3219 	  addImports(m3wrap_impl.import, "m3wrapargvar", p);
3220 	  addThrows(throws_hash, "m3wrapargvar", p);
3221 	  Replaceall(tm, "$input", arg);
3222 	  Printv(local_variables, tm, "\n", NIL);
3223 	  p = Getattr(p, "tmap:m3wrapargvar:next");
3224 	} else {
3225 	  p = nextSibling(p);
3226 	}
3227 
3228       }
3229     }
3230 
3231     /* Convert input values from Modula 3 to C. */
3232     {
3233       Parm *p = l;
3234       while (p != NIL) {
3235 
3236 	String *arg = Getattr(p, "autoname");
3237 
3238 	String *tm = Getattr(p, "tmap:m3wrapinconv");
3239 	if (tm != NIL) {
3240 	  addImports(m3wrap_impl.import, "m3wrapinconv", p);
3241 	  num_exceptions += addThrows(throws_hash, "m3wrapinconv", p);
3242 	  Replaceall(tm, "$input", arg);
3243 	  Printv(setup, tm, "\n", NIL);
3244 	  p = Getattr(p, "tmap:m3wrapinconv:next");
3245 	} else {
3246 	  p = nextSibling(p);
3247 	}
3248 
3249       }
3250     }
3251 
3252     /* Generate checks for input value integrity. */
3253     {
3254       Parm *p = l;
3255       while (p != NIL) {
3256 
3257 	String *arg = Getattr(p, "autoname");
3258 
3259 	String *tm = Getattr(p, "tmap:m3wrapincheck");
3260 	if (tm != NIL) {
3261 	  addImports(m3wrap_impl.import, "m3wrapincheck", p);
3262 	  num_exceptions += addThrows(throws_hash, "m3wrapincheck", p);
3263 	  Replaceall(tm, "$input", arg);
3264 	  Printv(incheck, tm, "\n", NIL);
3265 	  p = Getattr(p, "tmap:m3wrapincheck:next");
3266 	} else {
3267 	  p = nextSibling(p);
3268 	}
3269 
3270       }
3271     }
3272 
3273     Printv(rawcall, m3raw_name, ".", func_name, "(", NIL);
3274     /* Arguments to the raw C function */
3275     {
3276       bool gencomma = false;
3277       Parm *p = l;
3278       while (p != NIL) {
3279 	if (gencomma) {
3280 	  Printf(rawcall, ", ");
3281 	}
3282 	gencomma = true;
3283 	addImports(m3wrap_impl.import, "m3wrapargraw", p);
3284 	num_exceptions += addThrows(throws_hash, "m3wrapargraw", p);
3285 
3286 	String *arg = Getattr(p, "autoname");
3287 	String *qualarg = NewString("");
3288 	if (!isInParam(p)) {
3289 	  String *tmparg = Getattr(p, "tmap:m3wrapoutname");
3290 	  if (tmparg != NIL) {
3291 	    arg = tmparg;
3292 	  }
3293 	  if (multiretval /*&& isOutParam(p) - automatically fulfilled */ ) {
3294 	    Printf(qualarg, "%s.", result_name);
3295 	  }
3296 	}
3297 	Append(qualarg, arg);
3298 	Setattr(p, "m3outarg", qualarg);
3299 
3300 	String *tm = Getattr(p, "tmap:m3wrapargraw");
3301 	if (tm != NIL) {
3302 	  Replaceall(tm, "$input", arg);
3303 	  Replaceall(tm, "$output", qualarg);
3304 	  Printv(rawcall, tm, NIL);
3305 	  p = Getattr(p, "tmap:m3wrapargraw:next");
3306 	} else {
3307 	  //Printv(rawcall, Getattr(p,"lname"), NIL);
3308 	  Printv(rawcall, qualarg, NIL);
3309 	  p = nextSibling(p);
3310 	}
3311 	Delete(qualarg);
3312       }
3313     }
3314     Printf(rawcall, ")");
3315 
3316     /* Check for error codes and integrity of results */
3317     {
3318       String *tm = getMappedTypeNew(n, "m3wrapretcheck", "", false);
3319       if (tm != NIL) {
3320 	addImports(m3wrap_impl.import, "m3wrapretcheck", n);
3321 	num_exceptions += addThrows(throws_hash, "m3wrapretcheck", n);
3322 	Printv(outcheck, tm, "\n", NIL);
3323       }
3324 
3325       Parm *p = l;
3326       while (p != NIL) {
3327 	tm = Getattr(p, "tmap:m3wrapoutcheck");
3328 	if (tm != NIL) {
3329 	  String *arg = Getattr(p, "autoname");
3330 	  String *outarg = Getattr(p, "m3outarg");
3331 	  addImports(m3wrap_impl.import, "m3wrapoutcheck", p);
3332 	  num_exceptions += addThrows(throws_hash, "m3wrapoutcheck", p);
3333 	  //substituteClassname(Getattr(p,"type"), tm);
3334 	  Replaceall(tm, "$input", arg);
3335 	  Replaceall(tm, "$output", outarg);
3336 	  Printv(outcheck, tm, "\n", NIL);
3337 	  p = Getattr(p, "tmap:m3wrapoutcheck:next");
3338 	} else {
3339 	  p = nextSibling(p);
3340 	}
3341       }
3342     }
3343 
3344     /* Convert the results to Modula 3 data structures and
3345        put them in the record prepared for returning */
3346     {
3347       /* m3wrapretconv is processed
3348          when it is clear if there is some output conversion and checking code */
3349       Parm *p = l;
3350       while (p != NIL) {
3351 	String *tm = Getattr(p, "tmap:m3wrapoutconv");
3352 	if (tm != NIL) {
3353 	  String *arg = Getattr(p, "autoname");
3354 	  String *outarg = Getattr(p, "m3outarg");
3355 	  addImports(m3wrap_impl.import, "m3wrapoutconv", n);
3356 	  num_exceptions += addThrows(throws_hash, "m3wrapoutconv", p);
3357 	  //substituteClassname(Getattr(p,"type"), tm);
3358 	  Replaceall(tm, "$input", arg);
3359 	  Replaceall(tm, "$output", outarg);
3360 	  Printf(storeout, "%s := %s;\n", outarg, tm);
3361 	  p = Getattr(p, "tmap:m3wrapoutconv:next");
3362 	} else {
3363 	  p = nextSibling(p);
3364 	}
3365       }
3366     }
3367 
3368     /* Generate cleanup code */
3369     {
3370       Parm *p = l;
3371       while (p != NIL) {
3372 	String *tm = Getattr(p, "tmap:m3wrapfreearg");
3373 	if (tm != NIL) {
3374 	  String *arg = Getattr(p, "autoname");
3375 	  String *outarg = Getattr(p, "m3outarg");
3376 	  addImports(m3wrap_impl.import, "m3wrapfreearg", p);
3377 	  num_exceptions += addThrows(throws_hash, "m3wrapfreearg", p);
3378 	  //substituteClassname(Getattr(p,"type"), tm);
3379 	  Replaceall(tm, "$input", arg);
3380 	  Replaceall(tm, "$output", outarg);
3381 	  Printv(cleanup, tm, "\n", NIL);
3382 	  p = Getattr(p, "tmap:m3wrapfreearg:next");
3383 	} else {
3384 	  p = nextSibling(p);
3385 	}
3386       }
3387     }
3388 
3389     {
3390       /* Currently I don't know how a typemap similar to the original 'out' typemap
3391          could help returning the return value. */
3392       /* Receive result from call to raw library function */
3393       if (!has_return_raw) {
3394 	/*
3395 	   rawcall(arg1);
3396 	   result.val := arg1;
3397 	   RETURN result;
3398 	 */
3399 	/*
3400 	   rawcall(arg1);
3401 	   RETURN arg1;
3402 	 */
3403 	Printf(reccall, "%s;\n", rawcall);
3404 
3405 	if (hasContent(result_name)) {
3406 	  Printf(outarg, "RETURN %s;\n", result_name);
3407 	}
3408       } else {
3409 	/*
3410 	   arg0 := rawcall(arg1);
3411 	   result.ret := Convert(arg0);
3412 	   result.val := arg1;
3413 	   RETURN result;
3414 	 */
3415 	/*
3416 	   arg0 := rawcall();
3417 	   RETURN Convert(arg0);
3418 	 */
3419 	/*
3420 	   RETURN rawcall();
3421 	 */
3422 	String *return_raw = getMappedTypeNew(n, "m3wrapretraw", "", false);
3423 	String *return_conv = getMappedTypeNew(n, "m3wrapretconv", "", false);
3424 
3425 	/* immediate RETURN would skip result checking */
3426 	if ((hasContent(outcheck) || hasContent(storeout)
3427 	     || hasContent(cleanup)) && (!hasContent(result_name))
3428 	    && (return_raw == NIL)) {
3429 	  Printv(result_name, Swig_cresult_name(), NIL);
3430 	  Printf(local_variables, "%s: %s;\n", result_name, result_m3wraptype);
3431 	}
3432 
3433 	String *result_lvalue = Copy(result_name);
3434 	if (multiretval) {
3435 	  Printf(result_lvalue, ".%s", result_return);
3436 	}
3437 	if (return_raw != NIL) {
3438 	  Printf(reccall, "%s := %s;\n", return_raw, rawcall);
3439 	} else if (hasContent(result_name)) {
3440 	  Printf(reccall, "%s := %s;\n", result_lvalue, rawcall);
3441 	} else {
3442 	  Printf(outarg, "RETURN %s;\n", rawcall);
3443 	}
3444 	if (return_conv != NIL) {
3445 	  addImports(m3wrap_impl.import, "m3wrapretconv", n);
3446 	  num_exceptions += addThrows(throws_hash, "m3wrapretconv", n);
3447 	  if (hasContent(result_name)) {
3448 	    Printf(reccall, "%s := %s;\n", result_lvalue, return_conv);
3449 	    Printf(outarg, "RETURN %s;\n", result_name);
3450 	  } else {
3451 	    Printf(outarg, "RETURN %s;\n", return_conv);
3452 	  }
3453 	} else {
3454 	  if (hasContent(result_name)) {
3455 	    Printf(outarg, "RETURN %s;\n", result_name);
3456 	  }
3457 	}
3458       }
3459     }
3460 
3461     /* Create procedure header */
3462     {
3463       String *header = NewStringf("PROCEDURE %s (%s)",
3464 				  func_name, arguments);
3465 
3466       if ((num_returns > 0) || multiretval) {
3467 	Printf(header, ": %s", result_m3wraptype);
3468       }
3469       generateThrowsClause(throws_hash, header);
3470 
3471       Append(function_code, header);
3472 
3473       m3wrap_intf.enterBlock(no_block);
3474       Printf(m3wrap_intf.f, "%s;\n\n", header);
3475     }
3476 
3477     {
3478       String *body = NewStringf("%s%s%s%s%s",
3479 				incheck,
3480 				setup,
3481 				reccall,
3482 				outcheck,
3483 				storeout);
3484 
3485       String *exc_handler;
3486       if (hasContent(cleanup) && (num_exceptions > 0)) {
3487 	exc_handler = NewStringf("TRY\n%sFINALLY\n%sEND;\n", body, cleanup);
3488       } else {
3489 	exc_handler = NewStringf("%s%s", body, cleanup);
3490       }
3491 
3492       Printf(function_code, " =\n%s%s%s%sBEGIN\n%s%sEND %s;\n\n",
3493 	     hasContent(local_constants) ? "CONST\n" : "", local_constants,
3494 	     hasContent(local_variables) ? "VAR\n" : "", local_variables, exc_handler, outarg, func_name);
3495 
3496       Delete(exc_handler);
3497       Delete(body);
3498     }
3499 
3500     m3wrap_impl.enterBlock(no_block);
3501     if (proxy_flag && global_variable_flag) {
3502       setter_flag = (Cmp(Getattr(n, "sym:name"), Swig_name_set(NSPACE_TODO, variable_name)) == 0);
3503       // Properties
3504       if (setter_flag) {
3505 	// Setter method
3506 	String *tm = getMappedTypeNew(n, "m3varin", "");
3507 	if (tm != NIL) {
3508 	  if (GetFlag(n, "feature:new")) {
3509 	    Replaceall(tm, "$owner", "true");
3510 	  } else {
3511 	    Replaceall(tm, "$owner", "false");
3512 	  }
3513 	  substituteClassname(t, tm);
3514 	  Replaceall(tm, "$rawcall", rawcall);
3515 	  Replaceall(tm, "$vartype", variable_type);	/* $type is already replaced by some super class */
3516 	  Replaceall(tm, "$var", variable_name);
3517 	  Printf(m3wrap_impl.f, "%s", tm);
3518 	}
3519       } else {
3520 	// Getter method
3521 	String *tm = getMappedTypeNew(n, "m3varout", "");
3522 	if (tm != NIL) {
3523 	  if (GetFlag(n, "feature:new"))
3524 	    Replaceall(tm, "$owner", "true");
3525 	  else
3526 	    Replaceall(tm, "$owner", "false");
3527 	  substituteClassname(t, tm);
3528 	  Replaceall(tm, "$rawcall", rawcall);
3529 	  Replaceall(tm, "$vartype", variable_type);
3530 	  Replaceall(tm, "$var", variable_name);
3531 	  Printf(m3wrap_impl.f, "%s", tm);
3532 	}
3533       }
3534     } else {
3535       // Normal function call
3536       Printv(m3wrap_impl.f, function_code, NIL);
3537     }
3538 
3539     Delete(arguments);
3540     Delete(return_variables);
3541     Delete(local_variables);
3542     Delete(local_constants);
3543     Delete(outarg);
3544     Delete(incheck);
3545     Delete(outcheck);
3546     Delete(setup);
3547     Delete(cleanup);
3548     Delete(storeout);
3549     Delete(function_code);
3550     Delete(result_name);
3551     Delete(result_m3wraptype);
3552     Delete(reccall);
3553     Delete(rawcall);
3554     Delete(throws_hash);
3555   }
3556 
3557   /*----------------------------------------------------------------------
3558    * replaceSpecialVariables()
3559    *--------------------------------------------------------------------*/
3560 
replaceSpecialVariables(String * method,String * tm,Parm * parm)3561   virtual void replaceSpecialVariables(String *method, String *tm, Parm *parm) {
3562     (void)method;
3563     SwigType *type = Getattr(parm, "type");
3564     substituteClassname(type, tm);
3565   }
3566 
3567   /* -----------------------------------------------------------------------------
3568    * substituteClassname()
3569    *
3570    * Substitute the special variable $m3classname with the proxy class name for classes/structs/unions
3571    * that SWIG knows about.
3572    * Otherwise use the $descriptor name for the Modula 3 class name. Note that the $&m3classname substitution
3573    * is the same as a $&descriptor substitution, ie one pointer added to descriptor name.
3574    * Inputs:
3575    *   pt - parameter type
3576    *   tm - typemap contents that might contain the special variable to be replaced
3577    * Outputs:
3578    *   tm - typemap contents complete with the special variable substitution
3579    * Return:
3580    *   substitution_performed - flag indicating if a substitution was performed
3581    * ----------------------------------------------------------------------------- */
3582 
substituteClassname(SwigType * pt,String * tm)3583   bool substituteClassname(SwigType *pt, String *tm) {
3584     bool substitution_performed = false;
3585     if (Strstr(tm, "$m3classname") || Strstr(tm, "$&m3classname")) {
3586       String *classname = getProxyName(pt);
3587       if (classname) {
3588 	Replaceall(tm, "$&m3classname", classname);	// getProxyName() works for pointers to classes too
3589 	Replaceall(tm, "$m3classname", classname);
3590       } else {			// use $descriptor if SWIG does not know anything about this type. Note that any typedefs are resolved.
3591 	String *descriptor = NULL;
3592 	SwigType *type = Copy(SwigType_typedef_resolve_all(pt));
3593 
3594 	if (Strstr(tm, "$&m3classname")) {
3595 	  SwigType_add_pointer(type);
3596 	  descriptor = NewStringf("SWIGTYPE%s", SwigType_manglestr(type));
3597 	  Replaceall(tm, "$&m3classname", descriptor);
3598 	} else {		// $m3classname
3599 	  descriptor = NewStringf("SWIGTYPE%s", SwigType_manglestr(type));
3600 	  Replaceall(tm, "$m3classname", descriptor);
3601 	}
3602 
3603 	// Add to hash table so that the type wrapper classes can be created later
3604 	Setattr(swig_types_hash, descriptor, type);
3605 	Delete(descriptor);
3606 	Delete(type);
3607       }
3608       substitution_performed = true;
3609     }
3610     return substitution_performed;
3611   }
3612 
3613   /* -----------------------------------------------------------------------------
3614    * attachParameterNames()
3615    *
3616    * Inputs:
3617    *   n      - Node of a function declaration
3618    *   tmid   - attribute name for overriding C argument names,
3619    *              e.g. "tmap:m3wrapinname",
3620    *              don't forget to attach the mapped types before
3621    *   nameid - attribute for attaching the names,
3622    *              e.g. "modula3:inname"
3623    *   fmt    - format for the argument name containing %d
3624    *              e.g. "arg%d"
3625    * ----------------------------------------------------------------------------- */
3626 
attachParameterNames(Node * n,const char * tmid,const char * nameid,const char * fmt)3627   void attachParameterNames(Node *n, const char *tmid, const char *nameid, const char *fmt) {
3628     /* Use C parameter name if present and unique,
3629        otherwise create an 'arg%d' name */
3630     Hash *hash = NewHash();
3631     Parm *p = Getattr(n, "parms");
3632     int count = 0;
3633     while (p != NIL) {
3634       String *name = Getattr(p, tmid);
3635       if (name == NIL) {
3636 	name = Getattr(p, "name");
3637       }
3638       String *newname;
3639       if ((!hasContent(name)) || (Getattr(hash, name) != NIL)) {
3640 	newname = NewStringf(fmt, count);
3641       } else {
3642 	newname = Copy(name);
3643       }
3644       if (1 == Setattr(hash, newname, "1")) {
3645 	Swig_warning(WARN_MODULA3_DOUBLE_ID, input_file, line_number, "Argument '%s' twice.\n", newname);
3646       }
3647       Setattr(p, nameid, newname);
3648 //      Delete(newname);
3649       p = nextSibling(p);
3650       count++;
3651     }
3652     Delete(hash);
3653   }
3654 
3655   /* -----------------------------------------------------------------------------
3656    * createM3Signature()
3657    *
3658    * Create signature of M3 wrapper procedure
3659    * Call attachParameterNames and attach mapped types before!
3660    *   m3wrapintype, m3wrapinmode, m3wrapindefault
3661    * ----------------------------------------------------------------------------- */
3662 
createM3Signature(Node * n)3663   String *createM3Signature(Node *n) {
3664     String *arguments = NewString("");
3665     Parm *p = skipIgnored(Getattr(n, "parms"), "m3wrapintype");
3666     writeArgState state;
3667     while (p != NIL) {
3668 
3669       /* Get the M3 parameter type */
3670       String *tm = getMappedType(p, "m3wrapintype");
3671       if (tm != NIL) {
3672 	if (isInParam(p)) {
3673 	  addImports(m3wrap_intf.import, "m3wrapintype", p);
3674 	  addImports(m3wrap_impl.import, "m3wrapintype", p);
3675 	  String *mode = Getattr(p, "tmap:m3wrapinmode");
3676 	  String *deflt = Getattr(p, "tmap:m3wrapindefault");
3677 	  String *arg = Getattr(p, "autoname");
3678 	  SwigType *pt = Getattr(p, "type");
3679 	  substituteClassname(pt, tm);	/* do we need this ? */
3680 
3681 	  writeArg(arguments, state, mode, arg, tm, deflt);
3682 	}
3683 	p = skipIgnored(Getattr(p, "tmap:m3wrapintype:next"), "m3wrapintype");
3684       } else {
3685 	p = nextSibling(p);
3686       }
3687     }
3688     writeArg(arguments, state, NIL, NIL, NIL, NIL);
3689     return (arguments);
3690   }
3691 
3692 /* not used any longer
3693     - try SwigType_str if required again */
3694 #if 0
3695   /* -----------------------------------------------------------------------------
3696    * createCSignature()
3697    *
3698    * Create signature of C function
3699    * ----------------------------------------------------------------------------- */
3700 
3701   String *createCSignature(Node *n) {
3702     String *arguments = NewString("");
3703     bool gencomma = false;
3704     Node *p;
3705     for (p = Getattr(n, "parms"); p != NIL; p = nextSibling(p)) {
3706       if (gencomma) {
3707 	Append(arguments, ",");
3708       }
3709       gencomma = true;
3710       String *type = Getattr(p, "type");
3711       String *ctype = getMappedTypeNew(type, "ctype");
3712       Append(arguments, ctype);
3713     }
3714     return arguments;
3715   }
3716 #endif
3717 
3718   /* -----------------------------------------------------------------------------
3719    * emitTypeWrapperClass()
3720    * ----------------------------------------------------------------------------- */
3721 
emitTypeWrapperClass(String * classname,SwigType * type)3722   void emitTypeWrapperClass(String *classname, SwigType *type) {
3723     Node *n = NewHash();
3724     Setfile(n, input_file);
3725     Setline(n, line_number);
3726 
3727     String *filen = NewStringf("%s%s.m3", SWIG_output_directory(), classname);
3728     File *f_swigtype = NewFile(filen, "w", SWIG_output_files());
3729     if (!f_swigtype) {
3730       FileErrorDisplay(filen);
3731       SWIG_exit(EXIT_FAILURE);
3732     }
3733     String *swigtype = NewString("");
3734 
3735     // Emit banner name
3736     emitBanner(f_swigtype);
3737 
3738     // Pure Modula 3 baseclass and interfaces
3739     const String *pure_baseclass = typemapLookup(n, "m3base", type, WARN_NONE);
3740     const String *pure_interfaces = typemapLookup(n, "m3interfaces", type, WARN_NONE);
3741 
3742     // Emit the class
3743     Printv(swigtype, typemapLookup(n, "m3imports", type, WARN_NONE),	// Import statements
3744 	   "\n", typemapLookup(n, "m3classmodifiers", type, WARN_MODULA3_TYPEMAP_CLASSMOD_UNDEF),	// Class modifiers
3745 	   " class $m3classname",	// Class name and bases
3746 	   *Char(pure_baseclass) ? " : " : "", pure_baseclass, *Char(pure_interfaces) ?	// Interfaces
3747 	   " : " : "", pure_interfaces, " {\n", "  private IntPtr swigCPtr;\n", "\n", "  ", typemapLookup(n, "m3ptrconstructormodifiers", type, WARN_MODULA3_TYPEMAP_PTRCONSTMOD_UNDEF),	// pointer constructor modifiers
3748 	   " $m3classname(IntPtr cPtr, bool bFutureUse) {\n",	// Constructor used for wrapping pointers
3749 	   "    swigCPtr = cPtr;\n", "  }\n", "\n", "  protected $m3classname() {\n",	// Default constructor
3750 	   "    swigCPtr = IntPtr.Zero;\n", "  }\n", typemapLookup(n, "m3getcptr", type, WARN_MODULA3_TYPEMAP_GETCPTR_UNDEF),	// getCPtr method
3751 	   typemapLookup(n, "m3code", type, WARN_NONE),	// extra Modula 3 code
3752 	   "}\n", "\n", NIL);
3753 
3754     Replaceall(swigtype, "$m3classname", classname);
3755     Printv(f_swigtype, swigtype, NIL);
3756 
3757     Delete(f_swigtype);
3758     Delete(filen);
3759     Delete(swigtype);
3760   }
3761 
3762   /* -----------------------------------------------------------------------------
3763    * typemapLookup()
3764    * n - for input only and must contain info for Getfile(n) and Getline(n) to work
3765    * tmap_method - typemap method name
3766    * type - typemap type to lookup
3767    * warning - warning number to issue if no typemaps found
3768    * typemap_attributes - the typemap attributes are attached to this node and will
3769    *   also be used for temporary storage if non null
3770    * return is never NULL, unlike Swig_typemap_lookup()
3771    * ----------------------------------------------------------------------------- */
3772 
typemapLookup(Node * n,const_String_or_char_ptr tmap_method,SwigType * type,int warning,Node * typemap_attributes=0)3773   const String *typemapLookup(Node *n, const_String_or_char_ptr tmap_method, SwigType *type, int warning, Node *typemap_attributes = 0) {
3774     Node *node = !typemap_attributes ? NewHash() : typemap_attributes;
3775     Setattr(node, "type", type);
3776     Setfile(node, Getfile(n));
3777     Setline(node, Getline(n));
3778     const String *tm = Swig_typemap_lookup(tmap_method, node, "", 0);
3779     if (!tm) {
3780       tm = empty_string;
3781       if (warning != WARN_NONE)
3782 	Swig_warning(warning, Getfile(n), Getline(n), "No %s typemap defined for %s\n", tmap_method, SwigType_str(type, 0));
3783     }
3784     if (!typemap_attributes)
3785       Delete(node);
3786     return tm;
3787   }
3788 
3789   /* -----------------------------------------------------------------------------
3790    * addThrows()
3791    *
3792    * Add all exceptions to a hash that are associated with the 'typemap'.
3793    * Return number the number of these exceptions.
3794    * ----------------------------------------------------------------------------- */
3795 
addThrows(Hash * throws_hash,const String * typemap,Node * parameter)3796   int addThrows(Hash *throws_hash, const String *typemap, Node *parameter) {
3797     // Get the comma separated throws clause - held in "throws" attribute in the typemap passed in
3798     int len = 0;
3799     String *throws_attribute = NewStringf("%s:throws", typemap);
3800 
3801     addImports(m3wrap_intf.import, throws_attribute, parameter);
3802     addImports(m3wrap_impl.import, throws_attribute, parameter);
3803 
3804     String *throws = getMappedTypeNew(parameter, Char(throws_attribute), "", false);
3805     //printf("got exceptions %s for %s\n", Char(throws), Char(throws_attribute));
3806 
3807     if (throws) {
3808       // Put the exception classes in the throws clause into a temporary List
3809       List *temp_classes_list = Split(throws, ',', INT_MAX);
3810       len = Len(temp_classes_list);
3811 
3812       // Add the exception classes to the node throws list, but don't duplicate if already in list
3813       if (temp_classes_list /*&& hasContent(temp_classes_list) */ ) {
3814 	for (Iterator cls = First(temp_classes_list); cls.item != NIL; cls = Next(cls)) {
3815 	  String *exception_class = NewString(cls.item);
3816 	  Replaceall(exception_class, " ", "");	// remove spaces
3817 	  Replaceall(exception_class, "\t", "");	// remove tabs
3818 	  if (hasContent(exception_class)) {
3819 	    // $m3classname substitution
3820 	    SwigType *pt = Getattr(parameter, "type");
3821 	    substituteClassname(pt, exception_class);
3822 	    // Don't duplicate the exception class in the throws clause
3823 	    //printf("add exception %s\n", Char(exception_class));
3824 	    Setattr(throws_hash, exception_class, "1");
3825 	  }
3826 	  Delete(exception_class);
3827 	}
3828       }
3829       Delete(temp_classes_list);
3830     }
3831     Delete(throws_attribute);
3832     return len;
3833   }
3834 
3835   /* -----------------------------------------------------------------------------
3836    * generateThrowsClause()
3837    * ----------------------------------------------------------------------------- */
3838 
generateThrowsClause(Hash * throws_hash,String * code)3839   void generateThrowsClause(Hash *throws_hash, String *code) {
3840     // Add the throws clause into code
3841     if (Len(throws_hash) > 0) {
3842       Iterator cls = First(throws_hash);
3843       Printf(code, " RAISES {%s", cls.key);
3844       for (cls = Next(cls); cls.key != NIL; cls = Next(cls)) {
3845 	Printf(code, ", %s", cls.key);
3846       }
3847       Printf(code, "}");
3848     }
3849   }
3850 
3851   /* -----------------------------------------------------------------------------
3852    * addImports()
3853    *
3854    * Add all imports that are needed for contents of 'typemap'.
3855    * ----------------------------------------------------------------------------- */
3856 
addImports(Hash * imports_hash,const String * typemap,Node * node)3857   void addImports(Hash *imports_hash, const String *typemap, Node *node) {
3858     // Get the comma separated throws clause - held in "throws" attribute in the typemap passed in
3859     String *imports_attribute = NewStringf("%s:import", typemap);
3860     String *imports = getMappedTypeNew(node, Char(imports_attribute), "", false);
3861     //printf("got imports %s for %s\n", Char(imports), Char(imports_attribute));
3862 
3863     if (imports != NIL) {
3864       List *import_list = Split(imports, ',', INT_MAX);
3865 
3866       // Add the exception classes to the node imports list, but don't duplicate if already in list
3867       if (import_list != NIL) {
3868 	for (Iterator imp = First(import_list); imp.item != NIL; imp = Next(imp)) {
3869 	  List *import_pair = Split(imp.item, ' ', 3);
3870 	  if (Len(import_pair) == 1) {
3871 	    Setattr(imports_hash, Getitem(import_pair, 0), "");
3872 	  } else if ((Len(import_pair) == 3)
3873 		     && Strcmp(Getitem(import_pair, 1), "AS") == 0) {
3874 	    Setattr(imports_hash, Getitem(import_pair, 0), Getitem(import_pair, 2));
3875 	  } else {
3876 	    Swig_warning(WARN_MODULA3_BAD_IMPORT, input_file, line_number,
3877 			 "Malformed import '%s' for typemap '%s' defined for type '%s'\n", imp, typemap, SwigType_str(Getattr(node, "type"), 0));
3878 	  }
3879 	  Delete(import_pair);
3880 	}
3881       }
3882       Delete(import_list);
3883     }
3884     Delete(imports_attribute);
3885   }
3886 
3887   /* -----------------------------------------------------------------------------
3888    * emitImportStatements()
3889    * ----------------------------------------------------------------------------- */
3890 
emitImportStatements(Hash * imports_hash,String * code)3891   void emitImportStatements(Hash *imports_hash, String *code) {
3892     // Add the imports statements into code
3893     Iterator imp = First(imports_hash);
3894     while (imp.key != NIL) {
3895       Printf(code, "IMPORT %s", imp.key);
3896       String *imp_as = imp.item;
3897       if (hasContent(imp_as)) {
3898 	Printf(code, " AS %s", imp_as);
3899       }
3900       Printf(code, ";\n");
3901       imp = Next(imp);
3902     }
3903   }
3904 
3905 };				/* class MODULA3 */
3906 
3907 /* -----------------------------------------------------------------------------
3908  * swig_modula3()    - Instantiate module
3909  * ----------------------------------------------------------------------------- */
3910 
swig_modula3(void)3911 extern "C" Language *swig_modula3(void) {
3912   return new MODULA3();
3913 }
3914 
3915 /* -----------------------------------------------------------------------------
3916  * Static member variables
3917  * ----------------------------------------------------------------------------- */
3918 
3919 const char *MODULA3::usage = "\
3920 Modula 3 Options (available with -modula3)\n\
3921      -generateconst <file>   - Generate code for computing numeric values of constants\n\
3922      -generaterename <file>  - Generate suggestions for %rename\n\
3923      -generatetypemap <file> - Generate templates for some basic typemaps\n\
3924      -oldvarnames            - Old intermediary method names for variable wrappers\n\
3925 \n";
3926 
3927 /*
3928      -generateconst <file> - stem of the .c source file for computing the numeric values of constants\n\
3929      -generaterename <file> - stem of the .i source file containing %rename suggestions\n\
3930      -generatetypemap <file> - stem of the .i source file containing typemap patterns\n\
3931 */
3932