~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to compiler/pdecsub.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
{
2
 
    $Id: pdecsub.pas,v 1.180 2004/05/23 20:54:39 peter Exp $
3
 
    Copyright (c) 1998-2002 by Florian Klaempfl, Daniel Mantione
4
 
 
5
 
    Does the parsing of the procedures/functions
6
 
 
7
 
    This program is free software; you can redistribute it and/or modify
8
 
    it under the terms of the GNU General Public License as published by
9
 
    the Free Software Foundation; either version 2 of the License, or
10
 
    (at your option) any later version.
11
 
 
12
 
    This program is distributed in the hope that it will be useful,
13
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
14
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15
 
    GNU General Public License for more details.
16
 
 
17
 
    You should have received a copy of the GNU General Public License
18
 
    along with this program; if not, write to the Free Software
19
 
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
 
 
21
 
 ****************************************************************************
22
 
}
23
 
unit pdecsub;
24
 
 
25
 
{$i fpcdefs.inc}
26
 
 
27
 
interface
28
 
 
29
 
    uses
30
 
      tokens,symconst,symtype,symdef,symsym;
31
 
 
32
 
    type
33
 
      tpdflag=(
34
 
        pd_body,       { directive needs a body }
35
 
        pd_implemen,   { directive can be used implementation section }
36
 
        pd_interface,  { directive can be used interface section }
37
 
        pd_object,     { directive can be used object declaration }
38
 
        pd_procvar,    { directive can be used procvar declaration }
39
 
        pd_notobject,  { directive can not be used object declaration }
40
 
        pd_notobjintf, { directive can not be used interface declaration }
41
 
        pd_notprocvar  { directive can not be used procvar declaration }
42
 
      );
43
 
      tpdflags=set of tpdflag;
44
 
 
45
 
    function is_proc_directive(tok:ttoken;isprocvar:boolean):boolean;
46
 
 
47
 
    procedure calc_parast(pd:tabstractprocdef);
48
 
 
49
 
    procedure insert_funcret_local(pd:tprocdef);
50
 
 
51
 
    function  proc_add_definition(var pd:tprocdef):boolean;
52
 
 
53
 
    procedure handle_calling_convention(pd:tabstractprocdef);
54
 
 
55
 
    procedure parse_parameter_dec(pd:tabstractprocdef);
56
 
    procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
57
 
    procedure parse_var_proc_directives(sym:tsym);
58
 
    procedure parse_object_proc_directives(pd:tabstractprocdef);
59
 
    function  parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
60
 
    function  parse_proc_dec(aclass:tobjectdef):tprocdef;
61
 
 
62
 
implementation
63
 
 
64
 
    uses
65
 
{$ifdef delphi}
66
 
       sysutils,
67
 
{$else delphi}
68
 
       strings,
69
 
{$endif delphi}
70
 
       { common }
71
 
       cutils,cclasses,
72
 
       { global }
73
 
       globtype,globals,verbose,
74
 
       systems,
75
 
       cpuinfo,
76
 
       { aasm }
77
 
       aasmbase,
78
 
       { symtable }
79
 
       symbase,symtable,defutil,defcmp,paramgr,
80
 
       { pass 1 }
81
 
       node,htypechk,
82
 
       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
83
 
       { parser }
84
 
       fmodule,scanner,
85
 
       pbase,pexpr,ptype,pdecl,
86
 
       { linking }
87
 
       import,gendef
88
 
       ;
89
 
 
90
 
    const
91
 
      { Please leave this here, this module should NOT use
92
 
        these variables.
93
 
        Declaring it as string here results in an error when compiling (PFV) }
94
 
      current_procinfo = 'error';
95
 
 
96
 
 
97
 
    procedure insert_funcret_para(pd:tabstractprocdef);
98
 
      var
99
 
        storepos : tfileposinfo;
100
 
        vs       : tvarsym;
101
 
      begin
102
 
        if not is_void(pd.rettype.def) and
103
 
           paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
104
 
         begin
105
 
           storepos:=akttokenpos;
106
 
           if pd.deftype=procdef then
107
 
            akttokenpos:=tprocdef(pd).fileinfo;
108
 
 
109
 
           { Generate result variable accessing function result }
110
 
           vs:=tvarsym.create('$result',vs_var,pd.rettype);
111
 
           include(vs.varoptions,vo_is_funcret);
112
 
           include(vs.varoptions,vo_regable);
113
 
           pd.parast.insert(vs);
114
 
           { For left to right add it at the end to be delphi compatible }
115
 
           if pd.proccalloption in pushleftright_pocalls then
116
 
             pd.concatpara(nil,vs.vartype,vs,nil,true)
117
 
           else
118
 
             pd.insertpara(vs.vartype,vs,nil,true);
119
 
           { Store the this symbol as funcretsym for procedures }
120
 
           if pd.deftype=procdef then
121
 
            tprocdef(pd).funcretsym:=vs;
122
 
 
123
 
           akttokenpos:=storepos;
124
 
         end;
125
 
      end;
126
 
 
127
 
 
128
 
    procedure insert_parentfp_para(pd:tabstractprocdef);
129
 
      var
130
 
        storepos : tfileposinfo;
131
 
        vs       : tvarsym;
132
 
      begin
133
 
        if pd.parast.symtablelevel>normal_function_level then
134
 
          begin
135
 
            storepos:=akttokenpos;
136
 
            if pd.deftype=procdef then
137
 
             akttokenpos:=tprocdef(pd).fileinfo;
138
 
 
139
 
            { Generate result variable accessing function result }
140
 
            vs:=tvarsym.create('$parentfp',vs_var,voidpointertype);
141
 
            include(vs.varoptions,vo_is_parentfp);
142
 
            pd.parast.insert(vs);
143
 
            pd.insertpara(vs.vartype,vs,nil,true);
144
 
 
145
 
            akttokenpos:=storepos;
146
 
          end;
147
 
      end;
148
 
 
149
 
 
150
 
    procedure insert_self_and_vmt_para(pd:tabstractprocdef);
151
 
      var
152
 
        storepos : tfileposinfo;
153
 
        vs       : tvarsym;
154
 
        tt       : ttype;
155
 
        vsp      : tvarspez;
156
 
      begin
157
 
        if (pd.deftype=procvardef) and
158
 
           pd.is_methodpointer then
159
 
          begin
160
 
            { Generate self variable }
161
 
            tt:=voidpointertype;
162
 
            vs:=tvarsym.create('$self',vs_value,tt);
163
 
            include(vs.varoptions,vo_is_self);
164
 
            { Insert as hidden parameter }
165
 
            pd.parast.insert(vs);
166
 
            pd.insertpara(vs.vartype,vs,nil,true);
167
 
          end
168
 
        else
169
 
          begin
170
 
             if (pd.deftype=procdef) and
171
 
                assigned(tprocdef(pd)._class) and
172
 
                (pd.parast.symtablelevel=normal_function_level) then
173
 
              begin
174
 
                storepos:=akttokenpos;
175
 
                akttokenpos:=tprocdef(pd).fileinfo;
176
 
 
177
 
                { Generate VMT variable for constructor/destructor }
178
 
                if pd.proctypeoption in [potype_constructor,potype_destructor] then
179
 
                 begin
180
 
                   { can't use classrefdef as type because inheriting
181
 
                     will then always file because of a type mismatch }
182
 
                   tt:=voidpointertype;
183
 
                   vs:=tvarsym.create('$vmt',vs_value,tt);
184
 
                   include(vs.varoptions,vo_is_vmt);
185
 
                   { Insert as hidden parameter }
186
 
                   pd.parast.insert(vs);
187
 
                   pd.insertpara(vs.vartype,vs,nil,true);
188
 
                 end;
189
 
 
190
 
                { Generate self variable, for classes we need
191
 
                  to use the generic voidpointer to be compatible with
192
 
                  methodpointers }
193
 
                vsp:=vs_value;
194
 
                if (po_staticmethod in pd.procoptions) or
195
 
                   (po_classmethod in pd.procoptions) then
196
 
                  begin
197
 
                    tt.setdef(tprocdef(pd)._class);
198
 
                    tt.setdef(tclassrefdef.create(tt));
199
 
                  end
200
 
                else
201
 
                  begin
202
 
                    if is_object(tprocdef(pd)._class) then
203
 
                      vsp:=vs_var;
204
 
                    tt.setdef(tprocdef(pd)._class);
205
 
                  end;
206
 
                vs:=tvarsym.create('$self',vsp,tt);
207
 
                include(vs.varoptions,vo_is_self);
208
 
                include(vs.varoptions,vo_regable);
209
 
                { Insert as hidden parameter }
210
 
                pd.parast.insert(vs);
211
 
                pd.insertpara(vs.vartype,vs,nil,true);
212
 
 
213
 
                akttokenpos:=storepos;
214
 
              end;
215
 
          end;
216
 
      end;
217
 
 
218
 
 
219
 
    procedure insert_funcret_local(pd:tprocdef);
220
 
      var
221
 
        storepos : tfileposinfo;
222
 
        vs       : tvarsym;
223
 
        sl       : tsymlist;
224
 
      begin
225
 
        if not is_void(pd.rettype.def) then
226
 
         begin
227
 
           storepos:=akttokenpos;
228
 
           akttokenpos:=pd.fileinfo;
229
 
 
230
 
           { We always need a localsymtable }
231
 
           if not assigned(pd.localst) then
232
 
            pd.insert_localst;
233
 
 
234
 
           { We need to insert a varsym for the result in the localst
235
 
             when it is returning in a register }
236
 
           if not paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
237
 
            begin
238
 
              vs:=tvarsym.create('$result',vs_value,pd.rettype);
239
 
              include(vs.varoptions,vo_is_funcret);
240
 
              if tstoreddef(pd.rettype.def).is_intregable then
241
 
                include(vs.varoptions,vo_regable);
242
 
              if tstoreddef(pd.rettype.def).is_fpuregable then
243
 
                include(vs.varoptions,vo_fpuregable);
244
 
              pd.localst.insert(vs);
245
 
              pd.funcretsym:=vs;
246
 
            end;
247
 
 
248
 
           { insert the name of the procedure as alias for the function result,
249
 
             we can't use realname because that will not work for compilerprocs
250
 
             as the name is lowercase and unreachable from the code }
251
 
           if pd.resultname='' then
252
 
            pd.resultname:=pd.procsym.name;
253
 
           sl:=tsymlist.create;
254
 
           sl.addsym(sl_load,pd.funcretsym);
255
 
           vs:=tabsolutesym.create_ref(pd.resultname,pd.rettype,sl);
256
 
           include(vs.varoptions,vo_is_funcret);
257
 
           pd.localst.insert(vs);
258
 
 
259
 
           { insert result also if support is on }
260
 
           if (m_result in aktmodeswitches) then
261
 
            begin
262
 
              sl:=tsymlist.create;
263
 
              sl.addsym(sl_load,pd.funcretsym);
264
 
              vs:=tabsolutesym.create_ref('RESULT',pd.rettype,sl);
265
 
              include(vs.varoptions,vo_is_funcret);
266
 
              include(vs.varoptions,vo_is_result);
267
 
              pd.localst.insert(vs);
268
 
            end;
269
 
 
270
 
           akttokenpos:=storepos;
271
 
         end;
272
 
      end;
273
 
 
274
 
 
275
 
    procedure insert_hidden_para(pd:tabstractprocdef);
276
 
      var
277
 
        currpara : tparaitem;
278
 
        hvs : tvarsym;
279
 
      begin
280
 
        { walk from right to left, so we can insert the
281
 
          high parameters after the current parameter }
282
 
        currpara:=tparaitem(pd.para.last);
283
 
        while assigned(currpara) do
284
 
         begin
285
 
           { needs high parameter ? }
286
 
           if paramanager.push_high_param(currpara.paratyp,currpara.paratype.def,pd.proccalloption) then
287
 
            begin
288
 
              if assigned(currpara.parasym) then
289
 
               begin
290
 
                 hvs:=tvarsym.create('$high'+tvarsym(currpara.parasym).name,vs_const,s32inttype);
291
 
                 include(hvs.varoptions,vo_is_high_value);
292
 
                 tvarsym(currpara.parasym).owner.insert(hvs);
293
 
               end
294
 
              else
295
 
               hvs:=nil;
296
 
              pd.concatpara(currpara,s32inttype,hvs,nil,true);
297
 
            end
298
 
           else
299
 
            begin
300
 
              { Give a warning that cdecl routines does not include high()
301
 
                support }
302
 
              if (pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
303
 
                 paramanager.push_high_param(currpara.paratyp,currpara.paratype.def,pocall_default) then
304
 
               begin
305
 
                 if is_open_string(currpara.paratype.def) then
306
 
                    Message(parser_w_cdecl_no_openstring);
307
 
                 if not (po_external in pd.procoptions) then
308
 
                   Message(parser_w_cdecl_has_no_high);
309
 
               end;
310
 
            end;
311
 
           currpara:=tparaitem(currpara.previous);
312
 
         end;
313
 
      end;
314
 
 
315
 
 
316
 
    procedure check_c_para(p:tnamedindexitem;arg:pointer);
317
 
      begin
318
 
        if (tsym(p).typ<>varsym) then
319
 
         exit;
320
 
        with tvarsym(p) do
321
 
         begin
322
 
           case vartype.def.deftype of
323
 
             arraydef :
324
 
               begin
325
 
                 if not is_variant_array(vartype.def) and
326
 
                    not is_array_of_const(vartype.def) then
327
 
                  begin
328
 
                    if (varspez<>vs_var) then
329
 
                      Message(parser_h_c_arrays_are_references);
330
 
                  end;
331
 
                 if is_array_of_const(vartype.def) and
332
 
                    assigned(indexnext) and
333
 
                    (tsym(indexnext).typ=varsym) and
334
 
                    not(vo_is_high_value in tvarsym(indexnext).varoptions) then
335
 
                   Message(parser_e_C_array_of_const_must_be_last);
336
 
               end;
337
 
            end;
338
 
         end;
339
 
      end;
340
 
 
341
 
 
342
 
    procedure parse_parameter_dec(pd:tabstractprocdef);
343
 
      {
344
 
        handle_procvar needs the same changes
345
 
      }
346
 
      var
347
 
        is_procvar : boolean;
348
 
        sc      : tsinglelist;
349
 
        tt      : ttype;
350
 
        arrayelementtype : ttype;
351
 
        vs      : tvarsym;
352
 
        srsym   : tsym;
353
 
        hs1 : string;
354
 
        varspez : Tvarspez;
355
 
        defaultvalue : tconstsym;
356
 
        defaultrequired : boolean;
357
 
        old_object_option : tsymoptions;
358
 
        currparast : tparasymtable;
359
 
        explicit_paraloc : boolean;
360
 
        locationstr : string;
361
 
      begin
362
 
        explicit_paraloc:=false;
363
 
        consume(_LKLAMMER);
364
 
        { Delphi/Kylix supports nonsense like }
365
 
        { procedure p();                      }
366
 
        if try_to_consume(_RKLAMMER) and
367
 
          not(m_tp7 in aktmodeswitches) then
368
 
          exit;
369
 
        { parsing a proc or procvar ? }
370
 
        is_procvar:=(pd.deftype=procvardef);
371
 
        currparast:=tparasymtable(pd.parast);
372
 
        { reset }
373
 
        sc:=tsinglelist.create;
374
 
        defaultrequired:=false;
375
 
        { the variables are always public }
376
 
        old_object_option:=current_object_option;
377
 
        current_object_option:=[sp_public];
378
 
        inc(testcurobject);
379
 
        repeat
380
 
          if try_to_consume(_VAR) then
381
 
            varspez:=vs_var
382
 
          else
383
 
            if try_to_consume(_CONST) then
384
 
              varspez:=vs_const
385
 
          else
386
 
            if (idtoken=_OUT) and (m_out in aktmodeswitches) then
387
 
              begin
388
 
                 consume(_OUT);
389
 
                 varspez:=vs_out
390
 
              end
391
 
          else
392
 
            if (token=_POINTPOINTPOINT) and (m_mac in aktmodeswitches) then
393
 
              begin
394
 
                consume(_POINTPOINTPOINT);
395
 
                include(pd.procoptions,po_varargs);
396
 
                break;
397
 
              end
398
 
          else
399
 
              varspez:=vs_value;
400
 
          defaultvalue:=nil;
401
 
          tt.reset;
402
 
          { read identifiers and insert with error type }
403
 
          sc.reset;
404
 
          repeat
405
 
            vs:=tvarsym.create(orgpattern,varspez,generrortype);
406
 
            currparast.insert(vs);
407
 
            if assigned(vs.owner) then
408
 
             sc.insert(vs)
409
 
            else
410
 
             vs.free;
411
 
            consume(_ID);
412
 
          until not try_to_consume(_COMMA);
413
 
          locationstr:='';
414
 
          { read type declaration, force reading for value and const paras }
415
 
          if (token=_COLON) or (varspez=vs_value) then
416
 
           begin
417
 
             consume(_COLON);
418
 
             { check for an open array }
419
 
             if token=_ARRAY then
420
 
              begin
421
 
                consume(_ARRAY);
422
 
                consume(_OF);
423
 
                { define range and type of range }
424
 
                tt.setdef(tarraydef.create(0,-1,s32inttype));
425
 
                { array of const ? }
426
 
                if (token=_CONST) and (m_objpas in aktmodeswitches) then
427
 
                 begin
428
 
                   consume(_CONST);
429
 
                   srsym:=searchsymonlyin(systemunit,'TVARREC');
430
 
                   if not assigned(srsym) then
431
 
                     InternalError(200404181);
432
 
                   tarraydef(tt.def).setelementtype(ttypesym(srsym).restype);
433
 
                   tarraydef(tt.def).IsArrayOfConst:=true;
434
 
                 end
435
 
                else
436
 
                 begin
437
 
                   { define field type }
438
 
                   single_type(arrayelementtype,hs1,false);
439
 
                   tarraydef(tt.def).setelementtype(arrayelementtype);
440
 
                 end;
441
 
              end
442
 
             else
443
 
              begin
444
 
                { open string ? }
445
 
                if (varspez=vs_var) and
446
 
                        (
447
 
                          (
448
 
                            ((token=_STRING) or (idtoken=_SHORTSTRING)) and
449
 
                            (cs_openstring in aktmoduleswitches) and
450
 
                            not(cs_ansistrings in aktlocalswitches)
451
 
                          ) or
452
 
                        (idtoken=_OPENSTRING)) then
453
 
                 begin
454
 
                   consume(token);
455
 
                   tt:=openshortstringtype;
456
 
                   hs1:='openstring';
457
 
                 end
458
 
                else
459
 
                 begin
460
 
                   { everything else }
461
 
                   if (m_mac in aktmodeswitches) then
462
 
                     try_to_consume(_UNIV); {currently does nothing}
463
 
                   single_type(tt,hs1,false);
464
 
                 end;
465
 
 
466
 
                if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then
467
 
                  begin
468
 
                    if (idtoken=_LOCATION) then
469
 
                      begin
470
 
                        consume(_LOCATION);
471
 
                        locationstr:=pattern;
472
 
                        consume(_CSTRING);
473
 
                      end
474
 
                    else
475
 
                      begin
476
 
                        if explicit_paraloc then
477
 
                          Message(parser_e_paraloc_all_paras);
478
 
                        locationstr:='';
479
 
                      end;
480
 
                  end
481
 
                else
482
 
                  locationstr:='';
483
 
 
484
 
                { default parameter }
485
 
                if (m_default_para in aktmodeswitches) then
486
 
                 begin
487
 
                   if try_to_consume(_EQUAL) then
488
 
                    begin
489
 
                      vs:=tvarsym(sc.first);
490
 
                      if assigned(vs.listnext) then
491
 
                        Message(parser_e_default_value_only_one_para);
492
 
                      { prefix 'def' to the parameter name }
493
 
                      defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo);
494
 
                      include(defaultvalue.symoptions,sp_internal);
495
 
                      if assigned(defaultvalue) then
496
 
                       tprocdef(pd).parast.insert(defaultvalue);
497
 
                      defaultrequired:=true;
498
 
                    end
499
 
                   else
500
 
                    begin
501
 
                      if defaultrequired then
502
 
                        Message1(parser_e_default_value_expected_for_para,vs.name);
503
 
                    end;
504
 
                 end;
505
 
              end;
506
 
           end
507
 
          else
508
 
           begin
509
 
{$ifndef UseNiceNames}
510
 
             hs1:='$$$';
511
 
{$else UseNiceNames}
512
 
             hs1:='var';
513
 
{$endif UseNiceNames}
514
 
             tt:=cformaltype;
515
 
           end;
516
 
 
517
 
          { File types are only allowed for var parameters }
518
 
          if (tt.def.deftype=filedef) and
519
 
             (varspez<>vs_var) then
520
 
            CGMessage(cg_e_file_must_call_by_reference);
521
 
 
522
 
          vs:=tvarsym(sc.first);
523
 
          while assigned(vs) do
524
 
           begin
525
 
             { update varsym }
526
 
             vs.vartype:=tt;
527
 
             { For proc vars we only need the definitions }
528
 
             if not is_procvar then
529
 
              begin
530
 
                if (varspez in [vs_var,vs_const,vs_out]) and
531
 
                   paramanager.push_addr_param(varspez,tt.def,pd.proccalloption) then
532
 
                  include(vs.varoptions,vo_regable);
533
 
              end;
534
 
             pd.concatpara(nil,tt,vs,defaultvalue,false);
535
 
 
536
 
             if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then
537
 
               begin
538
 
                 if locationstr<>'' then
539
 
                   begin
540
 
                     if assigned(sc.first.listnext) then
541
 
                       Message(parser_e_paraloc_only_one_para);
542
 
                     if (pd.para.first<>pd.para.last) and not(explicit_paraloc) then
543
 
                       Message(parser_e_paraloc_all_paras);
544
 
                     explicit_paraloc:=true;
545
 
                     if not(paramanager.parseparaloc(tparaitem(pd.para.last),upper(locationstr))) then
546
 
                       message(parser_e_illegal_explicit_paraloc);
547
 
                   end
548
 
                 else
549
 
                   if explicit_paraloc then
550
 
                     Message(parser_e_paraloc_all_paras);
551
 
               end;
552
 
             vs:=tvarsym(vs.listnext);
553
 
           end;
554
 
        until not try_to_consume(_SEMICOLON);
555
 
 
556
 
        if explicit_paraloc then
557
 
          begin
558
 
            pd.has_paraloc_info:=true;
559
 
            include(pd.procoptions,po_explicitparaloc);
560
 
          end;
561
 
        { remove parasymtable from stack }
562
 
        sc.free;
563
 
        { reset object options }
564
 
        dec(testcurobject);
565
 
        current_object_option:=old_object_option;
566
 
        consume(_RKLAMMER);
567
 
      end;
568
 
 
569
 
 
570
 
    function parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
571
 
      var
572
 
        orgsp,sp : stringid;
573
 
        sym : tsym;
574
 
        srsymtable : tsymtable;
575
 
        storepos,
576
 
        procstartfilepos : tfileposinfo;
577
 
        searchagain : boolean;
578
 
        i : longint;
579
 
        st : tsymtable;
580
 
        aprocsym : tprocsym;
581
 
      begin
582
 
        { Save the position where this procedure really starts }
583
 
        procstartfilepos:=akttokenpos;
584
 
 
585
 
        result:=false;
586
 
        pd:=nil;
587
 
        aprocsym:=nil;
588
 
 
589
 
        if (potype=potype_operator) then
590
 
          begin
591
 
            sp:=overloaded_names[optoken];
592
 
            orgsp:=sp;
593
 
          end
594
 
        else
595
 
          begin
596
 
            sp:=pattern;
597
 
            orgsp:=orgpattern;
598
 
            consume(_ID);
599
 
          end;
600
 
 
601
 
        { examine interface map: function/procedure iname.functionname=locfuncname }
602
 
        if assigned(aclass) and
603
 
           assigned(aclass.implementedinterfaces) and
604
 
           (aclass.implementedinterfaces.count>0) and
605
 
           try_to_consume(_POINT) then
606
 
         begin
607
 
           storepos:=akttokenpos;
608
 
           akttokenpos:=procstartfilepos;
609
 
           { get interface syms}
610
 
           searchsym(sp,sym,srsymtable);
611
 
           if not assigned(sym) then
612
 
            begin
613
 
              identifier_not_found(orgsp);
614
 
              sym:=generrorsym;
615
 
            end;
616
 
           akttokenpos:=storepos;
617
 
           { qualifier is interface? }
618
 
           if (sym.typ=typesym) and
619
 
              (ttypesym(sym).restype.def.deftype=objectdef) then
620
 
             i:=aclass.implementedinterfaces.searchintf(ttypesym(sym).restype.def)
621
 
           else
622
 
             i:=-1;
623
 
           if (i=-1) then
624
 
             Message(parser_e_interface_id_expected);
625
 
           consume(_ID);
626
 
           consume(_EQUAL);
627
 
           if (token=_ID) then
628
 
             aclass.implementedinterfaces.addmappings(i,sp,pattern);
629
 
           consume(_ID);
630
 
           result:=true;
631
 
           exit;
632
 
         end;
633
 
 
634
 
        { method  ? }
635
 
        if not assigned(aclass) and
636
 
           (potype<>potype_operator) and
637
 
           (symtablestack.symtablelevel=main_program_level) and
638
 
           try_to_consume(_POINT) then
639
 
         begin
640
 
           { search for object name }
641
 
           storepos:=akttokenpos;
642
 
           akttokenpos:=procstartfilepos;
643
 
           searchsym(sp,sym,srsymtable);
644
 
           if not assigned(sym) then
645
 
            begin
646
 
              identifier_not_found(orgsp);
647
 
              sym:=generrorsym;
648
 
            end;
649
 
           akttokenpos:=storepos;
650
 
           { consume proc name }
651
 
           sp:=pattern;
652
 
           orgsp:=orgpattern;
653
 
           procstartfilepos:=akttokenpos;
654
 
           consume(_ID);
655
 
           { qualifier is class name ? }
656
 
           if (sym.typ=typesym) and
657
 
              (ttypesym(sym).restype.def.deftype=objectdef) then
658
 
            begin
659
 
              aclass:=tobjectdef(ttypesym(sym).restype.def);
660
 
              aprocsym:=tprocsym(aclass.symtable.search(sp));
661
 
              { we solve this below }
662
 
              if assigned(aprocsym) then
663
 
               begin
664
 
                 if aprocsym.typ<>procsym then
665
 
                  begin
666
 
                    {  we use a different error message for tp7 so it looks more compatible }
667
 
                    if (m_fpc in aktmodeswitches) then
668
 
                      Message1(parser_e_overloaded_no_procedure,aprocsym.realname)
669
 
                    else
670
 
                      Message(parser_e_methode_id_expected);
671
 
                    { rename the name to an unique name to avoid an
672
 
                      error when inserting the symbol in the symtable }
673
 
                    orgsp:=orgsp+'$'+tostr(aktfilepos.line);
674
 
                    aprocsym:=nil;
675
 
                  end;
676
 
               end
677
 
              else
678
 
               begin
679
 
                 Message(parser_e_methode_id_expected);
680
 
                 { recover by making it a normal procedure instead of method }
681
 
                 aclass:=nil;
682
 
               end;
683
 
            end
684
 
           else
685
 
            Message(parser_e_class_id_expected);
686
 
         end
687
 
        else
688
 
         begin
689
 
           { check for constructor/destructor which is not allowed here }
690
 
           if (not parse_only) and
691
 
              (potype in [potype_constructor,potype_destructor]) then
692
 
             Message(parser_e_constructors_always_objects);
693
 
 
694
 
           repeat
695
 
             searchagain:=false;
696
 
             akttokenpos:=procstartfilepos;
697
 
             aprocsym:=tprocsym(symtablestack.search(sp));
698
 
 
699
 
             if not(parse_only) and
700
 
                not assigned(aprocsym) and
701
 
                (symtablestack.symtabletype=staticsymtable) and
702
 
                assigned(symtablestack.next) and
703
 
                (symtablestack.next.unitid=0) then
704
 
               begin
705
 
                 { The procedure we prepare for is in the implementation
706
 
                   part of the unit we compile. It is also possible that we
707
 
                   are compiling a program, which is also some kind of
708
 
                   implementaion part.
709
 
 
710
 
                   We need to find out if the procedure is global. If it is
711
 
                   global, it is in the global symtable.}
712
 
                 aprocsym:=tprocsym(symtablestack.next.search(sp));
713
 
               end;
714
 
 
715
 
             { Check if overloaded is a procsym }
716
 
             if assigned(aprocsym) and
717
 
                (aprocsym.typ<>procsym) then
718
 
              begin
719
 
                { when the other symbol is a unit symbol then hide the unit
720
 
                  symbol }
721
 
                if (aprocsym.typ=unitsym) then
722
 
                 begin
723
 
                   aprocsym.owner.rename(aprocsym.name,'hidden'+aprocsym.name);
724
 
                   searchagain:=true;
725
 
                 end
726
 
                else
727
 
                 begin
728
 
                   {  we use a different error message for tp7 so it looks more compatible }
729
 
                   if (m_fpc in aktmodeswitches) then
730
 
                    Message1(parser_e_overloaded_no_procedure,aprocsym.realname)
731
 
                   else
732
 
                    DuplicateSym(aprocsym);
733
 
                   { rename the name to an unique name to avoid an
734
 
                     error when inserting the symbol in the symtable }
735
 
                   orgsp:=orgsp+'$'+tostr(aktfilepos.line);
736
 
                   { generate a new aktprocsym }
737
 
                   aprocsym:=nil;
738
 
                 end;
739
 
              end;
740
 
           until not searchagain;
741
 
         end;
742
 
 
743
 
        { test again if assigned, it can be reset to recover }
744
 
        if not assigned(aprocsym) then
745
 
         begin
746
 
           { create a new procsym and set the real filepos }
747
 
           akttokenpos:=procstartfilepos;
748
 
           { for operator we have only one procsym for each overloaded
749
 
             operation }
750
 
           if (potype=potype_operator) then
751
 
             begin
752
 
               Aprocsym:=Tprocsym(symtablestack.search(sp));
753
 
               if Aprocsym=nil then
754
 
                 Aprocsym:=tprocsym.create('$'+sp);
755
 
             end
756
 
            else
757
 
             aprocsym:=tprocsym.create(orgsp);
758
 
            symtablestack.insert(aprocsym);
759
 
         end;
760
 
 
761
 
        { to get the correct symtablelevel we must ignore objectsymtables }
762
 
        st:=symtablestack;
763
 
        while not(st.symtabletype in [staticsymtable,globalsymtable,localsymtable]) do
764
 
         st:=st.next;
765
 
        pd:=tprocdef.create(st.symtablelevel+1);
766
 
        pd._class:=aclass;
767
 
        pd.procsym:=aprocsym;
768
 
        pd.proctypeoption:=potype;
769
 
        { methods need to be exported }
770
 
        if assigned(aclass) and
771
 
           (
772
 
            (symtablestack.symtabletype=objectsymtable) or
773
 
            (symtablestack.symtablelevel=main_program_level)
774
 
           ) then
775
 
          include(pd.procoptions,po_public);
776
 
 
777
 
        { symbol options that need to be kept per procdef }
778
 
        pd.fileinfo:=procstartfilepos;
779
 
        pd.symoptions:=current_object_option;
780
 
 
781
 
        { parse parameters }
782
 
        if token=_LKLAMMER then
783
 
          parse_parameter_dec(pd);
784
 
 
785
 
        result:=true;
786
 
      end;
787
 
 
788
 
 
789
 
    function parse_proc_dec(aclass:tobjectdef):tprocdef;
790
 
      var
791
 
        pd : tprocdef;
792
 
        hs : string;
793
 
        isclassmethod : boolean;
794
 
      begin
795
 
        pd:=nil;
796
 
        { read class method }
797
 
        if try_to_consume(_CLASS) then
798
 
         begin
799
 
           { class method only allowed for procedures and functions }
800
 
           if not(token in [_FUNCTION,_PROCEDURE]) then
801
 
             Message(parser_e_procedure_or_function_expected);
802
 
 
803
 
           isclassmethod:=true;
804
 
         end
805
 
        else
806
 
         isclassmethod:=false;
807
 
        case token of
808
 
          _FUNCTION :
809
 
            begin
810
 
              consume(_FUNCTION);
811
 
              if parse_proc_head(aclass,potype_none,pd) then
812
 
                begin
813
 
                  { pd=nil when it is a interface mapping }
814
 
                  if assigned(pd) then
815
 
                    begin
816
 
                      if try_to_consume(_COLON) then
817
 
                       begin
818
 
                         inc(testcurobject);
819
 
                         single_type(pd.rettype,hs,false);
820
 
                         pd.test_if_fpu_result;
821
 
                         dec(testcurobject);
822
 
                       end
823
 
                      else
824
 
                       begin
825
 
                          if (
826
 
                              parse_only and
827
 
                              not(is_interface(pd._class))
828
 
                             ) or
829
 
                             (m_repeat_forward in aktmodeswitches) then
830
 
                          begin
831
 
                            consume(_COLON);
832
 
                            consume_all_until(_SEMICOLON);
833
 
                          end;
834
 
                       end;
835
 
                      if isclassmethod then
836
 
                       include(pd.procoptions,po_classmethod);
837
 
                    end;
838
 
                end
839
 
              else
840
 
                begin
841
 
                  { recover }
842
 
                  consume(_COLON);
843
 
                  consume_all_until(_SEMICOLON);
844
 
                end;
845
 
            end;
846
 
 
847
 
          _PROCEDURE :
848
 
            begin
849
 
              consume(_PROCEDURE);
850
 
              if parse_proc_head(aclass,potype_none,pd) then
851
 
                begin
852
 
                  { pd=nil when it is a interface mapping }
853
 
                  if assigned(pd) then
854
 
                    begin
855
 
                      pd.rettype:=voidtype;
856
 
                      if isclassmethod then
857
 
                        include(pd.procoptions,po_classmethod);
858
 
                    end;
859
 
                end;
860
 
            end;
861
 
 
862
 
          _CONSTRUCTOR :
863
 
            begin
864
 
              consume(_CONSTRUCTOR);
865
 
              parse_proc_head(aclass,potype_constructor,pd);
866
 
              if assigned(pd) and
867
 
                 assigned(pd._class) then
868
 
                begin
869
 
                  { Set return type, class constructors return the
870
 
                    created instance, object constructors return boolean }
871
 
                  if is_class(pd._class) then
872
 
                   pd.rettype.setdef(pd._class)
873
 
                  else
874
 
                   pd.rettype:=booltype;
875
 
                end;
876
 
            end;
877
 
 
878
 
          _DESTRUCTOR :
879
 
            begin
880
 
              consume(_DESTRUCTOR);
881
 
              parse_proc_head(aclass,potype_destructor,pd);
882
 
              if assigned(pd) then
883
 
                pd.rettype:=voidtype;
884
 
            end;
885
 
 
886
 
          _OPERATOR :
887
 
            begin
888
 
              consume(_OPERATOR);
889
 
              if (token in [first_overloaded..last_overloaded]) then
890
 
               begin
891
 
                 optoken:=token;
892
 
               end
893
 
              else
894
 
               begin
895
 
                 Message(parser_e_overload_operator_failed);
896
 
                 { Use the dummy NOTOKEN that is also declared
897
 
                   for the overloaded_operator[] }
898
 
                 optoken:=NOTOKEN;
899
 
               end;
900
 
              consume(token);
901
 
              parse_proc_head(aclass,potype_operator,pd);
902
 
              if assigned(pd) then
903
 
                begin
904
 
                  if pd.parast.symtablelevel>normal_function_level then
905
 
                    Message(parser_e_no_local_operator);
906
 
                  if token<>_ID then
907
 
                    begin
908
 
                       if not(m_result in aktmodeswitches) then
909
 
                         consume(_ID);
910
 
                    end
911
 
                  else
912
 
                    begin
913
 
                      pd.resultname:=orgpattern;
914
 
                      consume(_ID);
915
 
                    end;
916
 
                  if not try_to_consume(_COLON) then
917
 
                    begin
918
 
                      consume(_COLON);
919
 
                      pd.rettype:=generrortype;
920
 
                      consume_all_until(_SEMICOLON);
921
 
                    end
922
 
                  else
923
 
                   begin
924
 
                     single_type(pd.rettype,hs,false);
925
 
                     pd.test_if_fpu_result;
926
 
                     if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
927
 
                        ((pd.rettype.def.deftype<>orddef) or
928
 
                         (torddef(pd.rettype.def).typ<>bool8bit)) then
929
 
                        Message(parser_e_comparative_operator_return_boolean);
930
 
                     if (optoken=_ASSIGNMENT) and
931
 
                        equal_defs(pd.rettype.def,
932
 
                           tvarsym(pd.parast.symindex.first).vartype.def) then
933
 
                       message(parser_e_no_such_assignment)
934
 
                     else if not isoperatoracceptable(pd,optoken) then
935
 
                       Message(parser_e_overload_impossible);
936
 
                   end;
937
 
                end
938
 
              else
939
 
                begin
940
 
                  { recover }
941
 
                  try_to_consume(_ID);
942
 
                  consume(_COLON);
943
 
                  consume_all_until(_SEMICOLON);
944
 
                end;
945
 
            end;
946
 
        end;
947
 
        { support procedure proc stdcall export; }
948
 
        if not(is_proc_directive(token,false)) then
949
 
          consume(_SEMICOLON);
950
 
        result:=pd;
951
 
      end;
952
 
 
953
 
 
954
 
{****************************************************************************
955
 
                        Procedure directive handlers
956
 
****************************************************************************}
957
 
 
958
 
procedure pd_far(pd:tabstractprocdef);
959
 
begin
960
 
  Message1(parser_w_proc_directive_ignored,'FAR');
961
 
end;
962
 
 
963
 
procedure pd_near(pd:tabstractprocdef);
964
 
begin
965
 
  Message1(parser_w_proc_directive_ignored,'NEAR');
966
 
end;
967
 
 
968
 
procedure pd_export(pd:tabstractprocdef);
969
 
begin
970
 
  if pd.deftype<>procdef then
971
 
    internalerror(200304264);
972
 
  if assigned(tprocdef(pd)._class) then
973
 
    Message(parser_e_methods_dont_be_export);
974
 
  if pd.parast.symtablelevel>normal_function_level then
975
 
    Message(parser_e_dont_nest_export);
976
 
  { only os/2 and emx need this }
977
 
  if target_info.system in [system_i386_os2,system_i386_emx] then
978
 
   begin
979
 
     tprocdef(pd).aliasnames.insert(tprocdef(pd).procsym.realname);
980
 
     if cs_link_deffile in aktglobalswitches then
981
 
       deffile.AddExport(tprocdef(pd).mangledname);
982
 
   end;
983
 
end;
984
 
 
985
 
procedure pd_forward(pd:tabstractprocdef);
986
 
begin
987
 
  if pd.deftype<>procdef then
988
 
    internalerror(200304265);
989
 
  tprocdef(pd).forwarddef:=true;
990
 
end;
991
 
 
992
 
procedure pd_alias(pd:tabstractprocdef);
993
 
begin
994
 
  if pd.deftype<>procdef then
995
 
    internalerror(200304266);
996
 
  consume(_COLON);
997
 
  tprocdef(pd).aliasnames.insert(get_stringconst);
998
 
end;
999
 
 
1000
 
procedure pd_asmname(pd:tabstractprocdef);
1001
 
begin
1002
 
  if pd.deftype<>procdef then
1003
 
    internalerror(200304267);
1004
 
  tprocdef(pd).setmangledname(target_info.Cprefix+pattern);
1005
 
  if token=_CCHAR then
1006
 
    consume(_CCHAR)
1007
 
  else
1008
 
    consume(_CSTRING);
1009
 
  { we don't need anything else }
1010
 
  tprocdef(pd).forwarddef:=false;
1011
 
end;
1012
 
 
1013
 
procedure pd_inline(pd:tabstractprocdef);
1014
 
var
1015
 
  hp : tparaitem;
1016
 
begin
1017
 
  { check if there is an array of const }
1018
 
  hp:=tparaitem(pd.para.first);
1019
 
  while assigned(hp) do
1020
 
   begin
1021
 
     if assigned(hp.paratype.def) and
1022
 
        (hp.paratype.def.deftype=arraydef) then
1023
 
      begin
1024
 
        with tarraydef(hp.paratype.def) do
1025
 
         if IsVariant or IsConstructor {or IsArrayOfConst} then
1026
 
          begin
1027
 
            Message1(parser_w_not_supported_for_inline,'array of const');
1028
 
            Message(parser_w_inlining_disabled);
1029
 
            pd.proccalloption:=pocall_default;
1030
 
          end;
1031
 
      end;
1032
 
     hp:=tparaitem(hp.next);
1033
 
   end;
1034
 
end;
1035
 
 
1036
 
procedure pd_intern(pd:tabstractprocdef);
1037
 
begin
1038
 
  if pd.deftype<>procdef then
1039
 
    internalerror(200304268);
1040
 
  consume(_COLON);
1041
 
  tprocdef(pd).extnumber:=get_intconst;
1042
 
end;
1043
 
 
1044
 
procedure pd_interrupt(pd:tabstractprocdef);
1045
 
begin
1046
 
  if pd.parast.symtablelevel>normal_function_level then
1047
 
    Message(parser_e_dont_nest_interrupt);
1048
 
end;
1049
 
 
1050
 
procedure pd_abstract(pd:tabstractprocdef);
1051
 
begin
1052
 
  if pd.deftype<>procdef then
1053
 
    internalerror(200304269);
1054
 
  if (po_virtualmethod in pd.procoptions) then
1055
 
    include(pd.procoptions,po_abstractmethod)
1056
 
  else
1057
 
    Message(parser_e_only_virtual_methods_abstract);
1058
 
  { the method is defined }
1059
 
  tprocdef(pd).forwarddef:=false;
1060
 
end;
1061
 
 
1062
 
procedure pd_virtual(pd:tabstractprocdef);
1063
 
{$ifdef WITHDMT}
1064
 
var
1065
 
  pt : tnode;
1066
 
{$endif WITHDMT}
1067
 
begin
1068
 
  if pd.deftype<>procdef then
1069
 
    internalerror(2003042610);
1070
 
  if (pd.proctypeoption=potype_constructor) and
1071
 
     is_object(tprocdef(pd)._class) then
1072
 
    Message(parser_e_constructor_cannot_be_not_virtual);
1073
 
{$ifdef WITHDMT}
1074
 
  if is_object(tprocdef(pd)._class) and
1075
 
     (token<>_SEMICOLON) then
1076
 
    begin
1077
 
       { any type of parameter is allowed here! }
1078
 
       pt:=comp_expr(true);
1079
 
       if is_constintnode(pt) then
1080
 
         begin
1081
 
           include(pd.procoptions,po_msgint);
1082
 
           pd.messageinf.i:=pt^.value;
1083
 
         end
1084
 
       else
1085
 
         Message(parser_e_ill_msg_expr);
1086
 
       disposetree(pt);
1087
 
    end;
1088
 
{$endif WITHDMT}
1089
 
end;
1090
 
 
1091
 
procedure pd_static(pd:tabstractprocdef);
1092
 
begin
1093
 
  if (cs_static_keyword in aktmoduleswitches) then
1094
 
    begin
1095
 
      if pd.deftype=procdef then
1096
 
        include(tprocdef(pd).procsym.symoptions,sp_static);
1097
 
      include(pd.procoptions,po_staticmethod);
1098
 
    end;
1099
 
end;
1100
 
 
1101
 
procedure pd_override(pd:tabstractprocdef);
1102
 
begin
1103
 
  if pd.deftype<>procdef then
1104
 
    internalerror(2003042611);
1105
 
  if not(is_class_or_interface(tprocdef(pd)._class)) then
1106
 
    Message(parser_e_no_object_override);
1107
 
end;
1108
 
 
1109
 
procedure pd_overload(pd:tabstractprocdef);
1110
 
begin
1111
 
  if pd.deftype<>procdef then
1112
 
    internalerror(2003042612);
1113
 
  include(tprocdef(pd).procsym.symoptions,sp_has_overloaded);
1114
 
end;
1115
 
 
1116
 
procedure pd_message(pd:tabstractprocdef);
1117
 
var
1118
 
  pt : tnode;
1119
 
begin
1120
 
  if pd.deftype<>procdef then
1121
 
    internalerror(2003042613);
1122
 
  if not is_class(tprocdef(pd)._class) then
1123
 
    Message(parser_e_msg_only_for_classes);
1124
 
  { check parameter type }
1125
 
  if ((pd.minparacount<>1) or
1126
 
      (pd.maxparacount<>1) or
1127
 
      (TParaItem(pd.Para.first).paratyp<>vs_var)) then
1128
 
    Message(parser_e_ill_msg_param);
1129
 
  pt:=comp_expr(true);
1130
 
  if pt.nodetype=stringconstn then
1131
 
    begin
1132
 
      include(pd.procoptions,po_msgstr);
1133
 
      tprocdef(pd).messageinf.str:=strnew(tstringconstnode(pt).value_str);
1134
 
    end
1135
 
  else
1136
 
   if is_constintnode(pt) then
1137
 
    begin
1138
 
      include(pd.procoptions,po_msgint);
1139
 
      tprocdef(pd).messageinf.i:=tordconstnode(pt).value;
1140
 
    end
1141
 
  else
1142
 
    Message(parser_e_ill_msg_expr);
1143
 
  pt.free;
1144
 
end;
1145
 
 
1146
 
 
1147
 
procedure pd_reintroduce(pd:tabstractprocdef);
1148
 
begin
1149
 
  if pd.deftype<>procdef then
1150
 
    internalerror(200401211);
1151
 
  if not(is_class_or_interface(tprocdef(pd)._class)) then
1152
 
    Message(parser_e_no_object_reintroduce);
1153
 
end;
1154
 
 
1155
 
 
1156
 
procedure pd_syscall(pd:tabstractprocdef);
1157
 
var
1158
 
  sym : tsym;
1159
 
  symtable : tsymtable;
1160
 
begin
1161
 
  if pd.deftype<>procdef then
1162
 
    internalerror(2003042614);
1163
 
  tprocdef(pd).forwarddef:=false;
1164
 
{$ifdef powerpc}
1165
 
  if target_info.system in [system_powerpc_morphos,system_m68k_amiga] then
1166
 
    begin
1167
 
     pd.has_paraloc_info:=true;
1168
 
     include(pd.procoptions,po_explicitparaloc);
1169
 
      if consume_sym(sym,symtable) then
1170
 
        begin
1171
 
          if (sym.typ=varsym) and
1172
 
            (is_voidpointer(tvarsym(sym).vartype.def) or
1173
 
             is_32bitint(tvarsym(sym).vartype.def)) then
1174
 
            begin
1175
 
              tprocdef(pd).libsym:=sym;
1176
 
              pd.concatpara(nil,tvarsym(sym).vartype,tvarsym(sym),nil,true);
1177
 
              paramanager.parseparaloc(tparaitem(pd.para.last),'A6');
1178
 
            end
1179
 
          else
1180
 
            Message(parser_e_32bitint_or_pointer_variable_expected);
1181
 
        end;
1182
 
    end;
1183
 
{$endif powerpc}
1184
 
  tprocdef(pd).extnumber:=get_intconst;
1185
 
end;
1186
 
 
1187
 
 
1188
 
procedure pd_external(pd:tabstractprocdef);
1189
 
{
1190
 
  If import_dll=nil the procedure is assumed to be in another
1191
 
  object file. In that object file it should have the name to
1192
 
  which import_name is pointing to. Otherwise, the procedure is
1193
 
  assumed to be in the DLL to which import_dll is pointing to. In
1194
 
  that case either import_nr<>0 or import_name<>nil is true, so
1195
 
  the procedure is either imported by number or by name. (DM)
1196
 
}
1197
 
var
1198
 
  import_dll,
1199
 
  import_name : string;
1200
 
  import_nr   : word;
1201
 
  hpd         : tprocdef;
1202
 
begin
1203
 
  if pd.deftype<>procdef then
1204
 
    internalerror(2003042615);
1205
 
  tprocdef(pd).forwarddef:=false;
1206
 
  { forbid local external procedures }
1207
 
  if pd.parast.symtablelevel>normal_function_level then
1208
 
    Message(parser_e_no_local_external);
1209
 
  { If the procedure should be imported from a DLL, a constant string follows.
1210
 
    This isn't really correct, an contant string expression follows
1211
 
    so we check if an semicolon follows, else a string constant have to
1212
 
    follow (FK) }
1213
 
  import_nr:=0;
1214
 
  import_name:='';
1215
 
  if not(token=_SEMICOLON) and not(idtoken=_NAME) then
1216
 
    begin
1217
 
      import_dll:=get_stringconst;
1218
 
      if (idtoken=_NAME) then
1219
 
       begin
1220
 
         consume(_NAME);
1221
 
         import_name:=get_stringconst;
1222
 
       end;
1223
 
      if (idtoken=_INDEX) then
1224
 
       begin
1225
 
         {After the word index follows the index number in the DLL.}
1226
 
         consume(_INDEX);
1227
 
         import_nr:=get_intconst;
1228
 
       end;
1229
 
      { default is to used the realname of the procedure }
1230
 
      if (import_nr=0) and (import_name='') then
1231
 
        import_name:=tprocdef(pd).procsym.realname;
1232
 
      { create importlib if not already done }
1233
 
      if not(current_module.uses_imports) then
1234
 
       begin
1235
 
         current_module.uses_imports:=true;
1236
 
         importlib.preparelib(current_module.modulename^);
1237
 
       end;
1238
 
      if not(m_repeat_forward in aktmodeswitches) then
1239
 
       begin
1240
 
         { we can only have one overloaded here ! }
1241
 
         if tprocsym(tprocdef(pd).procsym).procdef_count>1 then
1242
 
          hpd:=tprocsym(tprocdef(pd).procsym).procdef[2]
1243
 
         else
1244
 
          hpd:=tprocdef(pd);
1245
 
       end
1246
 
      else
1247
 
       hpd:=tprocdef(pd);
1248
 
      importlib.importprocedure(hpd,import_dll,import_nr,import_name);
1249
 
    end
1250
 
  else
1251
 
    begin
1252
 
      if (idtoken=_NAME) then
1253
 
       begin
1254
 
         consume(_NAME);
1255
 
         import_name:=get_stringconst;
1256
 
         tprocdef(pd).setmangledname(import_name);
1257
 
       end;
1258
 
    end;
1259
 
end;
1260
 
 
1261
 
type
1262
 
   pd_handler=procedure(pd:tabstractprocdef);
1263
 
   proc_dir_rec=record
1264
 
     idtok     : ttoken;
1265
 
     pd_flags  : tpdflags;
1266
 
     handler   : pd_handler;
1267
 
     pocall    : tproccalloption;
1268
 
     pooption  : tprocoptions;
1269
 
     mutexclpocall : tproccalloptions;
1270
 
     mutexclpotype : tproctypeoptions;
1271
 
     mutexclpo     : tprocoptions;
1272
 
   end;
1273
 
const
1274
 
  {Should contain the number of procedure directives we support.}
1275
 
  num_proc_directives=36;
1276
 
  proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
1277
 
   (
1278
 
    (
1279
 
      idtok:_ABSTRACT;
1280
 
      pd_flags : [pd_interface,pd_object,pd_notobjintf];
1281
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_abstract;
1282
 
      pocall   : pocall_none;
1283
 
      pooption : [po_abstractmethod];
1284
 
      mutexclpocall : [pocall_internproc,pocall_inline];
1285
 
      mutexclpotype : [];
1286
 
      mutexclpo     : [po_exports,po_interrupt,po_external]
1287
 
    ),(
1288
 
      idtok:_ALIAS;
1289
 
      pd_flags : [pd_implemen,pd_body,pd_notobjintf];
1290
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_alias;
1291
 
      pocall   : pocall_none;
1292
 
      pooption : [];
1293
 
      mutexclpocall : [pocall_inline];
1294
 
      mutexclpotype : [];
1295
 
      mutexclpo     : [po_external]
1296
 
    ),(
1297
 
      idtok:_ASMNAME;
1298
 
      pd_flags : [pd_interface,pd_implemen,pd_notobjintf];
1299
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_asmname;
1300
 
      pocall   : pocall_cdecl;
1301
 
      pooption : [po_external];
1302
 
      mutexclpocall : [pocall_internproc,pocall_inline];
1303
 
      mutexclpotype : [];
1304
 
      mutexclpo     : [po_external]
1305
 
    ),(
1306
 
      idtok:_ASSEMBLER;
1307
 
      pd_flags : [pd_implemen,pd_body,pd_notobjintf];
1308
 
      handler  : nil;
1309
 
      pocall   : pocall_none;
1310
 
      pooption : [po_assembler];
1311
 
      mutexclpocall : [];
1312
 
      mutexclpotype : [];
1313
 
      mutexclpo     : [po_external]
1314
 
    ),(
1315
 
      idtok:_C; {same as cdecl for mode mac}
1316
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1317
 
      handler  : nil;
1318
 
      pocall   : pocall_cdecl;
1319
 
      pooption : [];
1320
 
      mutexclpocall : [];
1321
 
      mutexclpotype : [potype_constructor,potype_destructor];
1322
 
      mutexclpo     : [po_assembler,po_external]
1323
 
    ),(
1324
 
      idtok:_CDECL;
1325
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1326
 
      handler  : nil;
1327
 
      pocall   : pocall_cdecl;
1328
 
      pooption : [];
1329
 
      mutexclpocall : [];
1330
 
      mutexclpotype : [potype_constructor,potype_destructor];
1331
 
      mutexclpo     : [po_assembler,po_external]
1332
 
    ),(
1333
 
      idtok:_DYNAMIC;
1334
 
      pd_flags : [pd_interface,pd_object,pd_notobjintf];
1335
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
1336
 
      pocall   : pocall_none;
1337
 
      pooption : [po_virtualmethod];
1338
 
      mutexclpocall : [pocall_internproc,pocall_inline];
1339
 
      mutexclpotype : [];
1340
 
      mutexclpo     : [po_exports,po_interrupt,po_external,po_overridingmethod]
1341
 
    ),(
1342
 
      idtok:_EXPORT;
1343
 
      pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf];
1344
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_export;
1345
 
      pocall   : pocall_none;
1346
 
      pooption : [po_exports,po_public];
1347
 
      mutexclpocall : [pocall_internproc,pocall_inline];
1348
 
      mutexclpotype : [potype_constructor,potype_destructor];
1349
 
      mutexclpo     : [po_external,po_interrupt]
1350
 
    ),(
1351
 
      idtok:_EXTERNAL;
1352
 
      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf];
1353
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_external;
1354
 
      pocall   : pocall_none;
1355
 
      pooption : [po_external];
1356
 
      mutexclpocall : [pocall_internproc,pocall_inline,pocall_syscall];
1357
 
      mutexclpotype : [potype_constructor,potype_destructor];
1358
 
      mutexclpo     : [po_exports,po_interrupt,po_assembler]
1359
 
    ),(
1360
 
      idtok:_FAR;
1361
 
      pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf];
1362
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_far;
1363
 
      pocall   : pocall_none;
1364
 
      pooption : [];
1365
 
      mutexclpocall : [pocall_internproc,pocall_inline];
1366
 
      mutexclpotype : [];
1367
 
      mutexclpo     : []
1368
 
    ),(
1369
 
      idtok:_FAR16;
1370
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject];
1371
 
      handler  : nil;
1372
 
      pocall   : pocall_far16;
1373
 
      pooption : [];
1374
 
      mutexclpocall : [];
1375
 
      mutexclpotype : [];
1376
 
      mutexclpo     : [po_external]
1377
 
    ),(
1378
 
      idtok:_FORWARD;
1379
 
      pd_flags : [pd_implemen,pd_notobject,pd_notobjintf];
1380
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_forward;
1381
 
      pocall   : pocall_none;
1382
 
      pooption : [];
1383
 
      mutexclpocall : [pocall_internproc,pocall_inline];
1384
 
      mutexclpotype : [];
1385
 
      mutexclpo     : [po_external]
1386
 
    ),(
1387
 
      idtok:_OLDFPCCALL;
1388
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1389
 
      handler  : nil;
1390
 
      pocall   : pocall_oldfpccall;
1391
 
      pooption : [];
1392
 
      mutexclpocall : [];
1393
 
      mutexclpotype : [];
1394
 
      mutexclpo     : []
1395
 
    ),(
1396
 
      idtok:_INLINE;
1397
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
1398
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_inline;
1399
 
      pocall   : pocall_inline;
1400
 
      pooption : [];
1401
 
      mutexclpocall : [];
1402
 
      mutexclpotype : [potype_constructor,potype_destructor];
1403
 
      mutexclpo     : [po_exports,po_external,po_interrupt,po_virtualmethod]
1404
 
    ),(
1405
 
      idtok:_INTERNCONST;
1406
 
      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
1407
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
1408
 
      pocall   : pocall_none;
1409
 
      pooption : [po_internconst];
1410
 
      mutexclpocall : [];
1411
 
      mutexclpotype : [potype_operator];
1412
 
      mutexclpo     : []
1413
 
    ),(
1414
 
      idtok:_INTERNPROC;
1415
 
      pd_flags : [pd_implemen,pd_notobject,pd_notobjintf];
1416
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_intern;
1417
 
      pocall   : pocall_internproc;
1418
 
      pooption : [];
1419
 
      mutexclpocall : [];
1420
 
      mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
1421
 
      mutexclpo     : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_virtualmethod]
1422
 
    ),(
1423
 
      idtok:_INTERRUPT;
1424
 
      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
1425
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_interrupt;
1426
 
      pocall   : pocall_none;
1427
 
      pooption : [po_interrupt];
1428
 
      mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,pocall_stdcall,
1429
 
                       pocall_inline,pocall_pascal,pocall_far16,pocall_oldfpccall];
1430
 
      mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
1431
 
      mutexclpo     : [po_external]
1432
 
    ),(
1433
 
      idtok:_IOCHECK;
1434
 
      pd_flags : [pd_implemen,pd_body,pd_notobjintf];
1435
 
      handler  : nil;
1436
 
      pocall   : pocall_none;
1437
 
      pooption : [po_iocheck];
1438
 
      mutexclpocall : [pocall_internproc];
1439
 
      mutexclpotype : [];
1440
 
      mutexclpo     : [po_external]
1441
 
    ),(
1442
 
      idtok:_MESSAGE;
1443
 
      pd_flags : [pd_interface,pd_object,pd_notobjintf];
1444
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_message;
1445
 
      pocall   : pocall_none;
1446
 
      pooption : []; { can be po_msgstr or po_msgint }
1447
 
      mutexclpocall : [pocall_inline,pocall_internproc];
1448
 
      mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
1449
 
      mutexclpo     : [po_interrupt,po_external]
1450
 
    ),(
1451
 
      idtok:_NEAR;
1452
 
      pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf];
1453
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_near;
1454
 
      pocall   : pocall_none;
1455
 
      pooption : [];
1456
 
      mutexclpocall : [pocall_internproc];
1457
 
      mutexclpotype : [];
1458
 
      mutexclpo     : []
1459
 
    ),(
1460
 
      idtok:_OVERLOAD;
1461
 
      pd_flags : [pd_implemen,pd_interface,pd_body];
1462
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_overload;
1463
 
      pocall   : pocall_none;
1464
 
      pooption : [po_overload];
1465
 
      mutexclpocall : [pocall_internproc];
1466
 
      mutexclpotype : [];
1467
 
      mutexclpo     : []
1468
 
    ),(
1469
 
      idtok:_OVERRIDE;
1470
 
      pd_flags : [pd_interface,pd_object,pd_notobjintf];
1471
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_override;
1472
 
      pocall   : pocall_none;
1473
 
      pooption : [po_overridingmethod,po_virtualmethod];
1474
 
      mutexclpocall : [pocall_inline,pocall_internproc];
1475
 
      mutexclpotype : [];
1476
 
      mutexclpo     : [po_exports,po_external,po_interrupt,po_virtualmethod]
1477
 
    ),(
1478
 
      idtok:_PASCAL;
1479
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1480
 
      handler  : nil;
1481
 
      pocall   : pocall_pascal;
1482
 
      pooption : [];
1483
 
      mutexclpocall : [];
1484
 
      mutexclpotype : [potype_constructor,potype_destructor];
1485
 
      mutexclpo     : [po_external]
1486
 
    ),(
1487
 
      idtok:_PUBLIC;
1488
 
      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
1489
 
      handler  : nil;
1490
 
      pocall   : pocall_none;
1491
 
      pooption : [po_public];
1492
 
      mutexclpocall : [pocall_internproc,pocall_inline];
1493
 
      mutexclpotype : [];
1494
 
      mutexclpo     : [po_external]
1495
 
    ),(
1496
 
      idtok:_REGISTER;
1497
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1498
 
      handler  : nil;
1499
 
      pocall   : pocall_register;
1500
 
      pooption : [];
1501
 
      mutexclpocall : [];
1502
 
      mutexclpotype : [potype_constructor,potype_destructor];
1503
 
      mutexclpo     : [po_external]
1504
 
    ),(
1505
 
      idtok:_REINTRODUCE;
1506
 
      pd_flags : [pd_interface,pd_object,pd_notobjintf];
1507
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_reintroduce;
1508
 
      pocall   : pocall_none;
1509
 
      pooption : [po_reintroduce];
1510
 
      mutexclpocall : [pocall_inline,pocall_internproc];
1511
 
      mutexclpotype : [];
1512
 
      mutexclpo     : [po_external,po_interrupt,po_exports,po_overridingmethod]
1513
 
    ),(
1514
 
      idtok:_SAFECALL;
1515
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1516
 
      handler  : nil;
1517
 
      pocall   : pocall_safecall;
1518
 
      pooption : [];
1519
 
      mutexclpocall : [];
1520
 
      mutexclpotype : [potype_constructor,potype_destructor];
1521
 
      mutexclpo     : [po_external]
1522
 
    ),(
1523
 
      idtok:_SAVEREGISTERS;
1524
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobjintf];
1525
 
      handler  : nil;
1526
 
      pocall   : pocall_none;
1527
 
      pooption : [po_saveregisters];
1528
 
      mutexclpocall : [pocall_internproc];
1529
 
      mutexclpotype : [potype_constructor,potype_destructor];
1530
 
      mutexclpo     : [po_external]
1531
 
    ),(
1532
 
      idtok:_SOFTFLOAT;
1533
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1534
 
      handler  : nil;
1535
 
      pocall   : pocall_softfloat;
1536
 
      pooption : [];
1537
 
      mutexclpocall : [];
1538
 
      mutexclpotype : [potype_constructor,potype_destructor];
1539
 
      { it's available with po_external because the libgcc floating point routines on the arm
1540
 
        uses this calling convention }
1541
 
      mutexclpo     : []
1542
 
    ),(
1543
 
      idtok:_STATIC;
1544
 
      pd_flags : [pd_interface,pd_object,pd_notobjintf];
1545
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_static;
1546
 
      pocall   : pocall_none;
1547
 
      pooption : [po_staticmethod];
1548
 
      mutexclpocall : [pocall_inline,pocall_internproc];
1549
 
      mutexclpotype : [potype_constructor,potype_destructor];
1550
 
      mutexclpo     : [po_external,po_interrupt,po_exports]
1551
 
    ),(
1552
 
      idtok:_STDCALL;
1553
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1554
 
      handler  : nil;
1555
 
      pocall   : pocall_stdcall;
1556
 
      pooption : [];
1557
 
      mutexclpocall : [];
1558
 
      mutexclpotype : [potype_constructor,potype_destructor];
1559
 
      mutexclpo     : [po_external]
1560
 
    ),(
1561
 
      idtok:_SYSCALL;
1562
 
      pd_flags : [pd_interface,pd_implemen,pd_notobject,pd_notobjintf];
1563
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_syscall;
1564
 
      pocall   : pocall_syscall;
1565
 
      pooption : [];
1566
 
      mutexclpocall : [];
1567
 
      mutexclpotype : [potype_constructor,potype_destructor];
1568
 
      mutexclpo     : [po_external,po_assembler,po_interrupt,po_exports]
1569
 
    ),(
1570
 
      idtok:_VIRTUAL;
1571
 
      pd_flags : [pd_interface,pd_object,pd_notobjintf];
1572
 
      handler  : {$ifdef FPCPROCVAR}@{$endif}pd_virtual;
1573
 
      pocall   : pocall_none;
1574
 
      pooption : [po_virtualmethod];
1575
 
      mutexclpocall : [pocall_inline,pocall_internproc];
1576
 
      mutexclpotype : [];
1577
 
      mutexclpo     : [po_external,po_interrupt,po_exports,po_overridingmethod]
1578
 
    ),(
1579
 
      idtok:_CPPDECL;
1580
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar];
1581
 
      handler  : nil;
1582
 
      pocall   : pocall_cppdecl;
1583
 
      pooption : [];
1584
 
      mutexclpocall : [];
1585
 
      mutexclpotype : [potype_constructor,potype_destructor];
1586
 
      mutexclpo     : [po_assembler,po_external,po_virtualmethod]
1587
 
    ),(
1588
 
      idtok:_VARARGS;
1589
 
      pd_flags : [pd_interface,pd_implemen,pd_procvar];
1590
 
      handler  : nil;
1591
 
      pocall   : pocall_none;
1592
 
      pooption : [po_varargs];
1593
 
      mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register,
1594
 
                       pocall_inline,pocall_far16,pocall_oldfpccall];
1595
 
      mutexclpotype : [];
1596
 
      mutexclpo     : [po_assembler,po_interrupt]
1597
 
    ),(
1598
 
      idtok:_COMPILERPROC;
1599
 
      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf];
1600
 
      handler  : nil;
1601
 
      pocall   : pocall_compilerproc;
1602
 
      pooption : [];
1603
 
      mutexclpocall : [];
1604
 
      mutexclpotype : [potype_constructor,potype_destructor];
1605
 
      mutexclpo     : [po_interrupt]
1606
 
    )
1607
 
   );
1608
 
 
1609
 
 
1610
 
    function is_proc_directive(tok:ttoken;isprocvar:boolean):boolean;
1611
 
      var
1612
 
        i : longint;
1613
 
      begin
1614
 
        is_proc_directive:=false;
1615
 
        for i:=1 to num_proc_directives do
1616
 
         if proc_direcdata[i].idtok=idtoken then
1617
 
          begin
1618
 
            if (not isprocvar) or
1619
 
               (pd_procvar in proc_direcdata[i].pd_flags) then
1620
 
              is_proc_directive:=true;
1621
 
            exit;
1622
 
          end;
1623
 
      end;
1624
 
 
1625
 
 
1626
 
    function parse_proc_direc(pd:tabstractprocdef;var pdflags:tpdflags):boolean;
1627
 
      {
1628
 
        Parse the procedure directive, returns true if a correct directive is found
1629
 
      }
1630
 
      var
1631
 
        p     : longint;
1632
 
        found : boolean;
1633
 
        name  : stringid;
1634
 
      begin
1635
 
        parse_proc_direc:=false;
1636
 
        name:=tokeninfo^[idtoken].str;
1637
 
        found:=false;
1638
 
 
1639
 
      { Hint directive? Then exit immediatly }
1640
 
        if (m_hintdirective in aktmodeswitches) then
1641
 
         begin
1642
 
           case idtoken of
1643
 
             _LIBRARY,
1644
 
             _PLATFORM,
1645
 
             _UNIMPLEMENTED,
1646
 
             _DEPRECATED :
1647
 
               exit;
1648
 
           end;
1649
 
         end;
1650
 
 
1651
 
        { C directive is MAC only, because it breaks too much existing code
1652
 
          on other platforms (PFV) }
1653
 
        if (idtoken=_C) and
1654
 
           not(m_mac in aktmodeswitches) then
1655
 
          exit;
1656
 
 
1657
 
      { retrieve data for directive if found }
1658
 
        for p:=1 to num_proc_directives do
1659
 
         if proc_direcdata[p].idtok=idtoken then
1660
 
          begin
1661
 
            found:=true;
1662
 
            break;
1663
 
          end;
1664
 
 
1665
 
      { Check if the procedure directive is known }
1666
 
        if not found then
1667
 
         begin
1668
 
            { parsing a procvar type the name can be any
1669
 
              next variable !! }
1670
 
            if (pdflags * [pd_procvar,pd_object])=[] then
1671
 
              Message1(parser_w_unknown_proc_directive_ignored,name);
1672
 
            exit;
1673
 
         end;
1674
 
 
1675
 
        { static needs a special treatment }
1676
 
        if (idtoken=_STATIC) and not (cs_static_keyword in aktmoduleswitches) then
1677
 
          exit;
1678
 
 
1679
 
      { Conflicts between directives ? }
1680
 
        if (pd.proctypeoption in proc_direcdata[p].mutexclpotype) or
1681
 
           (pd.proccalloption in proc_direcdata[p].mutexclpocall) or
1682
 
           ((pd.procoptions*proc_direcdata[p].mutexclpo)<>[]) then
1683
 
         begin
1684
 
           Message1(parser_e_proc_dir_conflict,name);
1685
 
           exit;
1686
 
         end;
1687
 
 
1688
 
      { set calling convention }
1689
 
        if proc_direcdata[p].pocall<>pocall_none then
1690
 
         begin
1691
 
           if (po_hascallingconvention in pd.procoptions) then
1692
 
            begin
1693
 
              Message2(parser_w_proc_overriding_calling,
1694
 
                proccalloptionStr[pd.proccalloption],
1695
 
                proccalloptionStr[proc_direcdata[p].pocall]);
1696
 
            end;
1697
 
           { check if the target processor supports this calling convention }
1698
 
           if not(proc_direcdata[p].pocall in supported_calling_conventions) then
1699
 
             begin
1700
 
               Message1(parser_e_illegal_calling_convention,proccalloptionStr[proc_direcdata[p].pocall]);
1701
 
               { recover }
1702
 
               proc_direcdata[p].pocall:=pocall_stdcall;
1703
 
             end;
1704
 
           pd.proccalloption:=proc_direcdata[p].pocall;
1705
 
           include(pd.procoptions,po_hascallingconvention);
1706
 
         end;
1707
 
 
1708
 
        { check if method and directive not for object, like public.
1709
 
          This needs to be checked also for procvars }
1710
 
        if (pd_notobject in proc_direcdata[p].pd_flags) and
1711
 
           (pd.owner.symtabletype=objectsymtable) then
1712
 
           exit;
1713
 
 
1714
 
        if pd.deftype=procdef then
1715
 
         begin
1716
 
           { Check if the directive is only for objects }
1717
 
           if (pd_object in proc_direcdata[p].pd_flags) and
1718
 
              not assigned(tprocdef(pd)._class) then
1719
 
            exit;
1720
 
 
1721
 
           { check if method and directive not for interface }
1722
 
           if (pd_notobjintf in proc_direcdata[p].pd_flags) and
1723
 
              is_interface(tprocdef(pd)._class) then
1724
 
            exit;
1725
 
         end;
1726
 
 
1727
 
        { consume directive, and turn flag on }
1728
 
        consume(token);
1729
 
        parse_proc_direc:=true;
1730
 
 
1731
 
        { Check the pd_flags if the directive should be allowed }
1732
 
        if (pd_interface in pdflags) and
1733
 
           not(pd_interface in proc_direcdata[p].pd_flags) then
1734
 
          begin
1735
 
            Message1(parser_e_proc_dir_not_allowed_in_interface,name);
1736
 
            exit;
1737
 
          end;
1738
 
        if (pd_implemen in pdflags) and
1739
 
           not(pd_implemen in proc_direcdata[p].pd_flags) then
1740
 
          begin
1741
 
            Message1(parser_e_proc_dir_not_allowed_in_implementation,name);
1742
 
            exit;
1743
 
          end;
1744
 
        if (pd_procvar in pdflags) and
1745
 
           not(pd_procvar in proc_direcdata[p].pd_flags) then
1746
 
          begin
1747
 
            Message1(parser_e_proc_dir_not_allowed_in_procvar,name);
1748
 
            exit;
1749
 
          end;
1750
 
 
1751
 
        { Return the new pd_flags }
1752
 
        if not(pd_body in proc_direcdata[p].pd_flags) then
1753
 
          exclude(pdflags,pd_body);
1754
 
 
1755
 
        { Add the correct flag }
1756
 
        pd.procoptions:=pd.procoptions+proc_direcdata[p].pooption;
1757
 
 
1758
 
        { Call the handler }
1759
 
        if pointer({$ifndef FPCPROCVAR}@{$endif}proc_direcdata[p].handler)<>nil then
1760
 
          proc_direcdata[p].handler(pd);
1761
 
      end;
1762
 
 
1763
 
 
1764
 
    procedure handle_calling_convention(pd:tabstractprocdef);
1765
 
      begin
1766
 
        { set the default calling convention if none provided }
1767
 
        if not(po_hascallingconvention in pd.procoptions) then
1768
 
          pd.proccalloption:=aktdefproccall
1769
 
        else
1770
 
          begin
1771
 
            if pd.proccalloption=pocall_none then
1772
 
              internalerror(200309081);
1773
 
          end;
1774
 
 
1775
 
        { handle proccall specific settings }
1776
 
        case pd.proccalloption of
1777
 
          pocall_cdecl :
1778
 
            begin
1779
 
              { set mangledname }
1780
 
              if (pd.deftype=procdef) then
1781
 
               begin
1782
 
                 if not tprocdef(pd).has_mangledname then
1783
 
                  begin
1784
 
                    if assigned(tprocdef(pd)._class) then
1785
 
                     tprocdef(pd).setmangledname(target_info.Cprefix+tprocdef(pd)._class.objrealname^+'_'+tprocdef(pd).procsym.realname)
1786
 
                    else
1787
 
                     tprocdef(pd).setmangledname(target_info.Cprefix+tprocdef(pd).procsym.realname);
1788
 
                  end;
1789
 
                 { check C cdecl para types }
1790
 
                 pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
1791
 
               end;
1792
 
            end;
1793
 
          pocall_cppdecl :
1794
 
            begin
1795
 
              { set mangledname }
1796
 
              if (pd.deftype=procdef) then
1797
 
               begin
1798
 
                 if not tprocdef(pd).has_mangledname then
1799
 
                  tprocdef(pd).setmangledname(target_info.Cprefix+tprocdef(pd).cplusplusmangledname);
1800
 
                 { check C cdecl para types }
1801
 
                 pd.parast.foreach_static({$ifdef FPCPROCVAR}@{$endif}check_c_para,nil);
1802
 
               end;
1803
 
            end;
1804
 
          pocall_compilerproc :
1805
 
            begin
1806
 
              if (pd.deftype<>procdef) then
1807
 
               internalerror(200110232);
1808
 
              if (target_info.system<>system_i386_watcom) then
1809
 
                tprocdef(pd).setmangledname(lower(tprocdef(pd).procsym.name));
1810
 
            end;
1811
 
          pocall_far16 :
1812
 
            begin
1813
 
              { Temporary stub, must be rewritten to support OS/2 far16 }
1814
 
              Message1(parser_w_proc_directive_ignored,'FAR16');
1815
 
            end;
1816
 
          pocall_inline :
1817
 
            begin
1818
 
              if not(cs_support_inline in aktmoduleswitches) then
1819
 
               begin
1820
 
                 Message(parser_e_proc_inline_not_supported);
1821
 
                 pd.proccalloption:=pocall_default;
1822
 
               end;
1823
 
            end;
1824
 
        end;
1825
 
 
1826
 
        { For varargs directive also cdecl and external must be defined }
1827
 
        if (po_varargs in pd.procoptions) then
1828
 
         begin
1829
 
           { check first for external in the interface, if available there
1830
 
             then the cdecl must also be there since there is no implementation
1831
 
             available to contain it }
1832
 
           if parse_only then
1833
 
            begin
1834
 
              { if external is available, then cdecl must also be available,
1835
 
                procvars don't need external }
1836
 
              if not((po_external in pd.procoptions) or
1837
 
                     (pd.deftype=procvardef)) and
1838
 
                 not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
1839
 
                Message(parser_e_varargs_need_cdecl_and_external);
1840
 
            end
1841
 
           else
1842
 
            begin
1843
 
              { both must be defined now }
1844
 
              if not((po_external in pd.procoptions) or
1845
 
                     (pd.deftype=procvardef)) or
1846
 
                 not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
1847
 
                Message(parser_e_varargs_need_cdecl_and_external);
1848
 
            end;
1849
 
         end;
1850
 
 
1851
 
        { add mangledname to external list }
1852
 
        if (pd.deftype=procdef) and
1853
 
           (po_external in pd.procoptions) and
1854
 
           target_info.DllScanSupported then
1855
 
          current_module.externals.insert(tExternalsItem.create(tprocdef(pd).mangledname));
1856
 
      end;
1857
 
 
1858
 
 
1859
 
    procedure calc_parast(pd:tabstractprocdef);
1860
 
      var
1861
 
        currpara : tparaitem;
1862
 
      begin
1863
 
        { insert hidden high parameters }
1864
 
        insert_hidden_para(pd);
1865
 
        { insert hidden self parameter }
1866
 
        insert_self_and_vmt_para(pd);
1867
 
        { insert funcret parameter if required }
1868
 
        insert_funcret_para(pd);
1869
 
        { insert parentfp parameter if required }
1870
 
        insert_parentfp_para(pd);
1871
 
 
1872
 
        currpara:=tparaitem(pd.para.first);
1873
 
        while assigned(currpara) do
1874
 
         begin
1875
 
           if not(assigned(currpara.parasym) and (currpara.parasym.typ=varsym)) then
1876
 
             internalerror(200304232);
1877
 
           { connect parasym to paraitem }
1878
 
           tvarsym(currpara.parasym).paraitem:=currpara;
1879
 
           { We need a local copy for a value parameter when only the
1880
 
             address is pushed. Open arrays and Array of Const are
1881
 
             an exception because they are allocated at runtime and the
1882
 
             address that is pushed is patched }
1883
 
           if (currpara.paratyp=vs_value) and
1884
 
              paramanager.push_addr_param(currpara.paratyp,currpara.paratype.def,pd.proccalloption) and
1885
 
              not(is_open_array(currpara.paratype.def) or
1886
 
                  is_array_of_const(currpara.paratype.def)) then
1887
 
             include(tvarsym(currpara.parasym).varoptions,vo_has_local_copy);
1888
 
           currpara:=tparaitem(currpara.next);
1889
 
         end;
1890
 
      end;
1891
 
 
1892
 
 
1893
 
 
1894
 
    procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
1895
 
      {
1896
 
        Parse the procedure directives. It does not matter if procedure directives
1897
 
        are written using ;procdir; or ['procdir'] syntax.
1898
 
      }
1899
 
      var
1900
 
        res : boolean;
1901
 
      begin
1902
 
        while token in [_ID,_LECKKLAMMER] do
1903
 
         begin
1904
 
           if try_to_consume(_LECKKLAMMER) then
1905
 
            begin
1906
 
              repeat
1907
 
                parse_proc_direc(pd,pdflags);
1908
 
              until not try_to_consume(_COMMA);
1909
 
              consume(_RECKKLAMMER);
1910
 
              { we always expect at least '[];' }
1911
 
              res:=true;
1912
 
            end
1913
 
           else
1914
 
            begin
1915
 
              res:=parse_proc_direc(pd,pdflags);
1916
 
            end;
1917
 
           { A procedure directive normally followed by a semicolon, but in
1918
 
             a const section or reading a type we should stop when _EQUAL is found,
1919
 
             because a constant/default value follows }
1920
 
           if res then
1921
 
            begin
1922
 
              if (block_type in [bt_const,bt_type]) and
1923
 
                 (token=_EQUAL) then
1924
 
               break;
1925
 
              { support procedure proc;stdcall export; }
1926
 
              if not(is_proc_directive(token,(pd.deftype=procvardef))) then
1927
 
               consume(_SEMICOLON);
1928
 
            end
1929
 
           else
1930
 
            break;
1931
 
         end;
1932
 
      end;
1933
 
 
1934
 
 
1935
 
    procedure parse_var_proc_directives(sym:tsym);
1936
 
      var
1937
 
        pdflags : tpdflags;
1938
 
        pd      : tabstractprocdef;
1939
 
      begin
1940
 
        pdflags:=[pd_procvar];
1941
 
        pd:=nil;
1942
 
        case sym.typ of
1943
 
          varsym :
1944
 
            pd:=tabstractprocdef(tvarsym(sym).vartype.def);
1945
 
          typedconstsym :
1946
 
            pd:=tabstractprocdef(ttypedconstsym(sym).typedconsttype.def);
1947
 
          typesym :
1948
 
            pd:=tabstractprocdef(ttypesym(sym).restype.def);
1949
 
          else
1950
 
            internalerror(2003042617);
1951
 
        end;
1952
 
        if pd.deftype<>procvardef then
1953
 
          internalerror(2003042618);
1954
 
        { names should never be used anyway }
1955
 
        parse_proc_directives(pd,pdflags);
1956
 
      end;
1957
 
 
1958
 
 
1959
 
    procedure parse_object_proc_directives(pd:tabstractprocdef);
1960
 
      var
1961
 
        pdflags : tpdflags;
1962
 
      begin
1963
 
        pdflags:=[pd_object];
1964
 
        parse_proc_directives(pd,pdflags);
1965
 
      end;
1966
 
 
1967
 
 
1968
 
    function proc_add_definition(var pd:tprocdef):boolean;
1969
 
      {
1970
 
        Add definition aprocdef to the overloaded definitions of aprocsym. If a
1971
 
        forwarddef is found and reused it returns true
1972
 
      }
1973
 
      var
1974
 
        hd    : tprocdef;
1975
 
        ad,fd : tsym;
1976
 
        s1,s2 : stringid;
1977
 
        i     : cardinal;
1978
 
        forwardfound : boolean;
1979
 
        po_comp : tprocoptions;
1980
 
        aprocsym : tprocsym;
1981
 
      begin
1982
 
        forwardfound:=false;
1983
 
        aprocsym:=tprocsym(pd.procsym);
1984
 
 
1985
 
        { check overloaded functions if the same function already exists }
1986
 
        for i:=1 to aprocsym.procdef_count do
1987
 
         begin
1988
 
           hd:=aprocsym.procdef[i];
1989
 
 
1990
 
           { Skip overloaded definitions that are declared in other
1991
 
             units }
1992
 
           if hd.procsym<>aprocsym then
1993
 
             continue;
1994
 
 
1995
 
           { check the parameters, for delphi/tp it is possible to
1996
 
             leave the parameters away in the implementation (forwarddef=false).
1997
 
             But for an overload declared function this is not allowed }
1998
 
           if { check if empty implementation arguments match is allowed }
1999
 
              (
2000
 
               not(m_repeat_forward in aktmodeswitches) and
2001
 
               not(pd.forwarddef) and
2002
 
               (pd.maxparacount=0) and
2003
 
               not(po_overload in hd.procoptions)
2004
 
              ) or
2005
 
              { check arguments }
2006
 
              (
2007
 
               (compare_paras(pd.para,hd.para,cp_none,[cpo_comparedefaultvalue])>=te_equal) and
2008
 
               { for operators equal_paras is not enough !! }
2009
 
               ((pd.proctypeoption<>potype_operator) or (optoken<>_ASSIGNMENT) or
2010
 
                equal_defs(hd.rettype.def,pd.rettype.def))
2011
 
              ) then
2012
 
             begin
2013
 
               { Check if we've found the forwarddef, if found then
2014
 
                 we need to update the forward def with the current
2015
 
                 implementation settings }
2016
 
               if hd.forwarddef then
2017
 
                 begin
2018
 
                   forwardfound:=true;
2019
 
 
2020
 
                   { Check if the procedure type and return type are correct,
2021
 
                     also the parameters must match also with the type }
2022
 
                   if (hd.proctypeoption<>pd.proctypeoption) or
2023
 
                      (
2024
 
                       (m_repeat_forward in aktmodeswitches) and
2025
 
                       (not((pd.maxparacount=0) or
2026
 
                            (compare_paras(pd.para,hd.para,cp_all,[cpo_comparedefaultvalue])>=te_equal)))
2027
 
                      ) or
2028
 
                      (
2029
 
                       ((m_repeat_forward in aktmodeswitches) or
2030
 
                        not(is_void(pd.rettype.def))) and
2031
 
                       (not equal_defs(hd.rettype.def,pd.rettype.def))) then
2032
 
                     begin
2033
 
                       MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,
2034
 
                                   pd.fullprocname(false));
2035
 
                       aprocsym.write_parameter_lists(pd);
2036
 
                       break;
2037
 
                     end;
2038
 
 
2039
 
                   { Check if both are declared forward }
2040
 
                   if hd.forwarddef and pd.forwarddef then
2041
 
                    begin
2042
 
                      MessagePos1(pd.fileinfo,parser_e_function_already_declared_public_forward,
2043
 
                                  pd.fullprocname(false));
2044
 
                    end;
2045
 
 
2046
 
                   { internconst or internproc only need to be defined once }
2047
 
                   if (hd.proccalloption=pocall_internproc) then
2048
 
                    pd.proccalloption:=hd.proccalloption
2049
 
                   else
2050
 
                    if (pd.proccalloption=pocall_internproc) then
2051
 
                     hd.proccalloption:=pd.proccalloption;
2052
 
                   if (po_internconst in hd.procoptions) then
2053
 
                    include(pd.procoptions,po_internconst)
2054
 
                   else if (po_internconst in pd.procoptions) then
2055
 
                    include(hd.procoptions,po_internconst);
2056
 
 
2057
 
                   { Check calling convention }
2058
 
                   if (hd.proccalloption<>pd.proccalloption) then
2059
 
                    begin
2060
 
                      { In delphi it is possible to specify the calling
2061
 
                        convention in the interface or implementation if
2062
 
                        there was no convention specified in the other
2063
 
                        part }
2064
 
                      if (m_delphi in aktmodeswitches) then
2065
 
                       begin
2066
 
                         if not(po_hascallingconvention in pd.procoptions) then
2067
 
                          pd.proccalloption:=hd.proccalloption
2068
 
                         else
2069
 
                          if not(po_hascallingconvention in hd.procoptions) then
2070
 
                           hd.proccalloption:=pd.proccalloption
2071
 
                         else
2072
 
                          begin
2073
 
                            MessagePos(pd.fileinfo,parser_e_call_convention_dont_match_forward);
2074
 
                            aprocsym.write_parameter_lists(pd);
2075
 
                            { restore interface settings }
2076
 
                            pd.proccalloption:=hd.proccalloption;
2077
 
                          end;
2078
 
                       end
2079
 
                      else
2080
 
                       begin
2081
 
                         MessagePos(pd.fileinfo,parser_e_call_convention_dont_match_forward);
2082
 
                         aprocsym.write_parameter_lists(pd);
2083
 
                         { restore interface settings }
2084
 
                         pd.proccalloption:=hd.proccalloption;
2085
 
                       end;
2086
 
                    end;
2087
 
 
2088
 
                   { Check procedure options, Delphi requires that class is
2089
 
                     repeated in the implementation for class methods }
2090
 
                   if (m_fpc in aktmodeswitches) then
2091
 
                     po_comp:=[po_varargs,po_methodpointer,po_interrupt]
2092
 
                   else
2093
 
                     po_comp:=[po_classmethod,po_methodpointer];
2094
 
 
2095
 
                   if ((po_comp * hd.procoptions)<>(po_comp * pd.procoptions)) then
2096
 
                     begin
2097
 
                       MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,
2098
 
                                   pd.fullprocname(false));
2099
 
                       aprocsym.write_parameter_lists(pd);
2100
 
                       { This error is non-fatal, we can recover }
2101
 
                     end;
2102
 
 
2103
 
                   { Check manglednames }
2104
 
                   if (m_repeat_forward in aktmodeswitches) or
2105
 
                      (pd.minparacount>0) then
2106
 
                    begin
2107
 
                      { If mangled names are equal then they have the same amount of arguments }
2108
 
                      { We can check the names of the arguments }
2109
 
                      { both symtables are in the same order from left to right }
2110
 
                      ad:=tsym(hd.parast.symindex.first);
2111
 
                      fd:=tsym(pd.parast.symindex.first);
2112
 
                      repeat
2113
 
                        { skip default parameter constsyms }
2114
 
                        while assigned(ad) and (ad.typ<>varsym) do
2115
 
                         ad:=tsym(ad.indexnext);
2116
 
                        while assigned(fd) and (fd.typ<>varsym) do
2117
 
                         fd:=tsym(fd.indexnext);
2118
 
                        { stop when one of the two lists is at the end }
2119
 
                        if not assigned(ad) or not assigned(fd) then
2120
 
                         break;
2121
 
                        { retrieve names, remove reg for register parameters }
2122
 
                        s1:=ad.name;
2123
 
                        s2:=fd.name;
2124
 
                        { compare names }
2125
 
                        if (s1<>s2) then
2126
 
                         begin
2127
 
                           MessagePos3(pd.fileinfo,parser_e_header_different_var_names,
2128
 
                                       aprocsym.name,s1,s2);
2129
 
                           break;
2130
 
                         end;
2131
 
                        ad:=tsym(ad.indexnext);
2132
 
                        fd:=tsym(fd.indexnext);
2133
 
                      until false;
2134
 
                      if assigned(ad) xor assigned(fd) then
2135
 
                        internalerror(200204178);
2136
 
                    end;
2137
 
 
2138
 
                   { Everything is checked, now we can update the forward declaration
2139
 
                     with the new data from the implementation }
2140
 
                   hd.forwarddef:=pd.forwarddef;
2141
 
                   hd.hasforward:=true;
2142
 
                   hd.procoptions:=hd.procoptions+pd.procoptions;
2143
 
                   if hd.extnumber=65535 then
2144
 
                     hd.extnumber:=pd.extnumber;
2145
 
                   while not pd.aliasnames.empty do
2146
 
                    hd.aliasnames.insert(pd.aliasnames.getfirst);
2147
 
                   { update fileinfo so position references the implementation,
2148
 
                     also update funcretsym if it is already generated }
2149
 
                   hd.fileinfo:=pd.fileinfo;
2150
 
                   if assigned(hd.funcretsym) then
2151
 
                     hd.funcretsym.fileinfo:=pd.fileinfo;
2152
 
                   { update mangledname if the implementation has a fixed mangledname set }
2153
 
                   if pd.has_mangledname then
2154
 
                    begin
2155
 
                      { rename also asmsymbol first, because the name can already be used }
2156
 
                      objectlibrary.renameasmsymbol(hd.mangledname,pd.mangledname);
2157
 
                      hd.setmangledname(pd.mangledname);
2158
 
                    end;
2159
 
                   { for compilerproc defines we need to rename and update the
2160
 
                     symbolname to lowercase }
2161
 
                   if (pd.proccalloption=pocall_compilerproc) then
2162
 
                    begin
2163
 
                      { rename to lowercase so users can't access it }
2164
 
                      aprocsym.owner.rename(aprocsym.name,lower(aprocsym.name));
2165
 
                      { also update the realname that is stored in the ppu }
2166
 
                      stringdispose(aprocsym._realname);
2167
 
                      aprocsym._realname:=stringdup('$'+aprocsym.name);
2168
 
                      { the mangeled name is already changed by the pd_compilerproc }
2169
 
                      { handler. It must be done immediately because if we have a   }
2170
 
                      { call to a compilerproc before it's implementation is        }
2171
 
                      { encountered, it must already use the new mangled name (JM)  }
2172
 
                    end;
2173
 
 
2174
 
                   { the procdef will be released by the symtable, we release
2175
 
                     at least the parast }
2176
 
                   pd.releasemem;
2177
 
                   pd:=hd;
2178
 
                 end
2179
 
               else
2180
 
                begin
2181
 
                  { abstract methods aren't forward defined, but this }
2182
 
                  { needs another error message                   }
2183
 
                  if (po_abstractmethod in hd.procoptions) then
2184
 
                    MessagePos(pd.fileinfo,parser_e_abstract_no_definition)
2185
 
                  else
2186
 
                    MessagePos(pd.fileinfo,parser_e_overloaded_have_same_parameters);
2187
 
                 end;
2188
 
 
2189
 
               { we found one proc with the same arguments, there are no others
2190
 
                 so we can stop }
2191
 
               break;
2192
 
             end;
2193
 
 
2194
 
           { check for allowing overload directive }
2195
 
           if not(m_fpc in aktmodeswitches) then
2196
 
            begin
2197
 
              { overload directive turns on overloading }
2198
 
              if ((po_overload in pd.procoptions) or
2199
 
                  (po_overload in hd.procoptions)) then
2200
 
               begin
2201
 
                 { check if all procs have overloading, but not if the proc is a method or
2202
 
                   already declared forward, then the check is already done }
2203
 
                 if not(hd.hasforward or
2204
 
                        assigned(pd._class) or
2205
 
                        (pd.forwarddef<>hd.forwarddef) or
2206
 
                        ((po_overload in pd.procoptions) and
2207
 
                         (po_overload in hd.procoptions))) then
2208
 
                  begin
2209
 
                    MessagePos1(pd.fileinfo,parser_e_no_overload_for_all_procs,aprocsym.realname);
2210
 
                    break;
2211
 
                  end;
2212
 
               end
2213
 
              else
2214
 
               begin
2215
 
                 if not(hd.forwarddef) then
2216
 
                  begin
2217
 
                    MessagePos(pd.fileinfo,parser_e_procedure_overloading_is_off);
2218
 
                    break;
2219
 
                  end;
2220
 
               end;
2221
 
            end; { equal arguments }
2222
 
         end;
2223
 
 
2224
 
        { if we didn't reuse a forwarddef then we add the procdef to the overloaded
2225
 
          list }
2226
 
        if not forwardfound then
2227
 
         begin
2228
 
           aprocsym.addprocdef(pd);
2229
 
           { add overloadnumber for unique naming, the overloadcount is
2230
 
             counted per module and 0 for the first procedure }
2231
 
           pd.overloadnumber:=aprocsym.overloadcount;
2232
 
           inc(aprocsym.overloadcount);
2233
 
         end;
2234
 
 
2235
 
        proc_add_definition:=forwardfound;
2236
 
      end;
2237
 
 
2238
 
end.
2239
 
{
2240
 
  $Log: pdecsub.pas,v $
2241
 
  Revision 1.180  2004/05/23 20:54:39  peter
2242
 
    * fixed 3114
2243
 
 
2244
 
  Revision 1.179  2004/05/23 19:06:26  peter
2245
 
    * expect : after function when it is a forwarddef
2246
 
 
2247
 
  Revision 1.178  2004/05/12 13:21:09  karoly
2248
 
    * few small changes to add syscall support to M68k/Amiga target
2249
 
 
2250
 
  Revision 1.177  2004/05/11 22:52:48  olle
2251
 
    * Moved import_implicit_external to symsym
2252
 
 
2253
 
  Revision 1.176  2004/05/11 18:29:41  olle
2254
 
    + mode macpas: support for implicit external
2255
 
 
2256
 
  Revision 1.175  2004/05/11 06:59:35  michael
2257
 
  + Patch from peter to hide system unit as symbol
2258
 
 
2259
 
  Revision 1.174  2004/05/09 12:49:14  peter
2260
 
  C directive is mac only
2261
 
 
2262
 
  Revision 1.173  2004/05/03 20:02:42  jonas
2263
 
    - removed change_forward_to_external() declaration
2264
 
 
2265
 
  Revision 1.172  2004/05/03 10:06:38  olle
2266
 
    + added language constructs UNIV, C, ... for mode mac
2267
 
    * consolidated macro expression to conform to Pascal
2268
 
    * macro true is defined as <> 0
2269
 
 
2270
 
  Revision 1.171  2004/05/01 22:38:13  florian
2271
 
    * fixed MorphOS syscall without parameters
2272
 
 
2273
 
  Revision 1.170  2004/05/01 22:05:01  florian
2274
 
    + added lib support for Amiga/MorphOS syscalls
2275
 
 
2276
 
  Revision 1.169  2004/04/29 21:10:13  florian
2277
 
    + locationstr always reset
2278
 
 
2279
 
  Revision 1.168  2004/04/28 15:19:03  florian
2280
 
    + syscall directive support for MorphOS added
2281
 
 
2282
 
  Revision 1.167  2004/04/28 00:20:43  karoly
2283
 
    * fixed locationstr having nonsense values in some cases
2284
 
 
2285
 
  Revision 1.166  2004/04/19 02:12:18  karoly
2286
 
   * quick fix for PowerPC/MorphOS location support
2287
 
 
2288
 
  Revision 1.165  2004/04/18 15:22:24  florian
2289
 
    + location support for arguments, currently PowerPC/MorphOS only
2290
 
 
2291
 
  Revision 1.164  2004/02/26 16:13:25  peter
2292
 
    * fix crash when method is not declared in object declaration
2293
 
    * fix parsing of mapped interface functions
2294
 
 
2295
 
  Revision 1.163  2004/02/20 21:54:47  peter
2296
 
    * use sp_internal flag to silence unused internal variable
2297
 
 
2298
 
  Revision 1.162  2004/02/13 15:41:24  peter
2299
 
    * overload directive checking for methods is now done
2300
 
      when the vmt is generated
2301
 
 
2302
 
  Revision 1.161  2004/02/05 14:13:53  daniel
2303
 
    *  Tvarsym.highvarsym removed
2304
 
 
2305
 
  Revision 1.160  2004/02/04 22:54:57  daniel
2306
 
    * Tvarsym.highvarsym commented out (unused by compiler, purpose unknown)
2307
 
 
2308
 
  Revision 1.159  2004/02/04 22:15:15  daniel
2309
 
    * Rtti generation moved to ncgutil
2310
 
    * Assmtai usage of symsym removed
2311
 
    * operator overloading cleanup up
2312
 
 
2313
 
  Revision 1.158  2004/02/03 22:32:54  peter
2314
 
    * renamed xNNbittype to xNNinttype
2315
 
    * renamed registers32 to registersint
2316
 
    * replace some s32bit,u32bit with torddef([su]inttype).def.typ
2317
 
 
2318
 
  Revision 1.157  2004/01/31 17:45:17  peter
2319
 
    * Change several $ifdef i386 to x86
2320
 
    * Change several OS_32 to OS_INT/OS_ADDR
2321
 
 
2322
 
  Revision 1.156  2004/01/21 14:22:00  florian
2323
 
    + reintroduce implemented
2324
 
 
2325
 
  Revision 1.155  2003/11/23 17:05:15  peter
2326
 
    * register calling is left-right
2327
 
    * parameter ordering
2328
 
    * left-right calling inserts result parameter last
2329
 
 
2330
 
  Revision 1.154  2003/11/12 15:49:06  peter
2331
 
    * virtual conflicts with override
2332
 
 
2333
 
  Revision 1.153  2003/11/10 19:09:29  peter
2334
 
    * procvar default value support
2335
 
 
2336
 
  Revision 1.152  2003/11/07 15:58:32  florian
2337
 
    * Florian's culmutative nr. 1; contains:
2338
 
      - invalid calling conventions for a certain cpu are rejected
2339
 
      - arm softfloat calling conventions
2340
 
      - -Sp for cpu dependend code generation
2341
 
      - several arm fixes
2342
 
      - remaining code for value open array paras on heap
2343
 
 
2344
 
  Revision 1.151  2003/11/03 17:47:30  peter
2345
 
    * insert framepointer as voidpointer instead of returntype
2346
 
 
2347
 
  Revision 1.150  2003/10/30 16:23:13  peter
2348
 
    * don't search for overloads in parents for constructors
2349
 
 
2350
 
  Revision 1.149  2003/10/28 15:36:01  peter
2351
 
    * absolute to object field supported, fixes tb0458
2352
 
 
2353
 
  Revision 1.148  2003/10/07 21:14:33  peter
2354
 
    * compare_paras() has a parameter to ignore hidden parameters
2355
 
    * cross unit overload searching ignores hidden parameters when
2356
 
      comparing parameter lists. Now function(string):string is
2357
 
      not overriden with procedure(string) which has the same visible
2358
 
      parameter list
2359
 
 
2360
 
  Revision 1.147  2003/10/07 20:52:54  peter
2361
 
    * procvar varargs fixed
2362
 
 
2363
 
  Revision 1.146  2003/10/05 21:21:52  peter
2364
 
    * c style array of const generates callparanodes
2365
 
    * varargs paraloc fixes
2366
 
 
2367
 
  Revision 1.145  2003/10/05 11:10:52  peter
2368
 
    * temporary fix for compilerprocs on watcom
2369
 
 
2370
 
  Revision 1.144  2003/10/03 22:00:33  peter
2371
 
    * parameter alignment fixes
2372
 
 
2373
 
  Revision 1.143  2003/10/02 21:13:09  peter
2374
 
    * procvar directive parsing fixes
2375
 
 
2376
 
  Revision 1.142  2003/10/01 19:05:33  peter
2377
 
    * searchsym_type to search for type definitions. It ignores
2378
 
      records,objects and parameters
2379
 
 
2380
 
  Revision 1.141  2003/10/01 18:28:55  peter
2381
 
    * don't look in objectsymtable when parsing the function return type
2382
 
 
2383
 
  Revision 1.140  2003/10/01 16:49:05  florian
2384
 
    * para items are now reversed for pascal calling conventions
2385
 
 
2386
 
  Revision 1.139  2003/09/28 21:44:55  peter
2387
 
    * fix check that filedef needs var para
2388
 
 
2389
 
  Revision 1.138  2003/09/28 17:55:04  peter
2390
 
    * parent framepointer changed to hidden parameter
2391
 
    * tloadparentfpnode added
2392
 
 
2393
 
  Revision 1.137  2003/09/25 21:24:09  peter
2394
 
    * don't include vo_has_local_copy for open array/array of const
2395
 
 
2396
 
  Revision 1.136  2003/09/23 20:36:47  peter
2397
 
    * remove obsolete code
2398
 
 
2399
 
  Revision 1.135  2003/09/23 17:56:05  peter
2400
 
    * locals and paras are allocated in the code generation
2401
 
    * tvarsym.localloc contains the location of para/local when
2402
 
      generating code for the current procedure
2403
 
 
2404
 
  Revision 1.134  2003/09/16 16:17:01  peter
2405
 
    * varspez in calls to push_addr_param
2406
 
 
2407
 
  Revision 1.133  2003/09/09 21:03:17  peter
2408
 
    * basics for x86 register calling
2409
 
 
2410
 
  Revision 1.132  2003/09/09 15:54:10  peter
2411
 
    * calling convention fix
2412
 
 
2413
 
  Revision 1.131  2003/09/07 22:09:35  peter
2414
 
    * preparations for different default calling conventions
2415
 
    * various RA fixes
2416
 
 
2417
 
  Revision 1.130  2003/09/03 11:18:37  florian
2418
 
    * fixed arm concatcopy
2419
 
    + arm support in the common compiler sources added
2420
 
    * moved some generic cg code around
2421
 
    + tfputype added
2422
 
    * ...
2423
 
 
2424
 
  Revision 1.129  2003/07/02 22:18:04  peter
2425
 
    * paraloc splitted in callerparaloc,calleeparaloc
2426
 
    * sparc calling convention updates
2427
 
 
2428
 
  Revision 1.128  2003/06/13 21:19:31  peter
2429
 
    * current_procdef removed, use current_procinfo.procdef instead
2430
 
 
2431
 
  Revision 1.127  2003/06/05 20:04:43  peter
2432
 
    * set po_public also when parsing the object declaration
2433
 
 
2434
 
  Revision 1.126  2003/06/02 21:42:05  jonas
2435
 
    * function results can now also be regvars
2436
 
    - removed tprocinfo.return_offset, never use it again since it's invalid
2437
 
      if the result is a regvar
2438
 
 
2439
 
  Revision 1.125  2003/05/22 21:31:35  peter
2440
 
    * defer codegeneration for nested procedures
2441
 
 
2442
 
  Revision 1.124  2003/05/15 18:58:53  peter
2443
 
    * removed selfpointer_offset, vmtpointer_offset
2444
 
    * tvarsym.adjusted_address
2445
 
    * address in localsymtable is now in the real direction
2446
 
    * removed some obsolete globals
2447
 
 
2448
 
  Revision 1.123  2003/05/13 15:18:49  peter
2449
 
    * fixed various crashes
2450
 
 
2451
 
  Revision 1.122  2003/05/09 17:47:03  peter
2452
 
    * self moved to hidden parameter
2453
 
    * removed hdisposen,hnewn,selfn
2454
 
 
2455
 
  Revision 1.121  2003/05/05 14:53:16  peter
2456
 
    * vs_hidden replaced by is_hidden boolean
2457
 
 
2458
 
  Revision 1.120  2003/04/30 09:42:42  florian
2459
 
    + first changes to make self a hidden parameter
2460
 
 
2461
 
  Revision 1.119  2003/04/27 11:21:33  peter
2462
 
    * aktprocdef renamed to current_procinfo.procdef
2463
 
    * procinfo renamed to current_procinfo
2464
 
    * procinfo will now be stored in current_module so it can be
2465
 
      cleaned up properly
2466
 
    * gen_main_procsym changed to create_main_proc and release_main_proc
2467
 
      to also generate a tprocinfo structure
2468
 
    * fixed unit implicit initfinal
2469
 
 
2470
 
  Revision 1.118  2003/04/27 07:29:50  peter
2471
 
    * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
2472
 
      a new procdef declaration
2473
 
    * aktprocsym removed
2474
 
    * lexlevel removed, use symtable.symtablelevel instead
2475
 
    * implicit init/final code uses the normal genentry/genexit
2476
 
    * funcret state checking updated for new funcret handling
2477
 
 
2478
 
  Revision 1.117  2003/04/26 00:33:07  peter
2479
 
    * vo_is_result flag added for the special RESULT symbol
2480
 
 
2481
 
  Revision 1.116  2003/04/25 20:59:33  peter
2482
 
    * removed funcretn,funcretsym, function result is now in varsym
2483
 
      and aliases for result and function name are added using absolutesym
2484
 
    * vs_hidden parameter for funcret passed in parameter
2485
 
    * vs_hidden fixes
2486
 
    * writenode changed to printnode and released from extdebug
2487
 
    * -vp option added to generate a tree.log with the nodetree
2488
 
    * nicer printnode for statements, callnode
2489
 
 
2490
 
  Revision 1.115  2003/04/24 13:03:01  florian
2491
 
    * comp is now written with its bit pattern to the ppu instead as an extended
2492
 
 
2493
 
  Revision 1.114  2003/04/23 13:12:26  peter
2494
 
    * fix po_comp setting for fpc mode
2495
 
 
2496
 
  Revision 1.113  2003/04/23 10:12:51  peter
2497
 
    * don't check po_varargs for delphi
2498
 
 
2499
 
  Revision 1.112  2003/04/22 13:47:08  peter
2500
 
    * fixed C style array of const
2501
 
    * fixed C array passing
2502
 
    * fixed left to right with high parameters
2503
 
 
2504
 
  Revision 1.111  2003/04/10 17:57:53  peter
2505
 
    * vs_hidden released
2506
 
 
2507
 
  Revision 1.110  2003/03/28 19:16:56  peter
2508
 
    * generic constructor working for i386
2509
 
    * remove fixed self register
2510
 
    * esi added as address register for i386
2511
 
 
2512
 
  Revision 1.109  2003/03/23 23:21:42  hajny
2513
 
    + emx target added
2514
 
 
2515
 
  Revision 1.108  2003/03/19 17:34:04  peter
2516
 
    * only allow class [procedure|function]
2517
 
 
2518
 
  Revision 1.107  2003/03/17 18:56:02  peter
2519
 
    * fix crash with duplicate id
2520
 
 
2521
 
  Revision 1.106  2003/03/17 15:54:22  peter
2522
 
    * store symoptions also for procdef
2523
 
    * check symoptions (private,public) when calculating possible
2524
 
      overload candidates
2525
 
 
2526
 
  Revision 1.105  2003/01/15 20:02:28  carl
2527
 
    * fix highname problem
2528
 
 
2529
 
  Revision 1.104  2003/01/12 15:42:23  peter
2530
 
    * m68k pathexist update from 1.0.x
2531
 
    * palmos res update from 1.0.x
2532
 
 
2533
 
  Revision 1.103  2003/01/07 19:16:38  peter
2534
 
    * removed some duplicate code when creating aktprocsym
2535
 
 
2536
 
  Revision 1.102  2003/01/05 18:17:45  peter
2537
 
    * more conflicts for constructor/destructor types
2538
 
 
2539
 
  Revision 1.100  2003/01/02 19:49:00  peter
2540
 
    * update self parameter only for methodpointer and methods
2541
 
 
2542
 
  Revision 1.99  2003/01/01 22:51:03  peter
2543
 
    * high value insertion changed so it works also when 2 parameters
2544
 
      are passed
2545
 
 
2546
 
  Revision 1.98  2003/01/01 14:35:33  peter
2547
 
    * don't check for export directive repeat
2548
 
 
2549
 
  Revision 1.97  2002/12/29 18:16:06  peter
2550
 
    * delphi allows setting calling convention in interface or
2551
 
      implementation
2552
 
 
2553
 
  Revision 1.96  2002/12/29 14:55:44  peter
2554
 
    * fix static method check
2555
 
    * don't require class for class methods in the implementation for
2556
 
      non delphi modes
2557
 
 
2558
 
  Revision 1.95  2002/12/27 15:25:14  peter
2559
 
    * check procoptions when a forward is found
2560
 
    * exclude some call directives for constructor/destructor
2561
 
 
2562
 
  Revision 1.94  2002/12/25 01:26:56  peter
2563
 
    * duplicate procsym-unitsym fix
2564
 
 
2565
 
  Revision 1.93  2002/12/24 21:21:06  peter
2566
 
    * remove code that skipped the _ prefix for win32 imports
2567
 
 
2568
 
  Revision 1.92  2002/12/23 21:24:22  peter
2569
 
    * fix wrong internalerror when var names were different
2570
 
 
2571
 
  Revision 1.91  2002/12/23 20:58:52  peter
2572
 
    * cdecl array fix, hack to change it to vs_var is not needed
2573
 
 
2574
 
  Revision 1.90  2002/12/17 22:19:33  peter
2575
 
    * fixed pushing of records>8 bytes with stdcall
2576
 
    * simplified hightree loading
2577
 
 
2578
 
  Revision 1.89  2002/12/15 21:07:30  peter
2579
 
    * don't allow external in object declarations
2580
 
 
2581
 
  Revision 1.88  2002/12/15 19:34:31  florian
2582
 
    + some front end stuff for vs_hidden added
2583
 
 
2584
 
  Revision 1.87  2002/12/07 14:27:07  carl
2585
 
    * 3% memory optimization
2586
 
    * changed some types
2587
 
    + added type checking with different size for call node and for
2588
 
       parameters
2589
 
 
2590
 
  Revision 1.86  2002/12/06 17:51:10  peter
2591
 
    * merged cdecl and array fixes
2592
 
 
2593
 
  Revision 1.85  2002/12/01 22:06:14  carl
2594
 
    * cleanup of error messages
2595
 
 
2596
 
  Revision 1.84  2002/11/29 22:31:19  carl
2597
 
    + unimplemented hint directive added
2598
 
    * hint directive parsing implemented
2599
 
    * warning on these directives
2600
 
 
2601
 
  Revision 1.83  2002/11/27 02:35:28  peter
2602
 
    * fixed typo in method comparing
2603
 
 
2604
 
  Revision 1.82  2002/11/25 17:43:21  peter
2605
 
    * splitted defbase in defutil,symutil,defcmp
2606
 
    * merged isconvertable and is_equal into compare_defs(_ext)
2607
 
    * made operator search faster by walking the list only once
2608
 
 
2609
 
  Revision 1.81  2002/11/18 17:31:58  peter
2610
 
    * pass proccalloption to ret_in_xxx and push_xxx functions
2611
 
 
2612
 
  Revision 1.80  2002/11/17 16:31:56  carl
2613
 
    * memory optimization (3-4%) : cleanup of tai fields,
2614
 
       cleanup of tdef and tsym fields.
2615
 
    * make it work for m68k
2616
 
 
2617
 
  Revision 1.79  2002/11/16 14:20:50  peter
2618
 
    * fix infinite loop in pd_inline
2619
 
 
2620
 
  Revision 1.78  2002/11/15 01:58:53  peter
2621
 
    * merged changes from 1.0.7 up to 04-11
2622
 
      - -V option for generating bug report tracing
2623
 
      - more tracing for option parsing
2624
 
      - errors for cdecl and high()
2625
 
      - win32 import stabs
2626
 
      - win32 records<=8 are returned in eax:edx (turned off by default)
2627
 
      - heaptrc update
2628
 
      - more info for temp management in .s file with EXTDEBUG
2629
 
 
2630
 
  Revision 1.77  2002/10/06 15:09:12  peter
2631
 
    * variant:=nil supported
2632
 
 
2633
 
  Revision 1.76  2002/09/27 21:13:29  carl
2634
 
    * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
2635
 
 
2636
 
  Revision 1.75  2002/09/16 14:11:13  peter
2637
 
    * add argument to equal_paras() to support default values or not
2638
 
 
2639
 
  Revision 1.74  2002/09/10 16:27:28  peter
2640
 
    * don't insert parast in symtablestack, because typesyms should not be
2641
 
      searched in the the parast
2642
 
 
2643
 
  Revision 1.73  2002/09/09 19:39:07  peter
2644
 
    * check return type for forwarddefs also not delphi mode when
2645
 
      the type is not void
2646
 
 
2647
 
  Revision 1.72  2002/09/09 17:34:15  peter
2648
 
    * tdicationary.replace added to replace and item in a dictionary. This
2649
 
      is only allowed for the same name
2650
 
    * varsyms are inserted in symtable before the types are parsed. This
2651
 
      fixes the long standing "var longint : longint" bug
2652
 
    - consume_idlist and idstringlist removed. The loops are inserted
2653
 
      at the callers place and uses the symtable for duplicate id checking
2654
 
 
2655
 
  Revision 1.71  2002/09/07 15:25:06  peter
2656
 
    * old logs removed and tabs fixed
2657
 
 
2658
 
  Revision 1.70  2002/09/03 16:26:27  daniel
2659
 
    * Make Tprocdef.defs protected
2660
 
 
2661
 
  Revision 1.69  2002/09/01 12:11:33  peter
2662
 
    * calc param_offset after parameters are read, because the calculation
2663
 
      depends on po_containself
2664
 
 
2665
 
  Revision 1.68  2002/08/25 19:25:20  peter
2666
 
    * sym.insert_in_data removed
2667
 
    * symtable.insertvardata/insertconstdata added
2668
 
    * removed insert_in_data call from symtable.insert, it needs to be
2669
 
      called separatly. This allows to deref the address calculation
2670
 
    * procedures now calculate the parast addresses after the procedure
2671
 
      directives are parsed. This fixes the cdecl parast problem
2672
 
    * push_addr_param has an extra argument that specifies if cdecl is used
2673
 
      or not
2674
 
 
2675
 
  Revision 1.67  2002/08/25 11:33:06  peter
2676
 
    * also check the paratypes when a forward was found
2677
 
 
2678
 
  Revision 1.66  2002/08/19 19:36:44  peter
2679
 
    * More fixes for cross unit inlining, all tnodes are now implemented
2680
 
    * Moved pocall_internconst to po_internconst because it is not a
2681
 
      calling type at all and it conflicted when inlining of these small
2682
 
      functions was requested
2683
 
 
2684
 
  Revision 1.65  2002/08/18 20:06:24  peter
2685
 
    * inlining is now also allowed in interface
2686
 
    * renamed write/load to ppuwrite/ppuload
2687
 
    * tnode storing in ppu
2688
 
    * nld,ncon,nbas are already updated for storing in ppu
2689
 
 
2690
 
  Revision 1.64  2002/08/17 09:23:39  florian
2691
 
    * first part of procinfo rewrite
2692
 
 
2693
 
  Revision 1.63  2002/08/11 14:32:27  peter
2694
 
    * renamed current_library to objectlibrary
2695
 
 
2696
 
  Revision 1.62  2002/08/11 13:24:12  peter
2697
 
    * saving of asmsymbols in ppu supported
2698
 
    * asmsymbollist global is removed and moved into a new class
2699
 
      tasmlibrarydata that will hold the info of a .a file which
2700
 
      corresponds with a single module. Added librarydata to tmodule
2701
 
      to keep the library info stored for the module. In the future the
2702
 
      objectfiles will also be stored to the tasmlibrarydata class
2703
 
    * all getlabel/newasmsymbol and friends are moved to the new class
2704
 
 
2705
 
  Revision 1.61  2002/07/26 21:15:40  florian
2706
 
    * rewrote the system handling
2707
 
 
2708
 
  Revision 1.60  2002/07/20 11:57:55  florian
2709
 
    * types.pas renamed to defbase.pas because D6 contains a types
2710
 
      unit so this would conflicts if D6 programms are compiled
2711
 
    + Willamette/SSE2 instructions to assembler added
2712
 
 
2713
 
  Revision 1.59  2002/07/11 14:41:28  florian
2714
 
    * start of the new generic parameter handling
2715
 
 
2716
 
  Revision 1.58  2002/07/01 18:46:25  peter
2717
 
    * internal linker
2718
 
    * reorganized aasm layer
2719
 
 
2720
 
  Revision 1.57  2002/05/18 13:34:12  peter
2721
 
    * readded missing revisions
2722
 
 
2723
 
  Revision 1.56  2002/05/16 19:46:42  carl
2724
 
  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
2725
 
  + try to fix temp allocation (still in ifdef)
2726
 
  + generic constructor calls
2727
 
  + start of tassembler / tmodulebase class cleanup
2728
 
 
2729
 
  Revision 1.54  2002/05/12 16:53:08  peter
2730
 
    * moved entry and exitcode to ncgutil and cgobj
2731
 
    * foreach gets extra argument for passing local data to the
2732
 
      iterator function
2733
 
    * -CR checks also class typecasts at runtime by changing them
2734
 
      into as
2735
 
    * fixed compiler to cycle with the -CR option
2736
 
    * fixed stabs with elf writer, finally the global variables can
2737
 
      be watched
2738
 
    * removed a lot of routines from cga unit and replaced them by
2739
 
      calls to cgobj
2740
 
    * u32bit-s32bit updates for and,or,xor nodes. When one element is
2741
 
      u32bit then the other is typecasted also to u32bit without giving
2742
 
      a rangecheck warning/error.
2743
 
    * fixed pascal calling method with reversing also the high tree in
2744
 
      the parast, detected by tcalcst3 test
2745
 
 
2746
 
  Revision 1.53  2002/04/21 19:02:04  peter
2747
 
    * removed newn and disposen nodes, the code is now directly
2748
 
      inlined from pexpr
2749
 
    * -an option that will write the secondpass nodes to the .s file, this
2750
 
      requires EXTDEBUG define to actually write the info
2751
 
    * fixed various internal errors and crashes due recent code changes
2752
 
 
2753
 
  Revision 1.52  2002/04/20 21:32:24  carl
2754
 
  + generic FPC_CHECKPOINTER
2755
 
  + first parameter offset in stack now portable
2756
 
  * rename some constants
2757
 
  + move some cpu stuff to other units
2758
 
  - remove unused constents
2759
 
  * fix stacksize for some targets
2760
 
  * fix generic size problems which depend now on EXTEND_SIZE constant
2761
 
 
2762
 
  Revision 1.51  2002/04/20 15:27:05  carl
2763
 
  - remove ifdef i386 define
2764
 
 
2765
 
  Revision 1.50  2002/04/19 15:46:02  peter
2766
 
    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
2767
 
      in most cases and not written to the ppu
2768
 
    * add mangeledname_prefix() routine to generate the prefix of
2769
 
      manglednames depending on the current procedure, object and module
2770
 
    * removed static procprefix since the mangledname is now build only
2771
 
      on demand from tprocdef.mangledname
2772
 
 
2773
 
}