summaryrefslogtreecommitdiff
path: root/compiler/jvm/pjvm.pas
blob: fdae6615bb3b623ed8893b9197524e57ffc06a94 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
{
    Copyright (c) 2011 by Jonas Maebe

    This unit implements some JVM parser helper routines.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************
}

{$i fpcdefs.inc}

unit pjvm;

interface

    uses
      globtype,
      symconst,symtype,symbase,symdef,symsym;

    { records are emulated via Java classes. They require a default constructor
      to initialise temps, a deep copy helper for assignments, and clone()
      to initialse dynamic arrays }
    procedure add_java_default_record_methods_intf(def: trecorddef);

    procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef);
    procedure jvm_create_procvar_class(const name: TIDString; def: tdef);

    procedure jvm_wrap_virtual_class_methods(obj: tobjectdef);

    function jvm_add_typed_const_initializer(csym: tconstsym): tstaticvarsym;

    function jvm_wrap_method_with_vis(pd: tprocdef; vis: tvisibility): tprocdef;


implementation

  uses
    cutils,cclasses,
    verbose,globals,systems,
    fmodule,
    parabase,aasmdata,
    ngenutil,pparautl,
    symtable,symcreat,defcmp,jvmdef,symcpu,nobj,
    defutil,paramgr;


    procedure add_java_default_record_methods_intf(def: trecorddef);
      var
        sstate: tscannerstate;
        pd: tprocdef;
        sym: tsym;
        i: longint;
      begin
        maybe_add_public_default_java_constructor(def);
        replace_scanner('record_jvm_helpers',sstate);
        { no override, because not supported in records. Only required in case
          some of the fields require deep copies (otherwise the default
          shallow clone is fine) }
        for i:=0 to def.symtable.symlist.count-1 do
          begin
            sym:=tsym(def.symtable.symlist[i]);
            if (sym.typ=fieldvarsym) and
               jvmimplicitpointertype(tfieldvarsym(sym).vardef) then
              begin
                if str_parse_method_dec('function clone: JLObject;',potype_function,false,def,pd) then
                  pd.synthetickind:=tsk_jvm_clone
                else
                  internalerror(2011032806);
                break;
              end;
          end;
        { can't use def.typesym, not yet set at this point }
        if not assigned(def.symtable.realname) then
          internalerror(2011032803);
        if str_parse_method_dec('procedure fpcDeepCopy(result: FpcBaseRecordType);',potype_procedure,false,def,pd) then
          begin
            pd.synthetickind:=tsk_record_deepcopy;
            { can't add to the declaration since record methods can't override;
              it is in fact an overriding method, because all records inherit
              from a Java base class }
            include(pd.procoptions,po_overridingmethod);
          end
        else
          internalerror(2011032807);
        if def.needs_inittable then
          begin
            { 'var' instead of 'out' parameter, because 'out' would trigger
               calling the initialize method recursively }
            if str_parse_method_dec('procedure fpcInitializeRec;',potype_procedure,false,def,pd) then
              pd.synthetickind:=tsk_record_initialize
            else
              internalerror(2011071711);
          end;
        restore_scanner(sstate);
      end;


    procedure setup_for_new_class(const scannername: string; out sstate: tscannerstate; out islocal: boolean; out oldsymtablestack: TSymtablestack);
      begin
        replace_scanner(scannername,sstate);
        oldsymtablestack:=symtablestack;
        islocal:=symtablestack.top.symtablelevel>=normal_function_level;
        if islocal then
          begin
            { we cannot add a class local to a procedure -> insert it in the
              static symtable. This is not ideal because this means that it will
              be saved to the ppu file for no good reason, and loaded again
              even though it contains a reference to a type that was never
              saved to the ppu file (the locally defined enum type). Since this
              alias for the locally defined enumtype is only used while
              implementing the class' methods, this is however no problem. }
            symtablestack:=symtablestack.getcopyuntil(current_module.localsymtable);
          end;
      end;


    procedure restore_after_new_class(const sstate: tscannerstate; const islocal: boolean; const oldsymtablestack: TSymtablestack);
      begin
        if islocal then
          begin
            symtablestack.free;
            symtablestack:=oldsymtablestack;
          end;
        restore_scanner(sstate);
      end;


    procedure jvm_maybe_create_enum_class(const name: TIDString; def: tdef);
      var
        arrdef: tarraydef;
        arrsym: ttypesym;
        juhashmap: tdef;
        enumclass: tobjectdef;
        pd: tprocdef;
        old_current_structdef: tabstractrecorddef;
        i: longint;
        sym,
        aliassym: tstaticvarsym;
        fsym: tfieldvarsym;
        sstate: tscannerstate;
        sl: tpropaccesslist;
        temptypesym: ttypesym;
        oldsymtablestack: tsymtablestack;
        islocal: boolean;
      begin
        { if it's a subrange type, don't create a new class }
        if assigned(tenumdef(def).basedef) then
          exit;

        setup_for_new_class('jvm_enum_class',sstate,islocal,oldsymtablestack);

        { create new class (different internal name than enum to prevent name
          clash; at unit level because we don't want its methods to be nested
          inside a function in case its a local type) }
        enumclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternEnum$'+def.unique_id_str,java_jlenum,true);
        tcpuenumdef(def).classdef:=enumclass;
        include(enumclass.objectoptions,oo_is_enum_class);
        include(enumclass.objectoptions,oo_is_sealed);
        { implement FpcEnumValueObtainable interface }
        enumclass.ImplementedInterfaces.add(TImplementedInterface.Create(tobjectdef(search_system_type('FPCENUMVALUEOBTAINABLE').typedef)));
        { create an alias for this type inside itself: this way we can choose a
          name that can be used in generated Pascal code without risking an
          identifier conflict (since it is local to this class; the global name
          is unique because it's an identifier that contains $-signs) }
        enumclass.symtable.insert(ctypesym.create('__FPC_TEnumClassAlias',enumclass));

        { also create an alias for the enum type so that we can iterate over
          all enum values when creating the body of the class constructor }
        temptypesym:=ctypesym.create('__FPC_TEnumAlias',nil);
        { don't pass def to the ttypesym constructor, because then it
          will replace the current (real) typesym of that def with the alias }
        temptypesym.typedef:=def;
        enumclass.symtable.insert(temptypesym);
        { but the name of the class as far as the JVM is concerned will match
          the enum's original name (the enum type itself won't be output in
          any class file, so no conflict there)

          name can be empty in case of declaration such as "set of (ea,eb)"  }
        if not islocal and
           (name <> '')  then
          enumclass.objextname:=stringdup(name)
        else
          { for local types, use a unique name to prevent conflicts (since such
            types are not visible outside the routine anyway, it doesn't matter
          }
          begin
            enumclass.objextname:=stringdup(enumclass.objrealname^);
            { also mark it as private (not strict private, because the class
              is not a subclass of the unit in which it is declared, so then
              the unit's procedures would not be able to use it) }
            enumclass.typesym.visibility:=vis_private;
          end;
        { now add a bunch of extra things to the enum class }
        old_current_structdef:=current_structdef;
        current_structdef:=enumclass;

        symtablestack.push(enumclass.symtable);
        { create static fields representing all enums }
        for i:=0 to tenumdef(def).symtable.symlist.count-1 do
          begin
            fsym:=cfieldvarsym.create(tenumsym(tenumdef(def).symtable.symlist[i]).realname,vs_final,enumclass,[]);
            enumclass.symtable.insert(fsym);
            sym:=make_field_static(enumclass.symtable,fsym);
            { add alias for the field representing ordinal(0), for use in
              initialization code }
            if tenumsym(tenumdef(def).symtable.symlist[i]).value=0 then
              begin
                aliassym:=cstaticvarsym.create('__FPC_Zero_Initializer',vs_final,enumclass,[vo_is_external]);
                enumclass.symtable.insert(aliassym);
                aliassym.set_raw_mangledname(sym.mangledname);
              end;
          end;
        { create local "array of enumtype" type for the "values" functionality
          (used internally by the JDK) }
        arrdef:=carraydef.create(0,tenumdef(def).symtable.symlist.count-1,s32inttype);
        arrdef.elementdef:=enumclass;
        arrsym:=ctypesym.create('__FPC_TEnumValues',arrdef);
        enumclass.symtable.insert(arrsym);
        { insert "public static values: array of enumclass" that returns $VALUES.clone()
          (rather than a dynamic array and using clone --which we don't support yet for arrays--
           simply use a fixed length array and copy it) }
        if not str_parse_method_dec('function values: __FPC_TEnumValues;static;',potype_function,true,enumclass,pd) then
          internalerror(2011062301);
        include(pd.procoptions,po_staticmethod);
        pd.synthetickind:=tsk_jvm_enum_values;
        { do we have to store the ordinal value separately? (if no jumps, we can
          just call the default ordinal() java.lang.Enum function) }
        if tenumdef(def).has_jumps then
          begin
            { add field for the value }
            fsym:=cfieldvarsym.create('__fpc_fenumval',vs_final,s32inttype,[]);
            enumclass.symtable.insert(fsym);
            tobjectsymtable(enumclass.symtable).addfield(fsym,vis_strictprivate);
            { add class field with hash table that maps from FPC-declared ordinal value -> enum instance }
            juhashmap:=search_system_type('JUHASHMAP').typedef;
            fsym:=cfieldvarsym.create('__fpc_ord2enum',vs_final,juhashmap,[]);
            enumclass.symtable.insert(fsym);
            make_field_static(enumclass.symtable,fsym);
            { add custom constructor }
            if not str_parse_method_dec('constructor Create(const __fpc_name: JLString; const __fpc_ord, __fpc_initenumval: longint);',potype_constructor,false,enumclass,pd) then
              internalerror(2011062401);
            pd.synthetickind:=tsk_jvm_enum_jumps_constr;
            pd.visibility:=vis_strictprivate;
          end
        else
          begin
            { insert "private constructor(string,int,int)" that calls inherited and
              initialises the FPC value field }
            add_missing_parent_constructors_intf(enumclass,false,vis_strictprivate);
          end;
        { add instance method to get the enum's value as declared in FPC }
        if not str_parse_method_dec('function FPCOrdinal: longint;',potype_function,false,enumclass,pd) then
          internalerror(2011062402);
        pd.synthetickind:=tsk_jvm_enum_fpcordinal;
        { add static class method to convert an ordinal to the corresponding enum }
        if not str_parse_method_dec('function FPCValueOf(__fpc_int: longint): __FPC_TEnumClassAlias; static;',potype_function,true,enumclass,pd) then
          internalerror(2011062403);
        pd.synthetickind:=tsk_jvm_enum_fpcvalueof;
        { similar (instance) function for use in set factories; implements FpcEnumValueObtainable interface }
        if not str_parse_method_dec('function fpcGenericValueOf(__fpc_int: longint): JLEnum;',potype_function,false,enumclass,pd) then
          internalerror(2011062404);
        pd.synthetickind:=tsk_jvm_enum_fpcvalueof;

        { insert "public static valueOf(string): tenumclass" that returns tenumclass(inherited valueOf(tenumclass,string)) }
        if not str_parse_method_dec('function valueOf(const __fpc_str: JLString): __FPC_TEnumClassAlias; static;',potype_function,true,enumclass,pd) then
          internalerror(2011062302);
        include(pd.procoptions,po_staticmethod);
        pd.synthetickind:=tsk_jvm_enum_valueof;

        { add instance method to convert an ordinal and an array into a set of
          (we always need/can use both in case of subrange types and/or array
           -> set type casts) }
        if not str_parse_method_dec('function fpcLongToEnumSet(__val: jlong; __setbase, __setsize: jint): JUEnumSet;',potype_function,true,enumclass,pd) then
          internalerror(2011070501);
        pd.synthetickind:=tsk_jvm_enum_long2set;

        if not str_parse_method_dec('function fpcBitSetToEnumSet(const __val: FpcBitSet; __fromsetbase, __tosetbase: jint): JUEnumSet; static;',potype_function,true,enumclass,pd) then
          internalerror(2011071004);
        pd.synthetickind:=tsk_jvm_enum_bitset2set;

        if not str_parse_method_dec('function fpcEnumSetToEnumSet(const __val: JUEnumSet; __fromsetbase, __tosetbase: jint): JUEnumSet; static;',potype_function,true,enumclass,pd) then
          internalerror(2011071005);
        pd.synthetickind:=tsk_jvm_enum_set2set;

        { create array called "$VALUES" that will contain a reference to all
          enum instances (JDK convention)
          Disable duplicate identifier checking when inserting, because it will
          check for a conflict with "VALUES" ($<id> normally means "check for
          <id> without uppercasing first"), which will conflict with the
          "Values" instance method -- that's also the reason why we insert the
          field only now, because we cannot disable duplicate identifier
          checking when creating the "Values" method }
        fsym:=cfieldvarsym.create('$VALUES',vs_final,arrdef,[]);
        fsym.visibility:=vis_strictprivate;
        enumclass.symtable.insert(fsym,false);
        sym:=make_field_static(enumclass.symtable,fsym);
        { alias for accessing the field in generated Pascal code }
        sl:=tpropaccesslist.create;
        sl.addsym(sl_load,sym);
        enumclass.symtable.insert(cabsolutevarsym.create_ref('__fpc_FVALUES',arrdef,sl));
        { add initialization of the static class fields created above }
        if not str_parse_method_dec('constructor fpc_enum_class_constructor;',potype_class_constructor,true,enumclass,pd) then
          internalerror(2011062303);
        pd.synthetickind:=tsk_jvm_enum_classconstr;

        symtablestack.pop(enumclass.symtable);

        build_vmt(enumclass);

        restore_after_new_class(sstate,islocal,oldsymtablestack);
        current_structdef:=old_current_structdef;
      end;


    procedure jvm_create_procvar_class_intern(const name: TIDString; def: tdef; force_no_callback_intf: boolean);
      var
        oldsymtablestack: tsymtablestack;
        pvclass,
        pvintf: tobjectdef;
        temptypesym: ttypesym;
        sstate: tscannerstate;
        methoddef: tprocdef;
        old_current_structdef: tabstractrecorddef;
        islocal: boolean;
      begin
        { inlined definition of procvar -> generate name, derive from
          FpcBaseNestedProcVarType, pass nestedfpstruct to constructor and
          copy it }
        if name='' then
          begin
            if is_nested_pd(tabstractprocdef(def)) then
              internalerror(2011071901);
          end;

        setup_for_new_class('jvm_pvar_class',sstate,islocal,oldsymtablestack);

        { create new class (different internal name than pvar to prevent name
          clash; at unit level because we don't want its methods to be nested
          inside a function in case its a local type) }
        pvclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternProcvar$'+def.unique_id_str,java_procvarbase,true);
        tcpuprocvardef(def).classdef:=pvclass;
        include(pvclass.objectoptions,oo_is_sealed);
        if df_generic in def.defoptions then
          include(pvclass.defoptions,df_generic);
        { associate typesym }
        pvclass.symtable.insert(ctypesym.create('__FPC_TProcVarClassAlias',pvclass));
        { set external name to match procvar type name }
        if not islocal then
          pvclass.objextname:=stringdup(name)
        else
          pvclass.objextname:=stringdup(pvclass.objrealname^);

        symtablestack.push(pvclass.symtable);

        { inherit constructor and keep public }
        add_missing_parent_constructors_intf(pvclass,true,vis_public);

        { add a method to call the procvar using unwrapped arguments, which
          then wraps them and calls through to JLRMethod.invoke }
        methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
        finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
        methoddef.synthetickind:=tsk_jvm_procvar_invoke;
        methoddef.calcparas;

        { add local alias for the procvartype that we can use when implementing
          the invoke method }
        temptypesym:=ctypesym.create('__FPC_ProcVarAlias',nil);
        { don't pass def to the ttypesym constructor, because then it
          will replace the current (real) typesym of that def with the alias }
        temptypesym.typedef:=def;
        pvclass.symtable.insert(temptypesym);

        { in case of a procedure of object, add a nested interface type that
          has one method that conforms to the procvartype (with name
          procvartypename+'Callback') and an extra constructor that takes
          an instance conforming to this interface and which sets up the
          procvar by taking the address of its Callback method (convenient to
          use from Java code) }
        if (po_methodpointer in tprocvardef(def).procoptions) and
           not islocal and
           not force_no_callback_intf then
          begin
            pvintf:=cobjectdef.create(odt_interfacejava,'Callback',nil,true);
            pvintf.objextname:=stringdup('Callback');
            if df_generic in def.defoptions then
              include(pvintf.defoptions,df_generic);
            { associate typesym }
            pvclass.symtable.insert(ctypesym.create('Callback',pvintf));

            { add a method prototype matching the procvar (like the invoke
              in the procvarclass itself) }
            symtablestack.push(pvintf.symtable);
            methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
            finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
            { can't be final/static/private/protected, and must be virtual
              since it's an interface method }
            methoddef.procoptions:=methoddef.procoptions-[po_staticmethod,po_finalmethod];
            include(methoddef.procoptions,po_virtualmethod);
            methoddef.visibility:=vis_public;
            symtablestack.pop(pvintf.symtable);

            { add an extra constructor to the procvarclass that takes an
              instance of this interface as parameter }
            old_current_structdef:=current_structdef;
            current_structdef:=pvclass;
            if not str_parse_method_dec('constructor Create(__intf:'+pvintf.objextname^+');overload;',potype_constructor,false,pvclass,methoddef) then
              internalerror(2011092402);
            methoddef.synthetickind:=tsk_jvm_procvar_intconstr;
            methoddef.skpara:=def;
            current_structdef:=old_current_structdef;
          end;

        symtablestack.pop(pvclass.symtable);

        build_vmt(pvclass);

        restore_after_new_class(sstate,islocal,oldsymtablestack);
      end;


    procedure jvm_create_procvar_class(const name: TIDString; def: tdef);
      begin
        jvm_create_procvar_class_intern(name,def,false);
      end;


    procedure jvm_wrap_virtual_class_method(pd: tprocdef);
      var
        wrapperpd: tprocdef;
        wrapperpv: tcpuprocvardef;
        typ: ttypesym;
        wrappername: shortstring;
      begin
        if (po_external in pd.procoptions) or
           (oo_is_external in pd.struct.objectoptions) then
          exit;
        { the JVM does not support virtual class methods -> we generate
          wrappers with the original name so they can be called normally,
          and these wrappers will then perform a dynamic lookup. To enable
          calling the class method by its intended name from external Java code,
          we have to change its external name so that we give that original
          name to the wrapper function -> "switch" the external names around for
          the original and wrapper methods }

        { replace importname of original procdef }
        include(pd.procoptions,po_has_importname);
        if not assigned(pd.import_name) then
          wrappername:=pd.procsym.realname
        else
          wrappername:=pd.import_name^;
        stringdispose(pd.import_name);
        pd.import_name:=stringdup(wrappername+'__fpcvirtualclassmethod__');

        { wrapper is part of the same symtable as the original procdef }
        symtablestack.push(pd.owner);
        { get a copy of the virtual class method }
        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_normal_no_hidden,''));
        { this one is not virtual nor override }
        exclude(wrapperpd.procoptions,po_virtualmethod);
        exclude(wrapperpd.procoptions,po_overridingmethod);
        { import/external name = name of original class method }
        stringdispose(wrapperpd.import_name);
        wrapperpd.import_name:=stringdup(wrappername);
        include(wrapperpd.procoptions,po_has_importname);
        { associate with wrapper procsym (Pascal-level name = wrapper name ->
          in callnodes, we will have to replace the calls to virtual class
          methods with calls to the wrappers) }
        finish_copied_procdef(wrapperpd,pd.import_name^,pd.owner,tabstractrecorddef(pd.owner.defowner));

        { we only have to generate the dispatching routine for non-overriding
          methods; the overriding ones can use the original one, but generate
          a skeleton for that anyway because the overriding one may still
          change the visibility (but we can just call the inherited routine
          in that case) }
        if po_overridingmethod in pd.procoptions then
          begin
            { by default do not include this routine when looking for overloads }
            include(wrapperpd.procoptions,po_ignore_for_overload_resolution);
            wrapperpd.synthetickind:=tsk_anon_inherited;
            symtablestack.pop(pd.owner);
            exit;
          end;

        { implementation }
        wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
        wrapperpd.skpara:=pd;
        { also create procvar type that we can use in the implementation }
        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal_no_hidden,''));
        handle_calling_convention(wrapperpv,hcc_default_actions_intf);
        { no use in creating a callback wrapper here, this procvar type isn't
          for public consumption }
        jvm_create_procvar_class_intern('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv,true);
        { create alias for the procvar type so we can use it in generated
          Pascal code }
        typ:=ctypesym.create('__fpc_virtualclassmethod_pv_t'+wrapperpd.unique_id_str,wrapperpv);
        wrapperpv.classdef.typesym.visibility:=vis_strictprivate;
        symtablestack.top.insert(typ);
        symtablestack.pop(pd.owner);
      end;


    procedure jvm_wrap_virtual_constructor(pd: tprocdef);
      var
        wrapperpd: tprocdef;
      begin
        { to avoid having to implement procvar-like support for dynamically
          invoking constructors, call the constructors from virtual class
          methods and replace calls to the constructors with calls to the
          virtual class methods -> we can reuse lots of infrastructure }
        if (po_external in pd.procoptions) or
           (oo_is_external in pd.struct.objectoptions) then
          exit;
        { wrapper is part of the same symtable as the original procdef }
        symtablestack.push(pd.owner);
        { get a copy of the constructor }
        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc,''));
        { this one is a class method rather than a constructor }
        include(wrapperpd.procoptions,po_classmethod);
        wrapperpd.proctypeoption:=potype_function;
        wrapperpd.returndef:=tobjectdef(pd.owner.defowner);

        { import/external name = name of original constructor (since
          constructors don't have names in Java, this won't conflict with the
          original constructor definition) }
        stringdispose(wrapperpd.import_name);
        wrapperpd.import_name:=stringdup(pd.procsym.realname);
        { associate with wrapper procsym (Pascal-level name = wrapper name ->
          in callnodes, we will have to replace the calls to virtual
          constructors with calls to the wrappers) }
        finish_copied_procdef(wrapperpd,pd.procsym.realname+'__fpcvirtconstrwrapper__',pd.owner,tabstractrecorddef(pd.owner.defowner));
        { implementation: call through to the constructor
          Exception: if the current class is abstract, do not call the
            constructor, since abstract class cannot be constructed (and the
            Android verifier does not accept such code, even if it is
            unreachable) }
        wrapperpd.synthetickind:=tsk_callthrough_nonabstract;
        wrapperpd.skpara:=pd;
        symtablestack.pop(pd.owner);
        { and now wrap this generated virtual static method itself as well }
        jvm_wrap_virtual_class_method(wrapperpd);
      end;


    procedure jvm_wrap_virtual_class_methods(obj: tobjectdef);
      var
        i: longint;
        def: tdef;
      begin
        { new methods will be inserted while we do this, but since
          symtable.deflist.count is evaluated at the start of the loop that
          doesn't matter }
        for i:=0 to obj.symtable.deflist.count-1 do
          begin
            def:=tdef(obj.symtable.deflist[i]);
            if def.typ<>procdef then
              continue;
            if [po_classmethod,po_virtualmethod]<=tprocdef(def).procoptions then
              jvm_wrap_virtual_class_method(tprocdef(def))
            else if (tprocdef(def).proctypeoption=potype_constructor) and
               (po_virtualmethod in tprocdef(def).procoptions) then
              jvm_wrap_virtual_constructor(tprocdef(def));
          end;
      end;


    function jvm_add_typed_const_initializer(csym: tconstsym): tstaticvarsym;
      var
        ssym: tstaticvarsym;
        esym: tenumsym;
        i: longint;
        sstate: tscannerstate;
        elemdef: tdef;
        elemdefname,
        conststr: ansistring;
        first: boolean;
      begin
        result:=nil;
        esym:=nil;
        case csym.constdef.typ of
          enumdef:
            begin
              { make sure we don't emit a definition for this field (we'll do
                that for the constsym already) -> mark as external }
              ssym:=cstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,csym.constdef,[vo_is_external]);
              csym.owner.insert(ssym);
              { alias storage to the constsym }
              ssym.set_mangledname(csym.realname);
              for i:=0 to tenumdef(csym.constdef).symtable.symlist.count-1 do
                begin
                  esym:=tenumsym(tenumdef(csym.constdef).symtable.symlist[i]);
                  if esym.value=csym.value.valueord.svalue then
                    break;
                  esym:=nil;
                end;
              { can happen in case of explicit typecast from integer constant
                to enum type }
              if not assigned(esym) then
                begin
                  MessagePos(csym.fileinfo,parser_e_range_check_error);
                  exit;
                end;
              replace_scanner('jvm_enum_const',sstate);
              str_parse_typedconst(current_asmdata.asmlists[al_typedconsts],esym.name+';',ssym);
              restore_scanner(sstate);
              result:=ssym;
            end;
          setdef:
            begin
              replace_scanner('jvm_set_const',sstate);
              { make sure we don't emit a definition for this field (we'll do
                that for the constsym already) -> mark as external;
                on the other hand, we don't create instances for constsyms in
                (or external syms) the program/unit initialization code -> add
                vo_has_local_copy to indicate that this should be done after all
                (in thlcgjvm.allocate_implicit_structs_for_st_with_base_ref) }

              { the constant can be defined in the body of a function and its
                def can also belong to that -> will be freed when the function
                has been compiler -> insert a copy in the unit's staticsymtable
              }
              symtablestack.push(current_module.localsymtable);
              ssym:=cstaticvarsym.create(internal_static_field_name(csym.realname),vs_final,tsetdef(csym.constdef).getcopy,[vo_is_external,vo_has_local_copy]);
              symtablestack.top.insert(ssym);
              symtablestack.pop(current_module.localsymtable);
              { alias storage to the constsym }
              ssym.set_mangledname(csym.realname);
              { ensure that we allocate space for global symbols (won't actually
                allocate space for this one, since it's external, but for the
                constsym) }
              cnodeutils.insertbssdata(ssym);
              elemdef:=tsetdef(csym.constdef).elementdef;
              if not assigned(elemdef) then
                begin
                  internalerror(2011070502);
                end
              else
                begin
                  elemdefname:=elemdef.typename;
                  conststr:='[';
                  first:=true;
                  for i:=0 to 255 do
                    if i in pnormalset(csym.value.valueptr)^ then
                      begin
                        if not first then
                          conststr:=conststr+',';
                        first:=false;
                        { instead of looking up all enum value names/boolean
                           names, type cast integers to the required type }
                        conststr:=conststr+elemdefname+'('+tostr(i)+')';
                      end;
                  conststr:=conststr+'];';
                end;
              str_parse_typedconst(current_asmdata.asmlists[al_typedconsts],conststr,ssym);
              restore_scanner(sstate);
              result:=ssym;
            end;
          else
            internalerror(2011062701);
        end;
      end;


    function jvm_wrap_method_with_vis(pd: tprocdef; vis: tvisibility): tprocdef;
      var
        obj: tabstractrecorddef;
        visname: string;
      begin
        obj:=current_structdef;
        { if someone gets the idea to add a property to an external class
          definition, don't try to wrap it since we cannot add methods to
          external classes }
        if oo_is_external in obj.objectoptions then
          begin
            result:=pd;
            exit
          end;
        symtablestack.push(obj.symtable);
        result:=tprocdef(pd.getcopy);
        result.visibility:=vis;
        visname:=visibilityName[vis];
        replace(visname,' ','_');
        { create a name that is unique amongst all units (start with '$unitname$$') and
          unique in this unit (result.unique_id_str) }
        finish_copied_procdef(result,'$'+current_module.realmodulename^+'$$'+result.unique_id_str+pd.procsym.realname+'$'+visname,obj.symtable,obj);
        { in case the referred method is from an external class }
        exclude(result.procoptions,po_external);
        { not virtual/override/abstract/... }
        result.procoptions:=result.procoptions*[po_classmethod,po_staticmethod,po_varargs,po_public];
        result.synthetickind:=tsk_callthrough;
        { so we know the name of the routine to call through to }
        result.skpara:=pd;
        symtablestack.pop(obj.symtable);
      end;


end.