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