* bugs 593 and 607 fixed

  * some other potential bugs with array constructors fixed
  * for classes compiled in $M+ and it's childs, the default access method
    is now published
  * fixed copyright message (it is now 1993-99)

compiler/cg386ld.pas

@@ -936,8 +936,9 @@ implementation
                   begin
                     if vaddr then
                      begin
-                       emit_to_reference(hp^.left);
+                       emit_to_mem(hp^.left);
                        emit_push_lea_loc(hp^.left^.location,freetemp);
+                       del_reference(hp^.left^.location.reference);
                      end
                     else
                      emit_push_loc(hp^.left^.location);
@@ -951,7 +952,7 @@ implementation
                     { write changing field update href to the next element }
                     if vaddr then
                      begin
-                       emit_to_reference(hp^.left);
+                       emit_to_mem(hp^.left);
                        emit_lea_loc_ref(hp^.left^.location,href,freetemp);
                      end
                     else
@@ -984,7 +985,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.84  1999-09-11 09:08:31  florian
+  Revision 1.85  1999-09-12 08:48:03  florian
+    * bugs 593 and 607 fixed
+    * some other potential bugs with array constructors fixed
+    * for classes compiled in $M+ and it's childs, the default access method
+      is now published
+    * fixed copyright message (it is now 1993-99)
+
+  Revision 1.84  1999/09/11 09:08:31  florian
     * fixed bug 596
     * fixed some problems with procedure variables and procedures of object,
       especially in TP mode. Procedure of object doesn't apply only to classes,

compiler/cgai386.pas

@@ -81,7 +81,7 @@ unit cgai386;
 
     procedure emit_pushw_loc(const t:tlocation);
     procedure emit_push_lea_loc(const t:tlocation;freetemp:boolean);
-    procedure emit_to_reference(var p:ptree);
+    procedure emit_to_mem(var p:ptree);
     procedure emit_to_reg16(var hr:tregister);
     procedure emit_to_reg32(var hr:tregister);
     procedure emit_mov_reg_loc(reg: TRegister; const t:tlocation);
@@ -411,7 +411,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
     procedure emit_mov_loc_ref(const t:tlocation;const ref:treference;siz:topsize);
       var
         hreg : tregister;
+        pushedeax : boolean;
+
       begin
+        pushedeax:=false;
         case t.loc of
           LOC_REGISTER,
          LOC_CREGISTER : begin
@@ -427,16 +430,33 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                            else
                              begin
                                case siz of
-                                 S_B : hreg:=reg32toreg8(getregister32);
-                                 S_W : hreg:=reg32toreg16(getregister32);
+                                 S_B : begin
+                                          { we can't do a getregister in the code generator }
+                                          { without problems!!!                             }
+                                          if usablereg32>0 then
+                                            hreg:=reg32toreg8(getregister32)
+                                          else
+                                            begin
+                                               emit_reg(A_PUSH,S_L,R_EAX);
+                                               pushedeax:=true;
+                                               hreg:=R_AL;
+                                            end;
+                                       end;
+                                 S_W : hreg:=R_DI;
                                  S_L : hreg:=R_EDI;
                                end;
                                emit_ref_reg(A_MOV,siz,
                                  newreference(t.reference),hreg);
+                               del_reference(t.reference);
                                exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,siz,
                                  hreg,newreference(ref))));
-                               if siz<>S_L then
-                                ungetregister(hreg);
+                               if siz=S_B then
+                                 begin
+                                    if pushedeax then
+                                      emit_reg(A_POP,S_L,R_EAX)
+                                    else
+                                      ungetregister(hreg);
+                                 end;
                                { we can release the registers }
                                { but only AFTER the MOV! Important for the optimizer!
                                  (JM)}
@@ -714,7 +734,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
       end;
 
 
-    procedure emit_to_reference(var p:ptree);
+    procedure emit_to_mem(var p:ptree);
       begin
         case p^.location.loc of
                LOC_FPU : begin
@@ -723,7 +743,6 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                            floatstore(pfloatdef(p^.resulttype)^.typ,p^.location.reference);
                            {  This can't be never a l-value! (FK)
                               p^.location.loc:=LOC_REFERENCE; }
-                           p^.location.loc:=LOC_MEM;
                          end;
                LOC_MEM,
          LOC_REFERENCE : ;
@@ -735,10 +754,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                            floatstore(pfloatdef(p^.resulttype)^.typ,p^.location.reference);
                            {  This can't be never a l-value! (FK)
                               p^.location.loc:=LOC_REFERENCE; }
-                           p^.location.loc:=LOC_MEM;
                          end;
          else
          internalerror(333);
+         p^.location.loc:=LOC_MEM;
         end;
       end;
 
@@ -3331,7 +3350,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.40  1999-09-11 11:23:58  florian
+  Revision 1.41  1999-09-12 08:48:04  florian
+    * bugs 593 and 607 fixed
+    * some other potential bugs with array constructors fixed
+    * for classes compiled in $M+ and it's childs, the default access method
+      is now published
+    * fixed copyright message (it is now 1993-99)
+
+  Revision 1.40  1999/09/11 11:23:58  florian
     * bug 603 fixed
 
   Revision 1.39  1999/09/10 15:42:51  peter

compiler/errore.msg

@@ -1467,7 +1467,7 @@ option_switch_bin_to_src_assembler=N_Switching assembler to default source writi
 # Logo (option -l)
 #
 option_logo_start=Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET
-option_logo_end=Copyright (c) 1993-98 by Florian Klaempfl
+option_logo_end=Copyright (c) 1993-99 by Florian Klaempfl
 
 #
 # Info (option -i)

compiler/errores.msg

@@ -1407,7 +1407,7 @@ option_switch_bin_to_src_assembler=N_Cambi
 # Logo (option -l)
 #
 option_logo_start=Free Pascal Compiler versi¢n $FPCVER [$FPCDATE] para $FPCTARGET
-option_logo_end=Copyright (c) 1993-98 por Florian Klaempfl
+option_logo_end=Copyright (c) 1993-99 por Florian Klaempfl
 
 #
 # Info (option -i)

compiler/errorr.msg

@@ -732,7 +732,7 @@ option_switch_bin_to_src_assembler=N_Switching assembler to default source writi
 # ‹®£® (®¯æ¨ï -l)
 #
 option_logo_start=Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET [Russian]
-option_logo_end=Copyright (c) 1993-98 by Florian Klaempfl
+option_logo_end=Copyright (c) 1993-99 by Florian Klaempfl
 
 #
 # ˆ­ä®p¬ æ¨ï (®¯æ¨ï -i)
@@ -898,7 +898,14 @@ ol_end=**1h_
 
 #
 # $Log$
-# Revision 1.6  1999-07-07 22:36:22  michael
+# Revision 1.7  1999-09-12 08:48:05  florian
+#   * bugs 593 and 607 fixed
+#   * some other potential bugs with array constructors fixed
+#   * for classes compiled in $M+ and it's childs, the default access method
+#     is now published
+#   * fixed copyright message (it is now 1993-99)
+#
+# Revision 1.6  1999/07/07 22:36:22  michael
 # + Added last message
 #
 # Revision 1.5  1999/07/05 20:25:31  peter

compiler/msgtxt.inc

@@ -509,7 +509,7 @@ const msgtxt : array[0..000101,1..240] of char=(
   'E_You are using the obsolete switch $1, please use $2'#000+
   'N_Switching assembler to default source writing assembler'#000+
   'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
-  'Copyright (c) 1993-98 by Florian Klae','mpfl'#000+
+  'Copyright (c) 1993-99 by Florian Klae','mpfl'#000+
   'Free Pascal Compiler version $FPCVER'#000+
   #000+
   'Compiler Date  : $FPCDATE'#000+

compiler/pdecl.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 1993-98 by Florian Klaempfl
+    Copyright (c) 1993-99 by Florian Klaempfl
 
     Does declaration parsing for Free Pascal
 
@@ -1556,6 +1556,9 @@ unit pdecl;
          else
            aktclass:=new(pobjectdef,init(n,nil));
 
+         { default access is public }
+         actmembertype:=[sp_public];
+
          { set the class attribute }
          if is_a_class then
            begin
@@ -1567,17 +1570,16 @@ unit pdecl;
               if (cs_generate_rtti in aktlocalswitches) or
                   (assigned(aktclass^.childof) and
                    (oo_can_have_published in aktclass^.childof^.objectoptions)) then
-{$ifdef INCLUDEOK}
-                include(aktclass^.objectoptions,oo_can_have_published);
-{$else}
-                aktclass^.objectoptions:=aktclass^.objectoptions+[oo_can_have_published];
-{$endif}
+                begin
+                   include(aktclass^.objectoptions,oo_can_have_published);
+                   { in "publishable" classes the default access type is published }
+                   actmembertype:=[sp_published];
+                   { don't know if this is necessary (FK) }
+                   current_object_option:=[sp_published];
+                end;
            end;
 
          aktobjectdef:=aktclass;
-
-         { default access is public }
-         actmembertype:=[sp_public];
          aktclass^.symtable^.next:=symtablestack;
          symtablestack:=aktclass^.symtable;
          procinfo._class:=aktclass;
@@ -2525,7 +2527,14 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.150  1999-09-10 20:57:33  florian
+  Revision 1.151  1999-09-12 08:48:09  florian
+    * bugs 593 and 607 fixed
+    * some other potential bugs with array constructors fixed
+    * for classes compiled in $M+ and it's childs, the default access method
+      is now published
+    * fixed copyright message (it is now 1993-99)
+
+  Revision 1.150  1999/09/10 20:57:33  florian
     * some more fixes for stored properties
 
   Revision 1.149  1999/09/10 18:48:07  florian

compiler/symdef.inc

@@ -3583,7 +3583,6 @@ Const local_symtable_index : longint = $8001;
         end;
 
       begin
-
          if (psym(sym)^.typ=propertysym) and
             (ppo_indexed in ppropertysym(sym)^.propoptions) then
            proctypesinfo:=$40
@@ -3747,7 +3746,14 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.161  1999-09-10 18:48:09  florian
+  Revision 1.162  1999-09-12 08:48:09  florian
+    * bugs 593 and 607 fixed
+    * some other potential bugs with array constructors fixed
+    * for classes compiled in $M+ and it's childs, the default access method
+      is now published
+    * fixed copyright message (it is now 1993-99)
+
+  Revision 1.161  1999/09/10 18:48:09  florian
     * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
     * most things for stored properties fixed
 

compiler/symtable.pas

@@ -1534,12 +1534,13 @@ implementation
            end;
          { check for duplicate id in para symtable of methods }
          if (symtabletype=parasymtable) and
-           assigned(next) and
+           assigned(procinfo._class) and
+         { but not in nested procedures !}
+            (not(assigned(procinfo.parent^._class))) and 
           { funcretsym is allowed !! }
-           (sym^.typ <> funcretsym) and
-           (next^.symtabletype=objectsymtable) then
+           (sym^.typ <> funcretsym) then
            begin
-              hsym:=search_class_member(pobjectdef(next^.defowner),sym^.name);
+              hsym:=search_class_member(procinfo._class,sym^.name);
               { but private ids can be reused }
               if assigned(hsym) and
                 (not(sp_private in hsym^.symoptions) or
@@ -2406,7 +2407,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.46  1999-09-10 18:48:10  florian
+  Revision 1.47  1999-09-12 08:48:09  florian
+    * bugs 593 and 607 fixed
+    * some other potential bugs with array constructors fixed
+    * for classes compiled in $M+ and it's childs, the default access method
+      is now published
+    * fixed copyright message (it is now 1993-99)
+
+  Revision 1.46  1999/09/10 18:48:10  florian
     * some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
     * most things for stored properties fixed