Source/Modules/modula3.cxx

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