paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 16:49:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

compiler: a trial to implement record constructor

Browse Source 
- map self to constructor result
  - don't push vmt for records

At the moment generated assembler has errors although node tree is correct

git-svn-id: branches/paul/extended_records@16560 -
This commit is contained in:
paul 2010-12-13 06:39:29 +00:00
parent 582ab2dd32
commit 11d4eddf67
4 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/ncal.pas
View File

@ -1652,6 +1652,10 @@ implementation
{ constructors } { constructors }
if (procdefinition.proctypeoption=potype_constructor) then if (procdefinition.proctypeoption=potype_constructor) then
begin begin
{ for records self in constructor maps to result }
if (tprocdef(procdefinition).struct.typ=recorddef) then
selftree:=funcretnode.getcopy
else
{ push 0 as self when allocation is needed } { push 0 as self when allocation is needed }
if (methodpointer.resultdef.typ=classrefdef) or if (methodpointer.resultdef.typ=classrefdef) or
(cnf_new_call in callnodeflags) then (cnf_new_call in callnodeflags) then

8
compiler/pdecsub.pas
View File

@ -292,7 +292,8 @@ implementation
current_tokenpos:=tprocdef(pd).fileinfo; current_tokenpos:=tprocdef(pd).fileinfo;
{ Generate VMT variable for constructor/destructor } { Generate VMT variable for constructor/destructor }
if (pd.proctypeoption in [potype_constructor,potype_destructor]) and not(is_cppclass(tprocdef(pd).struct)) then if (pd.proctypeoption in [potype_constructor,potype_destructor]) and
not(is_cppclass(tprocdef(pd).struct) or is_record(tprocdef(pd).struct)) then
begin begin
{ can't use classrefdef as type because inheriting { can't use classrefdef as type because inheriting
will then always file because of a type mismatch } will then always file because of a type mismatch }
@ -313,7 +314,10 @@ implementation
vsp:=vs_var; vsp:=vs_var;
hdef:=tprocdef(pd).struct; hdef:=tprocdef(pd).struct;
end; end;
vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]); if is_record(tprocdef(pd).struct) and (pd.proctypeoption=potype_constructor) then
vs:=tparavarsym.create('$self',paranr_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para,vo_is_funcret])
else
vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
pd.parast.insert(vs); pd.parast.insert(vs);
current_tokenpos:=storepos; current_tokenpos:=storepos;

16
compiler/psub.pas
View File

@ -345,16 +345,18 @@ implementation
ccallnode.createintern('fpc_help_constructor',para))); ccallnode.createintern('fpc_help_constructor',para)));
end end
else else
internalerror(200305103); if not is_record(current_structdef) then
internalerror(200305103);
{ if self=nil then exit { if self=nil then exit
calling fail instead of exit is useless because calling fail instead of exit is useless because
there is nothing to dispose (PFV) } there is nothing to dispose (PFV) }
addstatement(newstatement,cifnode.create( if is_class_or_object(current_structdef) then
caddnode.create(equaln, addstatement(newstatement,cifnode.create(
load_self_pointer_node, caddnode.create(equaln,
cnilnode.create), load_self_pointer_node,
cexitnode.create(nil), cnilnode.create),
nil)); cexitnode.create(nil),
nil));
end; end;
{ maybe call BeforeDestruction for classes } { maybe call BeforeDestruction for classes }

6
compiler/ptype.pas
View File

@ -764,11 +764,7 @@ implementation
if is_classdef then if is_classdef then
pd:=class_constructor_head pd:=class_constructor_head
else else
begin pd:=constructor_head;
pd:=constructor_head;
{ raise internal error for now - constructor is not implemented yet }
internalerror(201012110);
end;
parse_record_proc_directives(pd); parse_record_proc_directives(pd);
handle_calling_convention(pd); handle_calling_convention(pd);