← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to compiler/symtable.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
compiler/symtable.pas
1
1
{
2
 
    $Id: symtable.pas,v 1.172 2005/03/13 12:15:44 florian Exp $
3
2
    Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
4
3
 
5
4
    This unit handles the symbol tables
69
68
          procedure buildderefimpl;virtual;
70
69
          procedure deref;virtual;
71
70
          procedure derefimpl;virtual;
72
 
          procedure duplicatesym(dupsym,sym:tsymentry);
73
71
          procedure insert(sym : tsymentry);override;
74
72
          procedure reset_all_defs;virtual;
75
73
          function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;override;
99
97
          procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
100
98
          procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
101
99
          procedure insertfield(sym:tfieldvarsym;addsym:boolean);
 
100
          procedure derefimpl; override;
102
101
          procedure addalignmentpadding;
103
102
       end;
104
103
 
200
199
    function  findunitsymtable(st:tsymtable):tsymtable;
201
200
    function  FullTypeName(def,otherdef:tdef):string;
202
201
    procedure incompatibletypes(def1,def2:tdef);
 
202
    procedure hidesym(sym:tsymentry);
 
203
    procedure duplicatesym(dupsym,sym:tsymentry);
203
204
 
204
205
{*** Search ***}
205
206
    function  searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
228
229
    {Name can be given in any case (it will be converted to upper case).}
229
230
    procedure def_system_macro(const name : string);
230
231
    procedure set_system_macro(const name, value : string);
 
232
    procedure set_system_compvar(const name, value : string);
231
233
    procedure undef_system_macro(const name : string);
232
234
 
233
235
{*** symtable stack ***}
286
288
      procinfo
287
289
      ;
288
290
 
289
 
    var
290
 
      dupnr : longint; { unique number for duplicate symbols }
291
 
 
292
291
 
293
292
{*****************************************************************************
294
293
                             TStoredSymtable
573
572
    procedure tstoredsymtable.derefimpl;
574
573
      var
575
574
        hp : tdef;
 
575
        hs: tsym;
576
576
      begin
577
577
        { definitions }
578
578
        hp:=tdef(defindex.first);
581
581
           hp.derefimpl;
582
582
           hp:=tdef(hp.indexnext);
583
583
         end;
584
 
      end;
585
 
 
586
 
 
587
 
    procedure tstoredsymtable.duplicatesym(dupsym,sym:tsymentry);
588
 
      var
589
 
        st : tsymtable;
590
 
      begin
591
 
        Message1(sym_e_duplicate_id,tsym(sym).realname);
592
 
        st:=findunitsymtable(sym.owner);
593
 
        with tsym(sym).fileinfo do
594
 
          begin
595
 
            if assigned(st) and
596
 
               (st.symtabletype=globalsymtable) and
597
 
               (not st.iscurrentunit) then
598
 
              Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
599
 
            else
600
 
              Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
601
 
          end;
602
 
        { Rename duplicate sym to an unreachable name, but it can be
603
 
          inserted in the symtable without errors }
604
 
        if assigned(dupsym) then
605
 
          begin
606
 
            inc(dupnr);
607
 
            dupsym.name:='dup'+tostr(dupnr)+dupsym.name;
608
 
          end;
 
584
        { symbols }
 
585
        hs:=tsym(symindex.first);
 
586
        while assigned(hs) do
 
587
         begin
 
588
           hs.derefimpl;
 
589
           hs:=tsym(hs.indexnext);
 
590
         end;
609
591
      end;
610
592
 
611
593
 
710
692
           tprocsym(sym).check_forward
711
693
         { check also object method table            }
712
694
         { we needn't to test the def list          }
713
 
         { because each object has to have a type sym }
 
695
         { because each object has to have a type sym,
 
696
           only test objects declarations, not type renamings }
714
697
         else
715
698
          if (tsym(sym).typ=typesym) and
716
699
             assigned(ttypesym(sym).restype.def) and
 
700
             (ttypesym(sym).restype.def.typesym=ttypesym(sym)) and
717
701
             (ttypesym(sym).restype.def.deftype=objectdef) then
718
702
           tobjectdef(ttypesym(sym).restype.def).check_forwards;
719
703
      end;
744
728
           { also don't count the value parameters which have local copies }
745
729
           { also don't claim for high param of open parameters (PM) }
746
730
           if (Errorcount<>0) or
747
 
              (vo_is_hidden_para in tabstractvarsym(p).varoptions) then
 
731
              ([vo_is_hidden_para,vo_is_funcret] * tabstractvarsym(p).varoptions = [vo_is_hidden_para]) then
748
732
             exit;
749
733
           if (tstoredsym(p).refs=0) then
750
734
             begin
762
746
                else
763
747
                  MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_not_used,tsym(p).realname);
764
748
             end
765
 
           else if tabstractvarsym(p).varstate=vs_assigned then
 
749
           else if tabstractvarsym(p).varstate in [vs_written,vs_initialised] then
766
750
             begin
767
751
                if (tsym(p).owner.symtabletype=parasymtable) then
768
752
                  begin
775
759
                else if not(vo_is_exported in tabstractvarsym(p).varoptions) and
776
760
                        not(vo_is_funcret in tabstractvarsym(p).varoptions) then
777
761
                  MessagePos1(tsym(p).fileinfo,sym_n_local_identifier_only_set,tsym(p).realname);
778
 
             end;
 
762
             end
 
763
           else if (tabstractvarsym(p).varstate = vs_read_not_warned) and
 
764
                   ([vo_is_exported,vo_is_external] * tabstractvarsym(p).varoptions = []) then
 
765
             MessagePos1(tsym(p).fileinfo,sym_w_identifier_only_read,tsym(p).realname)
779
766
         end
780
767
      else if ((tsym(p).owner.symtabletype in
781
768
              [objectsymtable,parasymtable,localsymtable,staticsymtable])) then
1020
1007
      end;
1021
1008
 
1022
1009
 
 
1010
 
 
1011
   procedure tabstractrecordsymtable.derefimpl;
 
1012
     var
 
1013
       storesymtable : tsymtable;
 
1014
     begin
 
1015
       storesymtable:=aktrecordsymtable;
 
1016
       aktrecordsymtable:=self;
 
1017
 
 
1018
       inherited derefimpl;
 
1019
 
 
1020
       aktrecordsymtable:=storesymtable;
 
1021
     end;
 
1022
 
 
1023
 
1023
1024
    procedure tabstractrecordsymtable.insertfield(sym : tfieldvarsym;addsym:boolean);
1024
1025
      var
1025
1026
        l      : aint;
1197
1198
              { but private ids can be reused }
1198
1199
              hsym:=search_class_member(tobjectdef(defowner),sym.name);
1199
1200
              if assigned(hsym) and
1200
 
                 Tsym(hsym).is_visible_for_object(tobjectdef(defowner)) then
 
1201
                 tsym(hsym).is_visible_for_object(tobjectdef(defowner),tobjectdef(defowner)) then
1201
1202
                DuplicateSym(sym,hsym);
1202
1203
           end;
1203
1204
         inherited insert(sym);
1251
1252
               (vo_is_funcret in tabstractvarsym(hsym).varoptions) and
1252
1253
               not((m_result in aktmodeswitches) and
1253
1254
                   (vo_is_result in tabstractvarsym(hsym).varoptions)) then
1254
 
              hsym.owner.rename(hsym.name,'hidden'+hsym.name)
 
1255
              HideSym(hsym)
1255
1256
            else
1256
1257
              DuplicateSym(sym,hsym);
1257
1258
          end;
1283
1284
               hsym:=search_class_member(tobjectdef(next.next.defowner),sym.name);
1284
1285
               if assigned(hsym) and
1285
1286
                 { private ids can be reused }
1286
 
                  (hsym.is_visible_for_object(tobjectdef(next.next.defowner)) or
 
1287
                  (hsym.is_visible_for_object(tobjectdef(next.next.defowner),tobjectdef(next.next.defowner)) or
1287
1288
                   (hsym.owner.defowner.owner.symtabletype<>globalsymtable)) then
1288
1289
                begin
1289
1290
                  { delphi allows to reuse the names in a class, but not
1324
1325
              hsym:=search_class_member(tobjectdef(next.defowner),sym.name);
1325
1326
              { private ids can be reused }
1326
1327
              if assigned(hsym) and
1327
 
                 Tsym(hsym).is_visible_for_object(tobjectdef(next.defowner)) then
 
1328
                 Tsym(hsym).is_visible_for_object(tobjectdef(next.defowner),tobjectdef(next.defowner)) then
1328
1329
               begin
1329
1330
                 { delphi allows to reuse the names in a class, but not
1330
1331
                   in object (tp7 compatible) }
1507
1508
                 <unit>.<id>, so we can hide the symbol }
1508
1509
               if (m_duplicate_names in aktmodeswitches) and
1509
1510
                  (hsym.typ=symconst.unitsym) then
1510
 
                hsym.owner.rename(hsym.name,'hidden'+hsym.name)
 
1511
                HideSym(hsym)
1511
1512
               else
1512
1513
                DuplicateSym(sym,hsym);
1513
1514
             end;
1641
1642
              <unit>.<id>, so we can hide the symbol }
1642
1643
            if (m_duplicate_names in aktmodeswitches) and
1643
1644
               (hsym.typ=symconst.unitsym) then
1644
 
             hsym.owner.rename(hsym.name,'hidden'+hsym.name)
 
1645
             HideSym(hsym)
1645
1646
            else
1646
1647
             DuplicateSym(sym,hsym);
1647
1648
          end;
1802
1803
      end;
1803
1804
 
1804
1805
 
 
1806
    procedure hidesym(sym:tsymentry);
 
1807
      var
 
1808
        s : string;
 
1809
      begin
 
1810
        if assigned(sym.owner) then
 
1811
          sym.owner.rename(sym.name,'hidden'+sym.name)
 
1812
        else
 
1813
          sym.name:='hidden'+sym.name;
 
1814
        s:='hidden'+tsym(sym).realname;
 
1815
        stringdispose(tsym(sym)._realname);
 
1816
        tsym(sym)._realname:=stringdup(s);
 
1817
      end;
 
1818
 
 
1819
 
 
1820
      var
 
1821
        dupnr : longint; { unique number for duplicate symbols }
 
1822
 
 
1823
    procedure duplicatesym(dupsym,sym:tsymentry);
 
1824
      var
 
1825
        st : tsymtable;
 
1826
      begin
 
1827
        Message1(sym_e_duplicate_id,tsym(sym).realname);
 
1828
        st:=findunitsymtable(sym.owner);
 
1829
        with tsym(sym).fileinfo do
 
1830
          begin
 
1831
            if assigned(st) and
 
1832
               (st.symtabletype=globalsymtable) and
 
1833
               (not st.iscurrentunit) then
 
1834
              Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line))
 
1835
            else
 
1836
              Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line));
 
1837
          end;
 
1838
        { Rename duplicate sym to an unreachable name, but it can be
 
1839
          inserted in the symtable without errors }
 
1840
        if assigned(dupsym) then
 
1841
          begin
 
1842
            inc(dupnr);
 
1843
            dupsym.name:='dup'+tostr(dupnr)+dupsym.name;
 
1844
            include(tsym(dupsym).symoptions,sp_implicitrename);
 
1845
          end;
 
1846
      end;
 
1847
 
 
1848
 
1805
1849
{*****************************************************************************
1806
1850
                                  Search
1807
1851
*****************************************************************************}
1810
1854
      var
1811
1855
        speedvalue : cardinal;
1812
1856
        topclass   : tobjectdef;
 
1857
        context : tobjectdef;
1813
1858
      begin
1814
1859
         speedvalue:=getspeedvalue(s);
1815
1860
         srsymtable:=symtablestack;
1832
1877
                     if assigned(current_procinfo) then
1833
1878
                       topclass:=current_procinfo.procdef._class;
1834
1879
                   end;
1835
 
                 if Tsym(srsym).is_visible_for_object(topclass) then
 
1880
                 if assigned(current_procinfo) then
 
1881
                   context:=current_procinfo.procdef._class
 
1882
                 else
 
1883
                   context:=nil;
 
1884
                 if tsym(srsym).is_visible_for_object(topclass,context) then
1836
1885
                   begin
1837
1886
                     { we need to know if a procedure references symbols
1838
1887
                       in the static symtable, because then it can't be
1869
1918
                  srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
1870
1919
                  if assigned(srsym) and
1871
1920
                     (not assigned(current_procinfo) or
1872
 
                      Tsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
 
1921
                      tsym(srsym).is_visible_for_object(current_procinfo.procdef._class,current_procinfo.procdef._class)) then
1873
1922
                    begin
1874
1923
                      result:=true;
1875
1924
                      exit;
1910
1959
       end;
1911
1960
 
1912
1961
 
1913
 
    function  searchsym_in_class(classh:tobjectdef;const s : stringid):tsym;
 
1962
    function searchsym_in_class(classh:tobjectdef;const s : stringid):tsym;
1914
1963
      var
1915
1964
        speedvalue : cardinal;
1916
1965
        topclassh  : tobjectdef;
1937
1986
          begin
1938
1987
            sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
1939
1988
            if assigned(sym) and
1940
 
               Tsym(sym).is_visible_for_object(topclassh) then
1941
 
              break;
 
1989
               tsym(sym).is_visible_for_object(topclassh,current_procinfo.procdef._class) then
 
1990
              break
 
1991
            else
 
1992
              sym:=nil;
1942
1993
            classh:=classh.childof;
1943
1994
          end;
1944
1995
         searchsym_in_class:=sym;
1945
1996
      end;
1946
1997
 
1947
1998
 
1948
 
    function  searchsym_in_class_by_msgint(classh:tobjectdef;i:longint):tsym;
 
1999
    function searchsym_in_class_by_msgint(classh:tobjectdef;i:longint):tsym;
1949
2000
      var
1950
2001
        topclassh  : tobjectdef;
1951
2002
        def        : tdef;
1996
2047
      end;
1997
2048
 
1998
2049
 
1999
 
    function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string):tsym;
 
2050
    function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string):tsym;
2000
2051
      var
2001
2052
        topclassh  : tobjectdef;
2002
2053
        def        : tdef;
2052
2103
    var st:Tsymtable;
2053
2104
        sym:Tprocsym;
2054
2105
        sv:cardinal;
2055
 
 
 
2106
        curreq,
 
2107
        besteq : tequaltype;
 
2108
        currpd,
 
2109
        bestpd : tprocdef;
2056
2110
    begin
2057
2111
      st:=symtablestack;
2058
2112
      sv:=getspeedvalue('assign');
 
2113
      besteq:=te_incompatible;
 
2114
      bestpd:=nil;
2059
2115
      while st<>nil do
2060
2116
        begin
2061
2117
          sym:=Tprocsym(st.speedsearch('assign',sv));
2063
2119
            begin
2064
2120
              if sym.typ<>procsym then
2065
2121
                internalerror(200402031);
2066
 
              search_assignment_operator:=sym.search_procdef_assignment_operator(from_def,to_def);
2067
 
              if search_assignment_operator<>nil then
2068
 
                break;
 
2122
              { if the source type is an alias then this is only the second choice,
 
2123
                if you mess with this code, check tw4093 }
 
2124
              currpd:=sym.search_procdef_assignment_operator(from_def,to_def,curreq);
 
2125
              if curreq>besteq then
 
2126
                begin
 
2127
                  besteq:=curreq;
 
2128
                  bestpd:=currpd;
 
2129
                  if (besteq=te_exact) then
 
2130
                    break;
 
2131
                end;
2069
2132
            end;
2070
2133
          st:=st.next;
2071
2134
        end;
 
2135
      result:=bestpd;
2072
2136
    end;
2073
2137
 
2074
2138
    function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
2216
2280
            begin
2217
2281
              if (srsym.typ<>procsym) then
2218
2282
               internalerror(200111022);
2219
 
              if srsym.is_visible_for_object(tobjectdef(aprocsym.owner.defowner)) then
 
2283
              if srsym.is_visible_for_object(tobjectdef(aprocsym.owner.defowner),tobjectdef(aprocsym.owner.defowner)) then
2220
2284
               begin
2221
2285
                 srsym.add_para_match_to(Aprocsym,[cpo_ignorehidden,cpo_allowdefaults]);
2222
2286
                 { we can stop if the overloads were already added
2312
2376
         mac.defined:=true;
2313
2377
      end;
2314
2378
 
 
2379
    procedure set_system_compvar(const name, value : string);
 
2380
      var
 
2381
        mac : tmacro;
 
2382
        s: string;
 
2383
      begin
 
2384
        if name = '' then
 
2385
          internalerror(2004121201);
 
2386
         s:= upper(name);
 
2387
         mac:=tmacro(search_macro(s));
 
2388
         if not assigned(mac) then
 
2389
           begin
 
2390
             mac:=tmacro.create(s);
 
2391
             mac.is_compiler_var:=true;
 
2392
             if macrosymtablestack.symtabletype=localmacrosymtable then
 
2393
               macrosymtablestack.insert(mac)
 
2394
             else
 
2395
               macrosymtablestack.next.insert(mac)
 
2396
           end
 
2397
         else
 
2398
           begin
 
2399
             mac.is_compiler_var:=true;
 
2400
             if assigned(mac.buftext) then
 
2401
               freemem(mac.buftext,mac.buflen);
 
2402
           end;
 
2403
         Message2(parser_c_macro_set_to,mac.name,value);
 
2404
         mac.buflen:=length(value);
 
2405
         getmem(mac.buftext,mac.buflen);
 
2406
         move(value[1],mac.buftext^,mac.buflen);
 
2407
         mac.defined:=true;
 
2408
      end;
 
2409
 
2315
2410
    procedure undef_system_macro(const name : string);
2316
2411
      var
2317
2412
        mac : tmacro;
2466
2561
     end;
2467
2562
 
2468
2563
end.
2469
 
{
2470
 
  $Log: symtable.pas,v $
2471
 
  Revision 1.172  2005/03/13 12:15:44  florian
2472
 
    + reset in InitSymtable some global vars to avoid trouble with the ide
2473
 
 
2474
 
  Revision 1.171  2005/02/14 17:13:08  peter
2475
 
    * truncate log
2476
 
 
2477
 
  Revision 1.170  2005/01/20 16:38:45  peter
2478
 
    * load jmp_buf_size from system unit
2479
 
 
2480
 
  Revision 1.169  2005/01/19 22:19:41  peter
2481
 
    * unit mapping rewrite
2482
 
    * new derefmap added
2483
 
 
2484
 
  Revision 1.168  2005/01/09 20:24:43  olle
2485
 
    * rework of macro subsystem
2486
 
    + exportable macros for mode macpas
2487
 
 
2488
 
}