* problem with previous REGALLOC solved

  * improved property support

compiler/cgi386.pas

@@ -2080,7 +2080,6 @@ implementation
 
       var
          opsize : topsize;
-         {pushed,}withresult : boolean;
          otlabel,hlabel,oflabel : plabel;
          hregister : tregister;
          loc : tloc;
@@ -2090,7 +2089,6 @@ implementation
          oflabel:=falselabel;
          getlabel(truelabel);
          getlabel(falselabel);
-         withresult:=false;
          { calculate left sides }
          secondpass(p^.left);
          case p^.left^.location.loc of
@@ -2165,8 +2163,7 @@ implementation
              { we do not need destination anymore }
              del_reference(p^.left^.location.reference);
              { only source if withresult is set }
-             if not(withresult) then
-               del_reference(p^.right^.location.reference);
+             del_reference(p^.right^.location.reference);
              loadstring(p);
              ungetiftemp(p^.right^.location.reference);
            end
@@ -2197,8 +2194,7 @@ implementation
                          else
                            begin
                               concatcopy(p^.right^.location.reference,
-                                p^.left^.location.reference,p^.left^.resulttype^.size,
-                                withresult);
+                                p^.left^.location.reference,p^.left^.resulttype^.size,false);
                               ungetiftemp(p^.right^.location.reference);
                            end;
                       end;
@@ -2824,7 +2820,12 @@ implementation
                                          exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)));
                                       end;
 
-                                    exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+                                    { direct call to class constructor, don't allocate memory }
+                                    if is_con_or_destructor and (p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                      (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                      exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
+                                    else
+                                      exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
                                     if is_con_or_destructor then
                                       begin
                                          { classes don't get a VMT pointer pushed }
@@ -2960,6 +2961,7 @@ implementation
                        if ((aktprocsym^.properties and sp_static)<>0) or
                         ((aktprocsym^.definition^.options and poclassmethod)<>0) or
                         ((p^.procdefinition^.options and postaticmethod)<>0) or
+                        ((p^.procdefinition^.options and poconstructor)<>0) or
                         { ESI is loaded earlier }
                         ((p^.procdefinition^.options and poclassmethod)<>0)then
                          begin
@@ -2979,6 +2981,9 @@ implementation
                          end;
                      end
                    else
+                     { aktprocsym should be assigned, also in main program }
+                     internalerror(12345);
+                   {
                      begin
                        new(r);
                        reset_reference(r^);
@@ -2988,6 +2993,7 @@ implementation
                        reset_reference(r^);
                        r^.base:=R_EDI;
                      end;
+                   }
                    if p^.procdefinition^.extnumber=-1 then
                         internalerror($Da);
                    r^.offset:=p^.procdefinition^.extnumber*4+12;
@@ -5709,7 +5715,11 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.7  1998-04-09 14:28:05  jonas
+  Revision 1.8  1998-04-09 22:16:33  florian
+    * problem with previous REGALLOC solved
+    * improved property support
+
+  Revision 1.7  1998/04/09 14:28:05  jonas
     + basic k6 and 6x86 optimizing support (-O7 and -O8)
 
   Revision 1.6  1998/04/08 11:34:20  peter

compiler/pass_1.pas

@@ -2393,24 +2393,24 @@ unit pass_1;
               p^.resulttype:=p^.left^.resulttype;
            end
          { if we know the routine which is called, then the type }
-         { conversions are inserted                            }
+         { conversions are inserted                              }
          else
            begin
                if count_ref then
-                     begin
-                     store_valid:=must_be_valid;
-                     if (defcoll^.paratyp<>vs_var) then
-                       must_be_valid:=true
-                     else
-                       must_be_valid:=false;
-                     { here we must add something for the implicit type }
-                     { conversion from array of char to pchar }
-                     if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,p^.left^.treetype) then
-                       if convtyp=tc_array_to_pointer then
-                         must_be_valid:=false;
-                     firstpass(p^.left);
-                     must_be_valid:=store_valid;
-                     End;
+                 begin
+                    store_valid:=must_be_valid;
+                    if (defcoll^.paratyp<>vs_var) then
+                      must_be_valid:=true
+                    else
+                      must_be_valid:=false;
+                    { here we must add something for the implicit type }
+                    { conversion from array of char to pchar }
+                    if isconvertable(p^.left^.resulttype,defcoll^.data,convtyp,p^.left^.treetype) then
+                      if convtyp=tc_array_to_pointer then
+                        must_be_valid:=false;
+                    firstpass(p^.left);
+                    must_be_valid:=store_valid;
+                 end;
               if not((p^.left^.resulttype^.deftype=stringdef) and
                      (defcoll^.data^.deftype=stringdef)) and
                      (defcoll^.data^.deftype<>formaldef) then
@@ -2438,7 +2438,7 @@ unit pass_1;
                          ) and
                      not(is_equal(p^.left^.resulttype,defcoll^.data))) then
                        Message(parser_e_call_by_ref_without_typeconv);
-                   { don't generate an type conversion for open arrays }
+                   { don't generate an type conversion for open arrays   }
                    { else we loss the ranges                             }
                    if not(is_open_array(defcoll^.data)) then
                      begin
@@ -2534,24 +2534,81 @@ unit pass_1;
          procs:=nil;
          { made this global for disposing !! }
          store_valid:=must_be_valid;
-         if not assigned(p^.procdefinition) then
+         must_be_valid:=false;
+
+         { procedure variable ? }
+         if assigned(p^.right) then
            begin
-              must_be_valid:=false;
-              { procedure variable ? }
-              if not(assigned(p^.right)) then
+              { procedure does a call }
+              procinfo.flags:=procinfo.flags or pi_do_call;
+
+              { calc the correture value for the register }
+{$ifdef i386}
+              for regi:=R_EAX to R_EDI do
+                inc(reg_pushes[regi],t_times*2);
+{$endif}
+{$ifdef m68k}
+              for regi:=R_D0 to R_A6 do
+                inc(reg_pushes[regi],t_times*2);
+{$endif}
+              { calculate the type of the parameters }
+              if assigned(p^.left) then
                 begin
-                   if assigned(p^.left) then
-                     begin
-                        old_count_ref:=count_ref;
-                        count_ref:=false;
-                        store_valid:=must_be_valid;
-                        must_be_valid:=false;
-                        firstcallparan(p^.left,nil);
-                        count_ref:=old_count_ref;
-                        must_be_valid:=store_valid;
-                        if codegenerror then
-                          exit;
-                     end;
+                   old_count_ref:=count_ref;
+                   count_ref:=false;
+                   firstcallparan(p^.left,nil);
+                   count_ref:=old_count_ref;
+                   if codegenerror then
+                     exit;
+                end;
+              firstpass(p^.right);
+
+              { check the parameters }
+              pdc:=pprocvardef(p^.right^.resulttype)^.para1;
+              pt:=p^.left;
+              while assigned(pdc) and assigned(pt) do
+                begin
+                   pt:=pt^.right;
+                   pdc:=pdc^.next;
+                end;
+              if assigned(pt) or assigned(pdc) then
+               Message(parser_e_illegal_parameter_list);
+
+              { insert type conversions }
+              if assigned(p^.left) then
+                begin
+                   old_count_ref:=count_ref;
+                   count_ref:=true;
+                   firstcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1);
+                   count_ref:=old_count_ref;
+                   if codegenerror then
+                     exit;
+                end;
+              p^.resulttype:=pprocvardef(p^.right^.resulttype)^.retdef;
+              { this was missing, leads to a bug below if
+                the procvar is a function }
+              p^.procdefinition:=pprocdef(p^.right^.resulttype);
+           end
+         else
+           begin
+              { determine the type of the parameters }
+              if assigned(p^.left) then
+                begin
+                   old_count_ref:=count_ref;
+                   count_ref:=false;
+                   store_valid:=must_be_valid;
+                   must_be_valid:=false;
+                   firstcallparan(p^.left,nil);
+                   count_ref:=old_count_ref;
+                   must_be_valid:=store_valid;
+                   if codegenerror then
+                     exit;
+                end;
+
+              { do we know the procedure to call ? }
+              if not(assigned(p^.procdefinition)) then
+                begin
+
                    { determine length of parameter list }
                    pt:=p^.left;
                    paralength:=0;
@@ -2876,117 +2933,61 @@ unit pass_1;
                         p^.methodpointer:=nil;
                      end;
 {$endif CHAINPROCSYMS}
+                end; { end of procedure to call determination }
+              { work trough all parameters to insert the type conversions }
+              if assigned(p^.left) then
+                begin
+                   old_count_ref:=count_ref;
+                   count_ref:=true;
+                   firstcallparan(p^.left,p^.procdefinition^.para1);
+                   count_ref:=old_count_ref;
+                end;
 
-                   { work trough all parameters to insert the type conversions }
-                   if assigned(p^.left) then
-                     begin
-                        old_count_ref:=count_ref;
-                        count_ref:=true;
-                        firstcallparan(p^.left,p^.procdefinition^.para1);
-                        count_ref:=old_count_ref;
-                     end;
-                   { handle predefined procedures }
-                   if (p^.procdefinition^.options and pointernproc)<>0 then
-                     begin
-                        { settextbuf needs two args }
-                        if assigned(p^.left^.right) then
-                          pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,p^.left)
-                        else
-                          begin
-                             pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,p^.left^.left);
-                             putnode(p^.left);
-                          end;
-                        putnode(p);
-                        firstpass(pt);
-                        { was placed after the exit          }
-                        { caused GPF                         }
-                        { error caused and corrected by (PM) }
-                        p:=pt;
-
-                        must_be_valid:=store_valid;
-                        if codegenerror then
-                          exit;
-
-                        dispose(procs);
-                        exit;
-                     end
+              { handle predefined procedures }
+              if (p^.procdefinition^.options and pointernproc)<>0 then
+                begin
+                   { settextbuf needs two args }
+                   if assigned(p^.left^.right) then
+                     pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,p^.left)
                    else
-                     { no intern procedure => we do a call }
-                     procinfo.flags:=procinfo.flags or pi_do_call;
-
-                   { calc the correture value for the register }
-{$ifdef i386}
-                   { calc the correture value for the register }
-                   for regi:=R_EAX to R_EDI do
                      begin
-                        if (p^.procdefinition^.usedregisters and ($80 shr word(regi)))<>0 then
-                          inc(reg_pushes[regi],t_times*2);
+                        pt:=geninlinenode(pprocdef(p^.procdefinition)^.extnumber,p^.left^.left);
+                        putnode(p^.left);
                      end;
-{$endif}
-{$ifdef m68k}
-                  for regi:=R_D0 to R_A6 do
-                    begin
-                       if (p^.procdefinition^.usedregisters and ($800 shr word(regi)))<>0 then
-                         inc(reg_pushes[regi],t_times*2);
-                    end;
-{$endif}
+                   putnode(p);
+                   firstpass(pt);
+                   { was placed after the exit          }
+                   { caused GPF                         }
+                   { error caused and corrected by (PM) }
+                   p:=pt;
+
+                   must_be_valid:=store_valid;
+                   if codegenerror then
+                     exit;
+
+                   dispose(procs);
+                   exit;
                 end
               else
-                begin
-                   { procedure variable }
-                   { die Typen der Parameter berechnen }
-
-                   { procedure does a call }
-                   procinfo.flags:=procinfo.flags or pi_do_call;
+                { no intern procedure => we do a call }
+                procinfo.flags:=procinfo.flags or pi_do_call;
 
+              { calc the correture value for the register }
 {$ifdef i386}
-                   { calc the correture value for the register }
-                   for regi:=R_EAX to R_EDI do
+              for regi:=R_EAX to R_EDI do
+                begin
+                   if (p^.procdefinition^.usedregisters and ($80 shr word(regi)))<>0 then
                      inc(reg_pushes[regi],t_times*2);
+                end;
 {$endif}
 {$ifdef m68k}
-                   { calc the correture value for the register }
-                   for regi:=R_D0 to R_A6 do
-                     inc(reg_pushes[regi],t_times*2);
+             for regi:=R_D0 to R_A6 do
+               begin
+                  if (p^.procdefinition^.usedregisters and ($800 shr word(regi)))<>0 then
+                    inc(reg_pushes[regi],t_times*2);
+               end;
 {$endif}
-                   if assigned(p^.left) then
-                     begin
-                        old_count_ref:=count_ref;
-                        count_ref:=false;
-                        firstcallparan(p^.left,nil);
-                        count_ref:=old_count_ref;
-                        if codegenerror then
-                          exit;
-                     end;
-                   firstpass(p^.right);
-
-                   { check the parameters }
-                   pdc:=pprocvardef(p^.right^.resulttype)^.para1;
-                   pt:=p^.left;
-                   while assigned(pdc) and assigned(pt) do
-                     begin
-                        pt:=pt^.right;
-                        pdc:=pdc^.next;
-                     end;
-                   if assigned(pt) or assigned(pdc) then
-                    Message(parser_e_illegal_parameter_list);
-
-                   { insert type conversions }
-                   if assigned(p^.left) then
-                     begin
-                        old_count_ref:=count_ref;
-                        count_ref:=true;
-                        firstcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1);
-                        count_ref:=old_count_ref;
-                        if codegenerror then
-                          exit;
-                     end;
-                   p^.resulttype:=pprocvardef(p^.right^.resulttype)^.retdef;
-                   { this was missing , leads to a bug below if
-                     the procvar is a function }
-                   p^.procdefinition:=pprocdef(p^.right^.resulttype);
-                end;
-         end; { not assigned(p^.procdefinition) }
+           end; { not assigned(p^.procdefinition) }
 
          { get a register for the return value }
          if (p^.resulttype<>pdef(voiddef)) then
@@ -4495,7 +4496,11 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.5  1998-04-08 16:58:04  pierre
+  Revision 1.6  1998-04-09 22:16:34  florian
+    * problem with previous REGALLOC solved
+    * improved property support
+
+  Revision 1.5  1998/04/08 16:58:04  pierre
     * several bugfixes
       ADD ADC and AND are also sign extended
       nasm output OK (program still crashes at end

compiler/pdecl.pas

@@ -370,6 +370,7 @@ unit pdecl;
            sc : pstringcontainer;
            hp : pdef;
            s : string;
+           pp : pprocdef;
 
         begin
            { check for a class }
@@ -471,8 +472,11 @@ unit pdecl;
                           { take the whole info: }
                           p^.options:=ppropertysym(overriden)^.options;
                           p^.index:=ppropertysym(overriden)^.index;
+                          p^.proptype:=ppropertysym(overriden)^.proptype;
                           p^.writeaccesssym:=ppropertysym(overriden)^.writeaccesssym;
                           p^.readaccesssym:=ppropertysym(overriden)^.readaccesssym;
+                          p^.writeaccessdef:=ppropertysym(overriden)^.writeaccessdef;
+                          p^.readaccessdef:=ppropertysym(overriden)^.readaccessdef;
                        end
                      else
                        begin
@@ -480,6 +484,12 @@ unit pdecl;
                           message(parser_e_no_property_found_to_override);
                        end;
                   end;
+                { create data defcoll to allow correct parameter checks }
+                new(datacoll);
+                datacoll^.paratyp:=vs_value;
+                datacoll^.data:=p^.proptype;
+                datacoll^.next:=nil;
+
                 if (token=ID) and (pattern='READ') then
                   begin
                      consume(ID);
@@ -492,14 +502,27 @@ unit pdecl;
                           { varsym aren't allowed for an indexed property
                             or an property with parameters }
                           if ((sym^.typ=varsym) and
-                            (((p^.options and ppo_indexed)<>0) or
-                             assigned(propertyparas))) or
+                             { not necessary, an index forces propertyparas
+                               to be assigned
+                             }
+                             { (((p^.options and ppo_indexed)<>0) or }
+                             assigned(propertyparas)) or
                              not(sym^.typ in [varsym,procsym]) then
                             Message(parser_e_ill_property_access_sym);
                           { search the matching definition }
                           if sym^.typ=procsym then
                             begin
-                               { !!!!!! }
+                               pp:=get_procdef;
+                               if not(assigned(pp)) or
+                                 not(is_equal(pp^.retdef,p^.proptype)) then
+                                 Message(parser_e_ill_property_access_sym);
+                               p^.readaccessdef:=pp;
+                            end
+                          else if sym^.typ=varsym then
+                            begin
+                               if not(is_equal(pvarsym(sym)^.definition,
+                                 p^.proptype)) then
+                                 Message(parser_e_ill_property_access_sym);
                             end;
                           p^.readaccesssym:=sym;
                        end;
@@ -513,16 +536,28 @@ unit pdecl;
                        Message1(sym_e_unknown_id,pattern)
                      else
                        begin
-                          { !!!! check sym }
                           if ((sym^.typ=varsym) and
-                            (((p^.options and ppo_indexed)<>0)
-                            { or property paras })) or
+                             assigned(propertyparas)) or
                              not(sym^.typ in [varsym,procsym]) then
                             Message(parser_e_ill_property_access_sym);
                           { search the matching definition }
                           if sym^.typ=procsym then
                             begin
-                               { !!!!!! }
+                               { insert data entry to check access method }
+                               datacoll^.next:=propertyparas;
+                               propertyparas:=datacoll;
+                               pp:=get_procdef;
+                               { ... and remove it }
+                               propertyparas:=propertyparas^.next;
+                               if not(assigned(pp)) then
+                                 Message(parser_e_ill_property_access_sym);
+                               p^.writeaccessdef:=pp;
+                            end
+                          else if sym^.typ=varsym then
+                            begin
+                               if not(is_equal(pvarsym(sym)^.definition,
+                                 p^.proptype)) then
+                                 Message(parser_e_ill_property_access_sym);
                             end;
                           p^.writeaccesssym:=sym;
                        end;
@@ -536,23 +571,7 @@ unit pdecl;
                 if (token=ID) and (pattern='DEFAULT') then
                   begin
                      consume(ID);
-                     if token=SEMICOLON then
-                       begin
-                          p2:=search_default_property(aktclass);
-                          if assigned(p2) then
-                            message1(parser_e_only_one_default_property,
-                              pobjectdef(p2^.owner^.defowner)^.name^)
-                          else
-                            begin
-                               p^.options:=p^.options and ppo_defaultproperty;
-                               if not(assigned(propertyparas)) then
-                                 message(parser_e_property_need_paras);
-                            end;
-                       end
-                     else
-                       begin
-                          { !!!!!!! storage }
-                       end;
+                     { !!!!!!! storage }
                      consume(SEMICOLON);
                   end
                 else if (token=ID) and (pattern='NODEFAULT') then
@@ -561,13 +580,32 @@ unit pdecl;
                      { !!!!!!!! }
                   end;
                 symtablestack^.insert(p);
+                { default property ? }
+                consume(SEMICOLON);
+                if (token=ID) and (pattern='DEFAULT') then
+                  begin
+                     consume(ID);
+                     p2:=search_default_property(aktclass);
+                     if assigned(p2) then
+                       message1(parser_e_only_one_default_property,
+                         pobjectdef(p2^.owner^.defowner)^.name^)
+                     else
+                       begin
+                          p^.options:=p^.options or ppo_defaultproperty;
+                          if not(assigned(propertyparas)) then
+                            message(parser_e_property_need_paras);
+                       end;
+                     consume(SEMICOLON);
+                  end;
                 { clean up }
                 if assigned(datacoll) then
                   dispose(datacoll);
              end
            else
-              consume(ID);
-           consume(SEMICOLON);
+             begin
+                consume(ID);
+                consume(SEMICOLON);
+             end;
         end;
 
       procedure destructor_head;
@@ -1689,7 +1727,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.5  1998-04-08 14:59:20  florian
+  Revision 1.6  1998-04-09 22:16:35  florian
+    * problem with previous REGALLOC solved
+    * improved property support
+
+  Revision 1.5  1998/04/08 14:59:20  florian
     * problem with new expr_type solved
 
   Revision 1.4  1998/04/08 10:26:09  florian

compiler/pexpr.pas

@@ -418,15 +418,140 @@ unit pexpr;
          afterassignment:=prevafterassn;
       end;
 
+    { the following procedure handles the access to a property symbol }
+    procedure handle_propertysym(sym : psym;var p1 : ptree;
+      var pd : pdef);
+
+      var
+         paras : ptree;
+         oldafterassignment : boolean;
+         p2 : ptree;
+
+      begin
+         paras:=nil;
+         { property parameters? }
+         if token=LECKKLAMMER then
+           begin
+              consume(LECKKLAMMER);
+              paras:=parse_paras(false,true);
+              consume(RECKKLAMMER);
+           end;
+         { indexed property }
+         if (ppropertysym(sym)^.options and ppo_indexed)<>0 then
+           begin
+              p2:=genordinalconstnode(ppropertysym(sym)^.index,s32bitdef);
+              paras:=gencallparanode(p2,paras);
+           end;
+         if not(afterassignment) and not(in_args) then
+           begin
+              { write property: }
+              { no result }
+              pd:=voiddef;
+              if assigned(ppropertysym(sym)^.writeaccesssym) then
+                begin
+                   if ppropertysym(sym)^.writeaccesssym^.typ=procsym then
+                     begin
+                        { generate the method call }
+                        p1:=genmethodcallnode(pprocsym(
+                          ppropertysym(sym)^.writeaccesssym),
+                          ppropertysym(sym)^.writeaccesssym^.owner,p1);
+                        { we know the procedure to call, so
+                          force the usage of that procedure }
+                        p1^.procdefinition:=pprocdef(ppropertysym(sym)^.writeaccessdef);
+                        p1^.left:=paras;
+                        { to be on the save side }
+                        oldafterassignment:=afterassignment;
+                        consume(ASSIGNMENT);
+                        { read the expression }
+                        afterassignment:=true;
+                        p2:=expr;
+                        p1^.left:=gencallparanode(p2,p1^.left);
+                        afterassignment:=oldafterassignment;
+                     end
+                   else if ppropertysym(sym)^.writeaccesssym^.typ=varsym then
+                     begin
+                        if assigned(paras) then
+                          message(parser_e_no_paras_allowed);
+                        p1:=gensubscriptnode(pvarsym(
+                          ppropertysym(sym)^.readaccesssym),p1);
+                        { to be on the save side }
+                        oldafterassignment:=afterassignment;
+                        consume(ASSIGNMENT);
+                        { read the expression }
+                        afterassignment:=true;
+                        p2:=expr;
+                        p1:=gennode(assignn,p1,p2);
+                        afterassignment:=oldafterassignment;
+                     end
+                   else
+                     begin
+                        p1:=genzeronode(errorn);
+                        Message(parser_e_no_procedure_to_access_property);
+                     end;
+                end
+              else
+                begin
+                   p1:=genzeronode(errorn);
+                   Message(parser_e_no_procedure_to_access_property);
+                end;
+           end
+         else
+           begin
+              { read property: }
+              pd:=ppropertysym(sym)^.proptype;
+              if assigned(ppropertysym(sym)^.readaccesssym) then
+                begin
+                   if ppropertysym(sym)^.readaccesssym^.typ=varsym then
+                     begin
+                        if assigned(paras) then
+                          message(parser_e_no_paras_allowed);
+                        p1:=gensubscriptnode(pvarsym(
+                          ppropertysym(sym)^.readaccesssym),p1);
+                        pd:=pvarsym(sym)^.definition;
+                     end
+                   else if ppropertysym(sym)^.readaccesssym^.typ=procsym then
+                     begin
+                        { generate the method call }
+                        p1:=genmethodcallnode(pprocsym(
+                          ppropertysym(sym)^.readaccesssym),
+                          ppropertysym(sym)^.readaccesssym^.owner,p1);
+                        { we know the procedure to call, so
+                          force the usage of that procedure }
+                        p1^.procdefinition:=pprocdef(ppropertysym(sym)^.writeaccessdef);
+                        { insert paras }
+                        p1^.left:=paras;
+
+                        { if we should be delphi compatible  }
+                        { then force type conversion         }
+                        { isn't neccessary, the result types }
+                        { have to match excatly              }
+                        {if cs_delphi2_compatible in aktswitches then
+                          p1:=gentypeconvnode(p1,pd);
+                        }
+                     end
+                   else
+                     begin
+                        p1:=genzeronode(errorn);
+                        Message(sym_e_type_mismatch);
+                     end;
+                end
+              else
+                begin
+                   { error, no function to read property }
+                   p1:=genzeronode(errorn);
+                   Message(parser_e_no_procedure_to_access_property);
+                end;
+           end;
+      end;
+
+
     { the ID token has to be consumed before calling this function }
     procedure do_member_read(const sym : psym;var p1 : ptree;
       var pd : pdef;var again : boolean);
 
       var
          static_name : string;
-         paras : ptree;
-         oldafterassignment,isclassref : boolean;
-         p2 : ptree;
+         isclassref : boolean;
 
       begin
          if sym=nil then
@@ -472,110 +597,7 @@ unit pexpr;
                    begin
                       if isclassref then
                         Message(parser_e_only_class_methods_via_class_ref);
-                      paras:=nil;
-                      { property parameters? }
-                      if token=LECKKLAMMER then
-                        begin
-                           consume(LECKKLAMMER);
-                           paras:=parse_paras(false,true);
-                           consume(RECKKLAMMER);
-                        end;
-                      { indexed property }
-                      if (ppropertysym(sym)^.options and ppo_indexed)<>0 then
-                        begin
-                           p2:=genordinalconstnode(ppropertysym(sym)^.index,s32bitdef);
-                           paras:=gencallparanode(p2,paras);
-                        end;
-                      if not(afterassignment) and not(in_args) then
-                        begin
-                           { write property: }
-                           { no result }
-                           pd:=voiddef;
-                           if assigned(ppropertysym(sym)^.writeaccesssym) then
-                             begin
-                                if ppropertysym(sym)^.writeaccesssym^.typ=procsym then
-                                  begin
-                                     { generate the method call }
-                                     p1:=genmethodcallnode(pprocsym(
-                                       ppropertysym(sym)^.writeaccesssym),
-                                       ppropertysym(sym)^.writeaccesssym^.owner,p1);
-                                     p1^.left:=paras;
-                                     { to be on the save side }
-                                     oldafterassignment:=afterassignment;
-                                     consume(ASSIGNMENT);
-                                     { read the expression }
-                                     afterassignment:=true;
-                                     p2:=expr;
-                                     p1^.left:=gencallparanode(p2,p1^.left);
-                                     afterassignment:=oldafterassignment;
-                                  end
-                                else if ppropertysym(sym)^.writeaccesssym^.typ=varsym then
-                                  begin
-                                     if assigned(paras) then
-                                       message(parser_e_no_paras_allowed);
-                                     p1:=gensubscriptnode(pvarsym(
-                                       ppropertysym(sym)^.readaccesssym),p1);
-                                     { to be on the save side }
-                                     oldafterassignment:=afterassignment;
-                                     consume(ASSIGNMENT);
-                                     { read the expression }
-                                     afterassignment:=true;
-                                     p2:=expr;
-                                     p1:=gennode(assignn,p1,p2);
-                                     afterassignment:=oldafterassignment;
-                                  end
-                                else
-                                  begin
-                                     p1:=genzeronode(errorn);
-                                     Message(parser_e_no_procedure_to_access_property);
-                                  end;
-                             end
-                           else
-                             begin
-                                p1:=genzeronode(errorn);
-                                Message(parser_e_no_procedure_to_access_property);
-                             end;
-                        end
-                      else
-                        begin
-                           { read property: }
-                           pd:=ppropertysym(sym)^.proptype;
-                           if assigned(ppropertysym(sym)^.readaccesssym) then
-                             begin
-                                if ppropertysym(sym)^.readaccesssym^.typ=varsym then
-                                  begin
-                                     if assigned(paras) then
-                                       message(parser_e_no_paras_allowed);
-                                     p1:=gensubscriptnode(pvarsym(
-                                       ppropertysym(sym)^.readaccesssym),p1);
-                                     pd:=pvarsym(sym)^.definition;
-                                  end
-                                else if ppropertysym(sym)^.readaccesssym^.typ=procsym then
-                                  begin
-                                     { generate the method call }
-                                     p1:=genmethodcallnode(pprocsym(
-                                       ppropertysym(sym)^.readaccesssym),
-                                       ppropertysym(sym)^.readaccesssym^.owner,p1);
-                                     { insert paras }
-                                     p1^.left:=paras;
-                                     { if we should be delphi compatible }
-                                     { then force type conversion      }
-                                     if cs_delphi2_compatible in aktswitches then
-                                       p1:=gentypeconvnode(p1,pd);
-                                  end
-                                else
-                                  begin
-                                     p1:=genzeronode(errorn);
-                                     Message(sym_e_type_mismatch);
-                                  end;
-                             end
-                           else
-                             begin
-                                { error, no function to read property }
-                                p1:=genzeronode(errorn);
-                                Message(parser_e_no_procedure_to_access_property);
-                             end;
-                        end;
+                      handle_propertysym(sym,p1,pd);
                    end;
                  else internalerror(16);
               end;
@@ -595,6 +617,7 @@ unit pexpr;
          classh : pobjectdef;
          d : bestreal;
          constset : pconstset;
+         propsym : ppropertysym;
 
 
       { p1 and p2 must contain valid values }
@@ -621,148 +644,171 @@ unit pexpr;
                              pd:=ppointerdef(pd)^.definition;
                           end;
                      end;
-                   LECKKLAMMER : begin
-                                    consume(LECKKLAMMER);
-                                    repeat
-                                      if (pd^.deftype<>arraydef) and
-                                         (pd^.deftype<>stringdef) and
-                                         (pd^.deftype<>pointerdef) then
-                                        begin
-                                           Message(cg_e_invalid_qualifier);
-                                           disposetree(p1);
-                                           p1:=genzeronode(errorn);
-                                        end
-                                      else if (pd^.deftype=pointerdef) then
-                                        begin
+                   LECKKLAMMER:
+                     begin
+                        if (pd^.deftype=objectdef) and
+                          pobjectdef(pd)^.isclass then
+                          begin
+                             { default property }
+                             propsym:=search_default_property(pobjectdef(pd));
+                             if not(assigned(propsym)) then
+                               begin
+                                  disposetree(p1);
+                                  p1:=genzeronode(errorn);
+                                  again:=false;
+                               end
+                             else
+                               begin
+                                  p1:=nil;
+                                  handle_propertysym(propsym,p1,pd);
+                               end;
+                          end
+                        else
+                          begin
+                             consume(LECKKLAMMER);
+                             repeat
+                               if (pd^.deftype<>arraydef) and
+                                  (pd^.deftype<>stringdef) and
+                                  (pd^.deftype<>pointerdef) then
+                                 begin
+                                    Message(cg_e_invalid_qualifier);
+                                    disposetree(p1);
+                                    p1:=genzeronode(errorn);
+                                    again:=false;
+                                 end
+                               else if (pd^.deftype=pointerdef) then
+                                 begin
+                                    p2:=expr;
+                                    p1:=gennode(vecn,p1,p2);
+                                    pd:=ppointerdef(pd)^.definition;
+                                 end
+                               else
+                                 begin
+                                    p2:=expr;
+                                  { support SEG:OFS for go32v2 Mem[] }
+                                    if (target_info.target=target_GO32V2) and
+                                       (p1^.treetype=loadn) and
+                                       assigned(p1^.symtableentry) and
+                                       assigned(p1^.symtableentry^.owner^.name) and
+                                       (p1^.symtableentry^.owner^.name^='SYSTEM') and
+                                       ((p1^.symtableentry^.name='MEM') or
+                                        (p1^.symtableentry^.name='MEMW') or
+                                        (p1^.symtableentry^.name='MEML')) then
+                                      begin
+                                        if (token=COLON) then
+                                         begin
+                                           consume(COLON);
+                                           p3:=gennode(muln,genordinalconstnode($10,s32bitdef),p2);
                                            p2:=expr;
+                                           p2:=gennode(addn,p2,p3);
                                            p1:=gennode(vecn,p1,p2);
-                                           pd:=ppointerdef(pd)^.definition;
-                                        end
-                                      else
-                                        begin
-                                           p2:=expr;
-                                         { support SEG:OFS for go32v2 Mem[] }
-                                           if (target_info.target=target_GO32V2) and
-                                              (p1^.treetype=loadn) and
-                                              assigned(p1^.symtableentry) and
-                                              assigned(p1^.symtableentry^.owner^.name) and
-                                              (p1^.symtableentry^.owner^.name^='SYSTEM') and
-                                              ((p1^.symtableentry^.name='MEM') or
-                                               (p1^.symtableentry^.name='MEMW') or
-                                               (p1^.symtableentry^.name='MEML')) then
-                                             begin
-                                               if (token=COLON) then
-                                                begin
-                                                  consume(COLON);
-                                                  p3:=gennode(muln,genordinalconstnode($10,s32bitdef),p2);
-                                                  p2:=expr;
-                                                  p2:=gennode(addn,p2,p3);
-                                                  p1:=gennode(vecn,p1,p2);
-                                                  p1^.memseg:=true;
-                                                  p1^.memindex:=true;
-                                                end
-                                               else
-                                                begin
-                                                  p1:=gennode(vecn,p1,p2);
-                                                  p1^.memindex:=true;
-                                                end;
-                                             end
-                                           { else
-                                           if (target_info.target=target_GO32V2) and
-                                              assigned(p1^.symtableentry) and
-                                              assigned(p1^.symtableentry^.owner^.name) and
-                                              (p1^.symtableentry^.owner^.name^='SYSTEM') and
-                                              ((p1^.symtableentry^.name='PORT') or
-                                               (p1^.symtableentry^.name='PORTW') or
-                                               (p1^.symtableentry^.name='PORTL')) then
-                                                begin
-                                                  p1:=gennode(vecn,p1,p2);
-                                                  p1^.portindex:=true;
-                                                  p
-                                                end;
-                                             end      }
-                                           else
-                                             p1:=gennode(vecn,p1,p2);
-                                           if pd^.deftype=stringdef then
-                                             pd:=cchardef
-                                           else
-                                             pd:=parraydef(pd)^.definition;
-                                        end;
-                                      if token=COMMA then consume(COMMA)
-                                        else break;
-                                    until false;
-                                    consume(RECKKLAMMER);
-                                 end;
-                   POINT       : begin
-                                    consume(POINT);
-                                    case pd^.deftype of
-                                       recorddef:
-                                             begin
-                                                sym:=pvarsym(precdef(pd)^.symtable^.search(pattern));
-                                                consume(ID);
-                                                if sym=nil then
-                                                  begin
-                                                     Message(sym_e_illegal_field);
-                                                     disposetree(p1);
-                                                     p1:=genzeronode(errorn);
-                                                  end
-                                                else
-                                                  begin
-                                                     p1:=gensubscriptnode(sym,p1);
-                                                     pd:=sym^.definition;
-                                                  end;
-                                             end;
-                                       classrefdef:
+                                           p1^.memseg:=true;
+                                           p1^.memindex:=true;
+                                         end
+                                        else
                                          begin
-                                            classh:=pobjectdef(pclassrefdef(pd)^.definition);
-                                            sym:=nil;
-                                            while assigned(classh) do
-                                              begin
-                                                 sym:=pvarsym(classh^.publicsyms^.search(pattern));
-                                                 srsymtable:=classh^.publicsyms;
-                                                 if assigned(sym) then
-                                                   break;
-                                                 classh:=classh^.childof;
-                                              end;
-                                            consume(ID);
-                                            do_member_read(sym,p1,pd,again);
+                                           p1:=gennode(vecn,p1,p2);
+                                           p1^.memindex:=true;
                                          end;
-                                       objectdef:
-                                             begin
-                                                classh:=pobjectdef(pd);
-                                                sym:=nil;
-                                                while assigned(classh) do
-                                                  begin
-                                                     sym:=pvarsym(classh^.publicsyms^.search(pattern));
-                                                     srsymtable:=classh^.publicsyms;
-                                                     if assigned(sym) then
-                                                       break;
-                                                     classh:=classh^.childof;
-                                                  end;
-                                                consume(ID);
-                                                do_member_read(sym,p1,pd,again);
-                                             end;
-                                       pointerdef:
-                                          begin
-                                             if ppointerdef(pd)^.definition^.deftype
-                                                in [recorddef,objectdef,classrefdef] then
-                                                begin
-                                                   Message(cg_e_invalid_qualifier);
-                                                   { exterror:=strpnew(' may be pointer deref ^ is missing');
-                                                   error(invalid_qualifizier); }
-                                                   Comment(V_hint,' may be pointer deref ^ is missing');
-                                                end
-                                             else
-                                                Message(cg_e_invalid_qualifier);
-                                          end
-                                          else
-                                             begin
-                                                Message(cg_e_invalid_qualifier);
-                                                disposetree(p1);
-                                                p1:=genzeronode(errorn);
-                                             end;
-                                    end;
+                                      end
+                                    { else
+                                    if (target_info.target=target_GO32V2) and
+                                       assigned(p1^.symtableentry) and
+                                       assigned(p1^.symtableentry^.owner^.name) and
+                                       (p1^.symtableentry^.owner^.name^='SYSTEM') and
+                                       ((p1^.symtableentry^.name='PORT') or
+                                        (p1^.symtableentry^.name='PORTW') or
+                                        (p1^.symtableentry^.name='PORTL')) then
+                                         begin
+                                           p1:=gennode(vecn,p1,p2);
+                                           p1^.portindex:=true;
+                                           p
+                                         end;
+                                      end      }
+                                    else
+                                      p1:=gennode(vecn,p1,p2);
+                                    if pd^.deftype=stringdef then
+                                      pd:=cchardef
+                                    else
+                                      pd:=parraydef(pd)^.definition;
                                  end;
+                               if token=COMMA then consume(COMMA)
+                                 else break;
+                             until false;
+                             consume(RECKKLAMMER);
+                          end;
+                     end;
+                   POINT:
+                     begin
+                        consume(POINT);
+                        case pd^.deftype of
+                           recorddef:
+                                 begin
+                                    sym:=pvarsym(precdef(pd)^.symtable^.search(pattern));
+                                    consume(ID);
+                                    if sym=nil then
+                                      begin
+                                         Message(sym_e_illegal_field);
+                                         disposetree(p1);
+                                         p1:=genzeronode(errorn);
+                                      end
+                                    else
+                                      begin
+                                         p1:=gensubscriptnode(sym,p1);
+                                         pd:=sym^.definition;
+                                      end;
+                                 end;
+                           classrefdef:
+                             begin
+                                classh:=pobjectdef(pclassrefdef(pd)^.definition);
+                                sym:=nil;
+                                while assigned(classh) do
+                                  begin
+                                     sym:=pvarsym(classh^.publicsyms^.search(pattern));
+                                     srsymtable:=classh^.publicsyms;
+                                     if assigned(sym) then
+                                       break;
+                                     classh:=classh^.childof;
+                                  end;
+                                consume(ID);
+                                do_member_read(sym,p1,pd,again);
+                             end;
+                           objectdef:
+                                 begin
+                                    classh:=pobjectdef(pd);
+                                    sym:=nil;
+                                    while assigned(classh) do
+                                      begin
+                                         sym:=pvarsym(classh^.publicsyms^.search(pattern));
+                                         srsymtable:=classh^.publicsyms;
+                                         if assigned(sym) then
+                                           break;
+                                         classh:=classh^.childof;
+                                      end;
+                                    consume(ID);
+                                    do_member_read(sym,p1,pd,again);
+                                 end;
+                           pointerdef:
+                              begin
+                                 if ppointerdef(pd)^.definition^.deftype
+                                    in [recorddef,objectdef,classrefdef] then
+                                    begin
+                                       Message(cg_e_invalid_qualifier);
+                                       { exterror:=strpnew(' may be pointer deref ^ is missing');
+                                       error(invalid_qualifizier); }
+                                       Comment(V_hint,' may be pointer deref ^ is missing');
+                                    end
+                                 else
+                                    Message(cg_e_invalid_qualifier);
+                              end
+                              else
+                                 begin
+                                    Message(cg_e_invalid_qualifier);
+                                    disposetree(p1);
+                                    p1:=genzeronode(errorn);
+                                 end;
+                        end;
+                     end;
                    else
                      begin
                         { is this a procedure variable ? }
@@ -1049,7 +1095,9 @@ unit pexpr;
                                      assigned(aktprocsym) and
                                      ((aktprocsym^.definition^.options and poclassmethod)<>0) then
                                      Message(parser_e_only_class_methods);
-                                   { !!!!! }
+                                   { no method pointer }
+                                   p1:=nil;
+                                   handle_propertysym(srsym,p1,pd);
                                 end;
                               errorsym:
                                 begin
@@ -1577,7 +1625,11 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.5  1998-04-08 10:26:09  florian
+  Revision 1.6  1998-04-09 22:16:35  florian
+    * problem with previous REGALLOC solved
+    * improved property support
+
+  Revision 1.5  1998/04/08 10:26:09  florian
     * correct error handling of virtual constructors
     * problem with new type declaration handling fixed
 

compiler/tgeni386.pas

@@ -204,11 +204,12 @@ unit tgeni386;
            begin
               if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then
                 exit;
-{$ifdef REGALLOC}
-              exprasmlist^.concat(new(pairegdealloc,init(r)));
-{$endif REGALLOC}
+              unused:=unused+[r];
               inc(usablereg32);
            end;
+{$ifdef REGALLOC}
+         exprasmlist^.concat(new(pairegdealloc,init(r)));
+{$endif REGALLOC}
       end;
 
 {$ifdef SUPPORT_MMX}
@@ -600,7 +601,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  1998-04-09 15:46:39  florian
+  Revision 1.3  1998-04-09 22:16:36  florian
+    * problem with previous REGALLOC solved
+    * improved property support
+
+  Revision 1.2  1998/04/09 15:46:39  florian
     + register allocation tracing stuff added
 
   Revision 1.1.1.1  1998/03/25 11:18:15  root