compiler: a trial to implement record constructor

  - 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 -

compiler/ncal.pas

@@ -1652,6 +1652,10 @@ implementation
           { constructors }
           if (procdefinition.proctypeoption=potype_constructor) then
             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 }
               if (methodpointer.resultdef.typ=classrefdef) or
                  (cnf_new_call in callnodeflags) then

compiler/pdecsub.pas

@@ -292,7 +292,8 @@ implementation
                 current_tokenpos:=tprocdef(pd).fileinfo;
 
                 { 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
                    { can't use classrefdef as type because inheriting
                      will then always file because of a type mismatch }
@@ -313,7 +314,10 @@ implementation
                       vsp:=vs_var;
                     hdef:=tprocdef(pd).struct;
                   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);
 
                 current_tokenpos:=storepos;

compiler/psub.pas

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

compiler/ptype.pas

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