521
522
**************************************}
525
procedure tclassheader.newdefentry(vmtentry:pvmtentry;pd:tprocdef;is_visible:boolean);
527
procdefcoll : pprocdefcoll;
529
if (_class=pd._class) then
531
{ new entry is needed, override was not possible }
532
if (po_overridingmethod in pd.procoptions) then
533
MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
535
{ check that all methods have overload directive }
536
if not(m_fpc in aktmodeswitches) then
538
procdefcoll:=vmtentry^.firstprocdef;
539
while assigned(procdefcoll) do
541
if (procdefcoll^.data._class=pd._class) and
542
((po_overload in pd.procoptions)<>(po_overload in procdefcoll^.data.procoptions)) then
544
MessagePos1(pd.fileinfo,parser_e_no_overload_for_all_procs,pd.procsym.realname);
546
include(procdefcoll^.data.procoptions,po_overload);
547
include(pd.procoptions,po_overload);
549
procdefcoll:=procdefcoll^.next;
554
{ generate new entry }
556
procdefcoll^.data:=pd;
557
procdefcoll^.hidden:=false;
558
procdefcoll^.visible:=is_visible;
559
procdefcoll^.next:=vmtentry^.firstprocdef;
560
vmtentry^.firstprocdef:=procdefcoll;
562
{ give virtual method a number }
563
if (po_virtualmethod in pd.procoptions) then
565
pd.extnumber:=nextvirtnumber;
567
has_virtual_method:=true;
570
if (pd.proctypeoption=potype_constructor) then
571
has_constructor:=true;
575
function tclassheader.newvmtentry(sym:tprocsym):pvmtentry;
577
{ generate new vmtentry }
579
result^.speedvalue:=sym.speedvalue;
580
result^.name:=stringdup(sym.name);
581
result^.next:=firstvmtentry;
582
result^.firstprocdef:=nil;
583
firstvmtentry:=result;
523
587
procedure tclassheader.eachsym(sym : tnamedindexitem;arg:pointer);
526
procdefcoll : pprocdefcoll;
531
procedure newdefentry(pd:tprocdef);
534
procdefcoll^.data:=pd;
535
procdefcoll^.hidden:=false;
536
procdefcoll^.next:=symcoll^.data;
537
symcoll^.data:=procdefcoll;
539
{ if it's a virtual method }
540
if (po_virtualmethod in pd.procoptions) then
542
{ then it gets a number ... }
543
pd.extnumber:=nextvirtnumber;
544
{ and we inc the number }
546
has_virtual_method:=true;
549
if (pd.proctypeoption=potype_constructor) then
550
has_constructor:=true;
552
{ check, if a method should be overridden }
553
if (pd._class=_class) and
554
(po_overridingmethod in pd.procoptions) then
555
MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
558
{ creates a new entry in the procsym list }
564
{ if not, generate a new symbol item }
566
symcoll^.speedvalue:=sym.speedvalue;
567
symcoll^.name:=stringdup(sym.name);
568
symcoll^.next:=wurzel;
572
{ inserts all definitions }
573
for i:=1 to Tprocsym(sym).procdef_count do
574
newdefentry(Tprocsym(sym).procdef[i]);
589
po_comp = [po_classmethod,po_virtualmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
590
po_exports,po_varargs,po_explicitparaloc,po_nostackframe];
584
598
pdoverload : boolean;
599
procdefcoll : pprocdefcoll;
600
vmtentry : pvmtentry;
586
{ put only sub routines into the VMT, and routines
587
that are visible to the current class. Skip private
588
methods in other classes }
589
if (tsym(sym).typ=procsym) then
591
{ is this symbol visible from the class that we are
592
generating. This will be used to hide the other procdefs.
593
When the symbol is not visible we don't hide the other
594
procdefs, because they can be reused in the next class.
595
The check to skip the invisible methods that are in the
596
list is futher down in the code }
597
is_visible:=tprocsym(sym).is_visible_for_object(_class);
598
{ check the current list of symbols }
600
_speed:=sym.speedvalue;
602
while assigned(symcoll) do
604
{ does the symbol already exist in the list? First
605
compare speedvalue before doing the string compare to
606
speed it up a little }
607
if (_speed=symcoll^.speedvalue) and
608
(_name=symcoll^.name^) then
604
if (tsym(sym).typ<>procsym) then
607
{ check the current list of symbols }
609
_speed:=sym.speedvalue;
610
vmtentry:=firstvmtentry;
611
while assigned(vmtentry) do
613
{ does the symbol already exist in the list? First
614
compare speedvalue before doing the string compare to
615
speed it up a little }
616
if (_speed=vmtentry^.speedvalue) and
617
(_name=vmtentry^.name^) then
619
hasoverloads:=(Tprocsym(sym).procdef_count>1);
620
{ walk through all defs of the symbol }
621
for i:=1 to Tprocsym(sym).procdef_count do
623
pd:=Tprocsym(sym).procdef[i];
625
{ is this procdef visible from the class that we are
626
generating. This will be used to hide the other procdefs.
627
When the symbol is not visible we don't hide the other
628
procdefs, because they can be reused in the next class.
629
The check to skip the invisible methods that are in the
630
list is futher down in the code }
631
is_visible:=pd.is_visible_for_object(_class);
633
if pd.procsym=sym then
610
hasoverloads:=(Tprocsym(sym).procdef_count>1);
611
{ walk through all defs of the symbol }
612
for i:=1 to Tprocsym(sym).procdef_count do
635
pdoverload:=(po_overload in pd.procoptions);
637
{ compare with all stored definitions }
638
procdefcoll:=vmtentry^.firstprocdef;
639
while assigned(procdefcoll) do
614
pd:=Tprocsym(sym).procdef[i];
615
if pd.procsym=sym then
617
pdoverload:=(po_overload in pd.procoptions);
619
{ compare with all stored definitions }
620
procdefcoll:=symcoll^.data;
621
while assigned(procdefcoll) do
623
{ compare only if the definition is not hidden }
624
if not procdefcoll^.hidden then
626
{ check that all methods have overload directive }
627
if not(m_fpc in aktmodeswitches) and
628
(_class=pd._class) and
629
(procdefcoll^.data._class=pd._class) and
630
((po_overload in pd.procoptions)<>(po_overload in procdefcoll^.data.procoptions)) then
632
MessagePos1(pd.fileinfo,parser_e_no_overload_for_all_procs,pd.procsym.realname);
634
include(procdefcoll^.data.procoptions,po_overload);
641
{ compare only if the definition is not hidden }
642
if not procdefcoll^.hidden then
644
{ check if one of the two methods has virtual }
645
if (po_virtualmethod in procdefcoll^.data.procoptions) or
646
(po_virtualmethod in pd.procoptions) then
648
{ if the current definition has no virtual then hide the
649
old virtual if the new definition has the same arguments or
650
when it has no overload directive and no overloads }
651
if not(po_virtualmethod in pd.procoptions) then
653
if procdefcoll^.visible and
654
(not(pdoverload or hasoverloads) or
655
(compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) then
658
procdefcoll^.hidden:=true;
659
if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
660
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
663
{ if both are virtual we check the header }
664
else if (po_virtualmethod in pd.procoptions) and
665
(po_virtualmethod in procdefcoll^.data.procoptions) then
667
{ new one has not override }
668
if is_class(_class) and
669
not(po_overridingmethod in pd.procoptions) then
671
{ we start a new virtual tree, hide the old }
672
if (not(pdoverload or hasoverloads) or
673
(compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) and
674
(procdefcoll^.visible) then
677
procdefcoll^.hidden:=true;
678
if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
679
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
683
else if (compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal) then
685
{ overload is inherited }
686
if (po_overload in procdefcoll^.data.procoptions) then
635
687
include(pd.procoptions,po_overload);
638
{ check if one of the two methods has virtual }
639
if (po_virtualmethod in procdefcoll^.data.procoptions) or
640
(po_virtualmethod in pd.procoptions) then
689
{ inherite calling convention when it was force and the
690
current definition has none force }
691
if (po_hascallingconvention in procdefcoll^.data.procoptions) and
692
not(po_hascallingconvention in pd.procoptions) then
694
pd.proccalloption:=procdefcoll^.data.proccalloption;
695
include(pd.procoptions,po_hascallingconvention);
698
{ the flags have to match except abstract and override }
699
{ only if both are virtual !! }
700
if (procdefcoll^.data.proccalloption<>pd.proccalloption) or
701
(procdefcoll^.data.proctypeoption<>pd.proctypeoption) or
702
((procdefcoll^.data.procoptions*po_comp)<>(pd.procoptions*po_comp)) then
704
MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false));
705
tprocsym(procdefcoll^.data.procsym).write_parameter_lists(pd);
708
{ error, if the return types aren't equal }
709
if not(equal_defs(procdefcoll^.data.rettype.def,pd.rettype.def)) and
710
not((procdefcoll^.data.rettype.def.deftype=objectdef) and
711
(pd.rettype.def.deftype=objectdef) and
712
is_class(procdefcoll^.data.rettype.def) and
713
is_class(pd.rettype.def) and
714
(tobjectdef(pd.rettype.def).is_related(
715
tobjectdef(procdefcoll^.data.rettype.def)))) then
716
Message2(parser_e_overridden_methods_not_same_ret,pd.fullprocname(false),
717
procdefcoll^.data.fullprocname(false));
719
{ check if the method to override is visible, check is only needed
720
for the current parsed class. Parent classes are already validated and
721
need to include all virtual methods including the ones not visible in the
723
if (_class=pd._class) and
724
(po_overridingmethod in pd.procoptions) and
725
(not procdefcoll^.visible) then
726
MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
728
{ override old virtual method in VMT }
729
pd.extnumber:=procdefcoll^.data.extnumber;
730
procdefcoll^.data:=pd;
732
procdefcoll^.visible:=true;
736
{ different parameters }
642
{ if the current definition has no virtual then hide the
643
old virtual if the new definition has the same arguments or
644
when it has no overload directive and no overloads }
645
if not(po_virtualmethod in pd.procoptions) then
647
if tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class) and
648
(not(pdoverload or hasoverloads) or
649
(compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) then
652
procdefcoll^.hidden:=true;
653
if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
654
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
657
{ if both are virtual we check the header }
658
else if (po_virtualmethod in pd.procoptions) and
659
(po_virtualmethod in procdefcoll^.data.procoptions) then
661
{ new one has not override }
662
if is_class(_class) and
663
not(po_overridingmethod in pd.procoptions) then
665
{ we start a new virtual tree, hide the old }
666
if (not(pdoverload or hasoverloads) or
667
(compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) and
668
(tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
671
procdefcoll^.hidden:=true;
672
if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
673
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
676
{ check if the method to override is visible }
677
else if (po_overridingmethod in pd.procoptions) and
678
(not tstoredsym(procdefcoll^.data.procsym).is_visible_for_object(pd._class)) then
680
{ do nothing, the error will follow when adding the entry }
683
else if (compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal) then
685
{ overload is inherited }
686
if (po_overload in procdefcoll^.data.procoptions) then
687
include(pd.procoptions,po_overload);
689
{ inherite calling convention when it was force and the
690
current definition has none force }
691
if (po_hascallingconvention in procdefcoll^.data.procoptions) and
692
not(po_hascallingconvention in pd.procoptions) then
694
pd.proccalloption:=procdefcoll^.data.proccalloption;
695
include(pd.procoptions,po_hascallingconvention);
698
{ the flags have to match except abstract and override }
699
{ only if both are virtual !! }
700
if (procdefcoll^.data.proccalloption<>pd.proccalloption) or
701
(procdefcoll^.data.proctypeoption<>pd.proctypeoption) or
702
((procdefcoll^.data.procoptions-
703
[po_abstractmethod,po_overridingmethod,po_assembler,po_overload,po_public,po_reintroduce])<>
704
(pd.procoptions-[po_abstractmethod,po_overridingmethod,po_assembler,po_overload,po_public,po_reintroduce])) then
706
MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false));
707
tprocsym(procdefcoll^.data.procsym).write_parameter_lists(pd);
710
{ error, if the return types aren't equal }
711
if not(equal_defs(procdefcoll^.data.rettype.def,pd.rettype.def)) and
712
not((procdefcoll^.data.rettype.def.deftype=objectdef) and
713
(pd.rettype.def.deftype=objectdef) and
714
is_class(procdefcoll^.data.rettype.def) and
715
is_class(pd.rettype.def) and
716
(tobjectdef(pd.rettype.def).is_related(
717
tobjectdef(procdefcoll^.data.rettype.def)))) then
718
Message2(parser_e_overridden_methods_not_same_ret,pd.fullprocname(false),
719
procdefcoll^.data.fullprocname(false));
721
{ now set the number }
722
pd.extnumber:=procdefcoll^.data.extnumber;
724
procdefcoll^.data:=pd;
727
{ different parameters }
730
{ when we got an override directive then can search futher for
731
the procedure to override.
732
If we are starting a new virtual tree then hide the old tree }
733
if not(po_overridingmethod in pd.procoptions) and
737
procdefcoll^.hidden:=true;
738
if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
739
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
745
{ the new definition is virtual and the old static, we hide the old one
746
if the new defintion has not the overload directive }
748
((not(pdoverload or hasoverloads)) or
749
(compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) then
739
{ when we got an override directive then can search futher for
740
the procedure to override.
741
If we are starting a new virtual tree then hide the old tree }
742
if not(po_overridingmethod in pd.procoptions) and
750
746
procdefcoll^.hidden:=true;
747
if (_class=pd._class) and not(po_reintroduce in pd.procoptions) then
748
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
755
{ both are static, we hide the old one if the new defintion
756
has not the overload directive }
759
(compare_paras(procdefcoll^.data.para,pd.para,cp_all,[])>=te_equal)) then
760
procdefcoll^.hidden:=true;
763
procdefcoll:=procdefcoll^.next;
754
{ the new definition is virtual and the old static, we hide the old one
755
if the new defintion has not the overload directive }
757
((not(pdoverload or hasoverloads)) or
758
(compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) then
759
procdefcoll^.hidden:=true;
764
{ both are static, we hide the old one if the new defintion
765
has not the overload directive }
768
(compare_paras(procdefcoll^.data.paras,pd.paras,cp_all,[])>=te_equal)) then
769
procdefcoll^.hidden:=true;
772
procdefcoll:=procdefcoll^.next;
766
{ if it isn't saved in the list we create a new entry }
775
{ if it isn't saved in the list we create a new entry }
776
newdefentry(vmtentry,pd,is_visible);
773
symcoll:=symcoll^.next;
779
procedure tclassheader.disposevmttree;
783
procdefcoll : pprocdefcoll;
786
{ disposes the above generated tree }
788
while assigned(symcoll) do
790
wurzel:=symcoll^.next;
791
stringdispose(symcoll^.name);
792
procdefcoll:=symcoll^.data;
793
while assigned(procdefcoll) do
795
symcoll^.data:=procdefcoll^.next;
796
dispose(procdefcoll);
797
procdefcoll:=symcoll^.data;
782
vmtentry:=vmtentry^.next;
785
{ Generate new procsym entry in vmt }
786
vmtentry:=newvmtentry(tprocsym(sym));
789
for i:=1 to Tprocsym(sym).procdef_count do
791
pd:=Tprocsym(sym).procdef[i];
792
newdefentry(vmtentry,pd,pd.is_visible_for_object(_class));
797
procedure tclassheader.disposevmttree;
799
vmtentry : pvmtentry;
800
procdefcoll : pprocdefcoll;
802
{ disposes the above generated tree }
803
vmtentry:=firstvmtentry;
804
while assigned(vmtentry) do
806
firstvmtentry:=vmtentry^.next;
807
stringdispose(vmtentry^.name);
808
procdefcoll:=vmtentry^.firstprocdef;
809
while assigned(procdefcoll) do
811
vmtentry^.firstprocdef:=procdefcoll^.next;
812
dispose(procdefcoll);
813
procdefcoll:=vmtentry^.firstprocdef;
816
vmtentry:=firstvmtentry;
805
821
procedure tclassheader.genvmt;
988
if compats^[i].compintf<>0 then
989
implvtbl[i]:=compats^[i].compintf
990
else if equals^[i]<>0 then
991
implvtbl[i]:=equals^[i]
995
freemem(compats,sizeof(tcompintfentry)*max);
996
freemem(equals,sizeof(longint)*max);
1003
{ Reset, no replacements by default }
1006
{ Replace vtbls when equal or compat, repeat
1007
until there are no replacements possible anymore. This is
1008
needed for the cases like:
1009
First loop: 2->3, 3->1
1010
Second loop: 2->1 (because 3 was replaced with 1)
1016
if compats^[impls^[i]].compintf<>0 then
1017
impls^[i]:=compats^[impls^[i]].compintf
1018
else if equals^[impls^[i]]<>0 then
1019
impls^[i]:=equals^[impls^[i]]
1024
{ Update the implindex }
1026
_class.implementedinterfaces.setimplindex(i,impls^[i]);
1000
1033
procedure tclassheader.gintfwritedata;
1002
rawdata,rawcode: taasmoutput;
1003
impintfindexes: plongintarray;
1035
rawdata: taasmoutput;
1007
1038
max:=_class.implementedinterfaces.count;
1008
getmem(impintfindexes,(max+1)*sizeof(longint));
1010
gintfoptimizevtbls(impintfindexes);
1012
1040
rawdata:=TAAsmOutput.Create;
1013
rawcode:=TAAsmOutput.Create;
1014
1041
dataSegment.concat(Tai_const.Create_16bit(max));
1015
1042
{ Two pass, one for allocation and vtbl creation }
1016
1043
for i:=1 to max do
1018
if impintfindexes[i]=i then { if implement itself }
1045
if _class.implementedinterfaces.implindex(i)=i then { if implement itself }
1020
1047
{ allocate a pointer in the object memory }
1021
1048
with tobjectsymtable(_class.symtable) do
1023
datasize:=align(datasize,min(POINTER_SIZE,fieldalignment));
1024
_class.implementedinterfaces.ioffsets(i)^:=datasize;
1025
inc(datasize,POINTER_SIZE);
1050
datasize:=align(datasize,min(sizeof(aint),fieldalignment));
1051
_class.implementedinterfaces.setioffsets(i,datasize);
1052
inc(datasize,sizeof(aint));
1028
gintfcreatevtbl(i,rawdata,rawcode);
1055
gintfcreatevtbl(i,rawdata);
1031
1058
{ second pass: for fill interfacetable and remained ioffsets }
1032
1059
for i:=1 to max do
1034
if i<>impintfindexes[i] then { why execute x:=x ? }
1035
with _class.implementedinterfaces do
1036
ioffsets(i)^:=ioffsets(impintfindexes[i])^;
1037
gintfgenentry(i,impintfindexes[i],rawdata);
1061
j:=_class.implementedinterfaces.implindex(i);
1063
_class.implementedinterfaces.setioffsets(i,_class.implementedinterfaces.ioffsets(j));
1064
gintfgenentry(i,j,rawdata);
1039
1066
dataSegment.concatlist(rawdata);
1041
codeSegment.concatlist(rawcode);
1043
freemem(impintfindexes,(max+1)*sizeof(longint));
1047
1071
function tclassheader.gintfgetcprocdef(proc: tprocdef;const name: string): tprocdef;
1073
po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
1074
po_exports,po_varargs,po_explicitparaloc,po_nostackframe];
1050
1077
implprocdef : Tprocdef;
1292
1313
{ it is not written for parents that don't have any vmt !! }
1293
1314
if assigned(_class.childof) and
1294
1315
(oo_has_vmt in _class.childof.objectoptions) then
1295
dataSegment.concat(Tai_const_symbol.Createname(_class.childof.vmt_mangledname,AT_DATA,0))
1316
dataSegment.concat(Tai_const.Createname(_class.childof.vmt_mangledname,AT_DATA,0))
1297
dataSegment.concat(Tai_const.Create_ptr(0));
1318
dataSegment.concat(Tai_const.Create_sym(nil));
1299
1320
{ write extended info for classes, for the order see rtl/inc/objpash.inc }
1300
1321
if is_class(_class) then
1302
1323
{ pointer to class name string }
1303
dataSegment.concat(Tai_const_symbol.Create(classnamelabel));
1304
{ pointer to dynamic table }
1324
dataSegment.concat(Tai_const.Create_sym(classnamelabel));
1325
{ pointer to dynamic table or nil }
1305
1326
if (oo_has_msgint in _class.objectoptions) then
1306
dataSegment.concat(Tai_const_symbol.Create(intmessagetable))
1308
dataSegment.concat(Tai_const.Create_ptr(0));
1309
{ pointer to method table }
1310
if assigned(methodnametable) then
1311
dataSegment.concat(Tai_const_symbol.Create(methodnametable))
1313
dataSegment.concat(Tai_const.Create_ptr(0));
1327
dataSegment.concat(Tai_const.Create_sym(intmessagetable))
1329
dataSegment.concat(Tai_const.Create_sym(nil));
1330
{ pointer to method table or nil }
1331
dataSegment.concat(Tai_const.Create_sym(methodnametable));
1314
1332
{ pointer to field table }
1315
dataSegment.concat(Tai_const_symbol.Create(fieldtablelabel));
1333
dataSegment.concat(Tai_const.Create_sym(fieldtablelabel));
1316
1334
{ pointer to type info of published section }
1317
1335
if (oo_can_have_published in _class.objectoptions) then
1318
dataSegment.concat(Tai_const_symbol.Create(_class.get_rtti_label(fullrtti)))
1336
dataSegment.concat(Tai_const.Create_sym(_class.get_rtti_label(fullrtti)))
1320
dataSegment.concat(Tai_const.Create_ptr(0));
1338
dataSegment.concat(Tai_const.Create_sym(nil));
1321
1339
{ inittable for con-/destruction }
1322
1340
if _class.members_need_inittable then
1323
dataSegment.concat(Tai_const_symbol.Create(_class.get_rtti_label(initrtti)))
1341
dataSegment.concat(Tai_const.Create_sym(_class.get_rtti_label(initrtti)))
1325
dataSegment.concat(Tai_const.Create_ptr(0));
1343
dataSegment.concat(Tai_const.Create_sym(nil));
1327
dataSegment.concat(Tai_const.Create_ptr(0));
1345
dataSegment.concat(Tai_const.Create_sym(nil));
1328
1346
{ interface table }
1329
1347
if _class.implementedinterfaces.count>0 then
1330
dataSegment.concat(Tai_const_symbol.Create(interfacetable))
1348
dataSegment.concat(Tai_const.Create_sym(interfacetable))
1332
dataSegment.concat(Tai_const.Create_ptr(0));
1350
dataSegment.concat(Tai_const.Create_sym(nil));
1333
1351
{ table for string messages }
1334
1352
if (oo_has_msgstr in _class.objectoptions) then
1335
dataSegment.concat(Tai_const_symbol.Create(strmessagetable))
1353
dataSegment.concat(Tai_const.Create_sym(strmessagetable))
1337
dataSegment.concat(Tai_const.Create_ptr(0));
1355
dataSegment.concat(Tai_const.Create_sym(nil));
1339
1357
{ write virtual methods }
1340
1358
writevirtualmethods(dataSegment);
1359
datasegment.concat(Tai_const.create(ait_const_ptr,0));
1341
1360
{ write the size of the VMT }
1342
1361
dataSegment.concat(Tai_symbol_end.Createname(_class.vmt_mangledname));
1346
procedure tclassheader.adjustselfvalue(procdef: tprocdef;ioffset: aword);
1350
locpara : tparalocation;
1352
{ calculate the parameter info for the procdef }
1353
if not procdef.has_paraloc_info then
1355
procdef.requiredargarea:=paramanager.create_paraloc_info(procdef,callerside);
1356
procdef.has_paraloc_info:=true;
1358
hsym:=tsym(procdef.parast.search('self'));
1359
if not(assigned(hsym) and
1360
(hsym.typ=varsym) and
1361
assigned(tvarsym(hsym).paraitem)) then
1362
internalerror(200305251);
1363
locpara:=tvarsym(hsym).paraitem.paraloc[callerside];
1366
cg.a_op_const_reg(exprasmlist,OP_SUB,locpara.size,ioffset,locpara.register);
1369
{ offset in the wrapper needs to be adjusted for the stored
1371
reference_reset_base(href,locpara.reference.index,locpara.reference.offset+POINTER_SIZE);
1372
cg.a_op_const_ref(exprasmlist,OP_SUB,locpara.size,ioffset,href);
1375
internalerror(200309189);
1381
cclassheader:=tclassheader;
1384
1367
$Log: nobj.pas,v $
1385
Revision 1.69 2004/03/31 21:01:01 florian
1386
* vtbls are now properly aligned
1388
Revision 1.68 2004/03/18 11:43:57 olle
1389
* change AT_FUNCTION to AT_DATA where appropriate
1391
Revision 1.67 2004/03/08 22:07:46 peter
1392
* stabs updates to write stabs for def for all implictly used
1395
Revision 1.66 2004/03/04 17:23:50 peter
1396
* fix compare of parameters, they need to match exact
1398
Revision 1.65 2004/03/02 00:36:33 olle
1399
* big transformation of Tai_[const_]Symbol.Create[data]name*
1401
Revision 1.64 2004/02/27 10:21:05 florian
1403
+ refaddr to treference added
1404
+ refsymbol to treference added
1405
* top_local stuff moved to an extra record to save memory
1407
* tppufile.get/putint64/aint implemented
1409
Revision 1.63 2004/02/26 16:16:38 peter
1410
* tai_const.create_ptr added
1412
Revision 1.62 2004/02/19 17:07:42 florian
1413
* fixed arg. area calculation
1415
Revision 1.61 2004/02/13 15:41:24 peter
1416
* overload directive checking for methods is now done
1417
when the vmt is generated
1419
Revision 1.60 2004/02/08 23:30:43 florian
1420
* web bug 2942 fixed: reintroduce isn't necessary in methods of child classes of course
1422
Revision 1.59 2004/01/28 20:30:18 peter
1423
* record alignment splitted in fieldalignment and recordalignment,
1424
the latter is used when this record is inserted in another record.
1426
Revision 1.58 2004/01/21 14:22:00 florian
1427
+ reintroduce implemented
1429
Revision 1.57 2003/12/08 22:34:24 peter
1430
* tai_const.create_32bit changed to cardinal
1432
Revision 1.56 2003/11/28 17:24:22 peter
1433
* reversed offset calculation for caller side so it works
1434
correctly for interfaces
1436
Revision 1.55 2003/10/30 16:23:13 peter
1437
* don't search for overloads in parents for constructors
1439
Revision 1.54 2003/10/29 19:48:50 peter
1440
* renamed mangeldname_prefix to make_mangledname and made it more
1442
* make_mangledname is now also used for internal threadvar/resstring
1444
* Add P$ in front of program modulename to prevent duplicated symbols
1445
at assembler level, because the main program can have the same name
1446
as a unit, see webtbs/tw1251b
1448
Revision 1.53 2003/10/13 14:05:12 peter
1449
* removed is_visible_for_proc
1450
* search also for class overloads when finding interface
1453
Revision 1.52 2003/10/10 17:48:13 peter
1454
* old trgobj moved to x86/rgcpu and renamed to trgx86fpu
1455
* tregisteralloctor renamed to trgobj
1456
* removed rgobj from a lot of units
1457
* moved location_* and reference_* to cgobj
1458
* first things for mmx register allocation
1460
Revision 1.51 2003/10/07 21:14:32 peter
1461
* compare_paras() has a parameter to ignore hidden parameters
1462
* cross unit overload searching ignores hidden parameters when
1463
comparing parameter lists. Now function(string):string is
1464
not overriden with procedure(string) which has the same visible
1467
Revision 1.50 2003/10/07 20:44:22 peter
1468
* inherited forced calling convention
1469
* show hints when forward doesn't match
1471
Revision 1.49 2003/10/01 20:34:49 peter
1472
* procinfo unit contains tprocinfo
1473
* cginfo renamed to cgbase
1474
* moved cgmessage to verbose
1475
* fixed ppc and sparc compiles
1477
Revision 1.48 2003/09/23 17:56:05 peter
1478
* locals and paras are allocated in the code generation
1479
* tvarsym.localloc contains the location of para/local when
1480
generating code for the current procedure
1482
Revision 1.47 2003/08/21 14:47:41 peter
1483
* remove convert_registers
1485
Revision 1.46 2003/08/20 09:07:00 daniel
1486
* New register coding now mandatory, some more convert_registers calls
1489
Revision 1.45 2003/08/10 17:25:23 peter
1490
* fixed some reported bugs
1492
Revision 1.44 2003/06/01 21:38:06 peter
1493
* getregisterfpu size parameter added
1494
* op_const_reg size parameter added
1497
Revision 1.43 2003/05/23 14:27:35 peter
1498
* remove some unit dependencies
1499
* current_procinfo changes to store more info
1501
Revision 1.42 2003/04/25 20:59:33 peter
1502
* removed funcretn,funcretsym, function result is now in varsym
1503
and aliases for result and function name are added using absolutesym
1504
* vs_hidden parameter for funcret passed in parameter
1506
* writenode changed to printnode and released from extdebug
1507
* -vp option added to generate a tree.log with the nodetree
1508
* nicer printnode for statements, callnode
1510
Revision 1.41 2003/04/23 10:11:22 peter
1511
* range check error for GUID fixed
1513
Revision 1.40 2003/01/13 14:54:34 daniel
1514
* Further work to convert codegenerator register convention;
1515
internalerror bug fixed.
1517
Revision 1.39 2003/01/09 21:52:37 peter
1518
* merged some verbosity options.
1519
* V_LineInfo is a verbosity flag to include line info
1521
Revision 1.38 2002/11/25 17:43:20 peter
1522
* splitted defbase in defutil,symutil,defcmp
1523
* merged isconvertable and is_equal into compare_defs(_ext)
1524
* made operator search faster by walking the list only once
1526
Revision 1.37 2002/11/17 16:31:56 carl
1527
* memory optimization (3-4%) : cleanup of tai fields,
1528
cleanup of tdef and tsym fields.
1529
* make it work for m68k
1531
Revision 1.36 2002/11/15 01:58:52 peter
1532
* merged changes from 1.0.7 up to 04-11
1533
- -V option for generating bug report tracing
1534
- more tracing for option parsing
1535
- errors for cdecl and high()
1536
- win32 import stabs
1537
- win32 records<=8 are returned in eax:edx (turned off by default)
1539
- more info for temp management in .s file with EXTDEBUG
1541
Revision 1.35 2002/11/09 16:19:43 carl
1542
- remove superfluous data in classname
1544
Revision 1.34 2002/11/09 15:35:35 carl
1545
* major alignment updates for objects/class tables
1547
Revision 1.33 2002/10/20 15:33:36 peter
1548
* having overloads is the same as overload directive for hiding of
1549
parent methods. This is required becuase it can be possible that a
1550
method will then hide a method in the parent that an overloaded
1551
method requires. See webbug tw2185
1553
Revision 1.32 2002/10/19 15:09:24 peter
1554
+ tobjectdef.members_need_inittable that is used to generate only the
1555
inittable when it is really used. This saves a lot of useless calls
1556
to fpc_finalize when destroying classes
1558
Revision 1.31 2002/10/15 19:00:42 peter
1559
* small tweak to use speedvalue before comparing strings
1561
Revision 1.30 2002/10/06 16:40:25 florian
1562
* interface wrapper name mangling improved
1564
Revision 1.29 2002/10/05 12:43:25 carl
1565
* fixes for Delphi 6 compilation
1566
(warning : Some features do not work under Delphi)
1568
Revision 1.28 2002/09/16 14:11:13 peter
1569
* add argument to equal_paras() to support default values or not
1571
Revision 1.27 2002/09/03 16:26:26 daniel
1572
* Make Tprocdef.defs protected
1574
Revision 1.26 2002/09/03 15:44:44 peter
1575
* fixed private methods hiding public virtual methods
1577
Revision 1.25 2002/08/11 14:32:27 peter
1578
* renamed current_library to objectlibrary
1580
Revision 1.24 2002/08/11 13:24:12 peter
1581
* saving of asmsymbols in ppu supported
1582
* asmsymbollist global is removed and moved into a new class
1583
tasmlibrarydata that will hold the info of a .a file which
1584
corresponds with a single module. Added librarydata to tmodule
1585
to keep the library info stored for the module. In the future the
1586
objectfiles will also be stored to the tasmlibrarydata class
1587
* all getlabel/newasmsymbol and friends are moved to the new class
1589
Revision 1.23 2002/08/09 07:33:01 florian
1590
* a couple of interface related fixes
1592
Revision 1.22 2002/07/20 11:57:55 florian
1593
* types.pas renamed to defbase.pas because D6 contains a types
1594
unit so this would conflicts if D6 programms are compiled
1595
+ Willamette/SSE2 instructions to assembler added
1597
Revision 1.21 2002/07/01 18:46:23 peter
1599
* reorganized aasm layer
1601
Revision 1.20 2002/05/18 13:34:10 peter
1602
* readded missing revisions
1604
Revision 1.19 2002/05/16 19:46:39 carl
1605
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
1606
+ try to fix temp allocation (still in ifdef)
1607
+ generic constructor calls
1608
+ start of tassembler / tmodulebase class cleanup
1610
Revision 1.17 2002/05/12 16:53:08 peter
1611
* moved entry and exitcode to ncgutil and cgobj
1612
* foreach gets extra argument for passing local data to the
1614
* -CR checks also class typecasts at runtime by changing them
1616
* fixed compiler to cycle with the -CR option
1617
* fixed stabs with elf writer, finally the global variables can
1619
* removed a lot of routines from cga unit and replaced them by
1621
* u32bit-s32bit updates for and,or,xor nodes. When one element is
1622
u32bit then the other is typecasted also to u32bit without giving
1623
a rangecheck warning/error.
1624
* fixed pascal calling method with reversing also the high tree in
1625
the parast, detected by tcalcst3 test
1627
Revision 1.16 2002/04/20 21:32:24 carl
1628
+ generic FPC_CHECKPOINTER
1629
+ first parameter offset in stack now portable
1630
* rename some constants
1631
+ move some cpu stuff to other units
1632
- remove unused constents
1633
* fix stacksize for some targets
1634
* fix generic size problems which depend now on EXTEND_SIZE constant
1636
Revision 1.15 2002/04/19 15:46:01 peter
1637
* mangledname rewrite, tprocdef.mangledname is now created dynamicly
1638
in most cases and not written to the ppu
1639
* add mangeledname_prefix() routine to generate the prefix of
1640
manglednames depending on the current procedure, object and module
1641
* removed static procprefix since the mangledname is now build only
1642
on demand from tprocdef.mangledname
1644
Revision 1.14 2002/04/15 18:59:07 carl
1645
+ target_info.size_of_pointer -> pointer_Size
1647
Revision 1.13 2002/02/11 18:51:35 peter
1648
* fixed vmt generation for private procedures that were skipped after
1368
Revision 1.93 2005/05/05 21:09:10 florian
1369
* write nil into the method table for abstract methods
1371
Revision 1.92 2005/03/17 09:08:54 michael
1372
+ Patch from peter to fix overload directive cheking in delphi mode
1374
Revision 1.91 2005/02/14 17:13:06 peter
1377
Revision 1.90 2005/02/10 22:08:03 peter
1378
* remove obsolete code
1380
Revision 1.89 2005/02/02 02:19:42 karoly
1381
* removed debug writelns from florian's previous commit
1383
Revision 1.88 2005/02/01 23:18:54 florian
1386
p : procedure stdcall;
1390
Revision 1.87 2005/01/24 22:08:32 peter
1391
* interface wrapper generation moved to cgobj
1392
* generate interface wrappers after the module is parsed
1394
Revision 1.86 2005/01/10 20:41:55 peter
1395
* write realname for published methods
1397
Revision 1.85 2005/01/09 15:05:29 peter
1398
* fix interface vtbl optimization
1399
* replace ugly pointer construct of ioffset()
added
removed
compiler/nobj.pas
