+ Merged patches from florian

compiler/cg386cal.pas

@@ -1078,7 +1078,7 @@ implementation
                    if (p^.resulttype^.needs_inittable) and
                      ( (p^.resulttype^.deftype<>objectdef) or
                        not(pobjectdef(p^.resulttype)^.isclass)) then
-                      finalize(p^.resulttype,p^.location.reference);
+                      finalize(p^.resulttype,p^.location.reference,ret_in_param(p^.resulttype));
                    { release unused temp }
                    ungetiftemp(p^.location.reference)
                 end
@@ -1166,7 +1166,28 @@ implementation
 end.
 {
   $Log$
-  Revision 1.90.2.3  1999-06-22 13:30:08  peter
+  Revision 1.90.2.4  1999-07-07 07:53:13  michael
+  + Merged patches from florian
+
+  Revision 1.94  1999/07/06 21:48:09  florian
+    * a lot bug fixes:
+       - po_external isn't any longer necessary for procedure compatibility
+       - m_tp_procvar is in -Sd now available
+       - error messages of procedure variables improved
+       - return values with init./finalization fixed
+       - data types with init./finalization aren't any longer allowed in variant
+         record
+
+  Revision 1.93  1999/06/22 13:31:24  peter
+    * merged
+
+  Revision 1.92  1999/06/16 09:32:45  peter
+    * merged
+
+  Revision 1.91  1999/06/14 17:47:47  peter
+    * merged
+
+  Revision 1.90.2.3  1999/06/22 13:30:08  peter
     * fixed return with packenum
 
   Revision 1.90.2.2  1999/06/16 09:30:44  peter

compiler/cgai386.pas

@@ -71,7 +71,7 @@ unit cgai386;
     procedure loadansistring(p : ptree);
     procedure loadshort2ansi(source,dest : ptree);
 
-    procedure finalize(t : pdef;const ref : treference);
+    procedure finalize(t : pdef;const ref : treference;is_already_ref : boolean);
     procedure decrstringref(t : pdef;const ref : treference);
 
 {$ifdef unused}
@@ -2237,7 +2237,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          end;
     end;
 
-    procedure initialize(t : pdef;const ref : treference);
+    { initilizes data of type t                           }
+    { if is_already_ref is true then the routines assumes }
+    { that r points to the data to initialize             }
+    procedure initialize(t : pdef;const ref : treference;is_already_ref : boolean);
 
       var
          hr : treference;
@@ -2254,13 +2257,20 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
               reset_reference(hr);
               hr.symbol:=t^.get_inittable_label;
               emitpushreferenceaddr(hr);
-              emitpushreferenceaddr(ref);
+              if is_already_ref then
+                exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,
+                  newreference(ref))))
+              else
+                emitpushreferenceaddr(ref);
               exprasmlist^.concat(new(pai386,
                 op_sym(A_CALL,S_NO,newasmsymbol('FPC_INITIALIZE'))));
            end;
       end;
 
-    procedure finalize(t : pdef;const ref : treference);
+    { finalizes data of type t                            }
+    { if is_already_ref is true then the routines assumes }
+    { that r points to the data to finalizes              }
+    procedure finalize(t : pdef;const ref : treference;is_already_ref : boolean);
 
       var
          r : treference;
@@ -2276,7 +2286,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
               reset_reference(r);
               r.symbol:=t^.get_inittable_label;
               emitpushreferenceaddr(r);
-              emitpushreferenceaddr(ref);
+              if is_already_ref then
+                exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,
+                  newreference(ref))))
+              else
+                emitpushreferenceaddr(ref);
               emitcall('FPC_FINALIZE');
            end;
       end;
@@ -2306,7 +2320,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
               begin
                  hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
               end;
-            initialize(pvarsym(p)^.definition,hr);
+            initialize(pvarsym(p)^.definition,hr,false);
          end;
     end;
 
@@ -2376,7 +2390,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                else
                  hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
             end;
-            finalize(pvarsym(p)^.definition,hr);
+            finalize(pvarsym(p)^.definition,hr,false);
          end;
     end;
 
@@ -2716,7 +2730,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
            reset_reference(r);
            r.offset:=procinfo.retoffset;
            r.base:=procinfo.framepointer;
-           initialize(procinfo.retdef,r);
+           initialize(procinfo.retdef,r,ret_in_param(procinfo.retdef));
         end;
 
       { generate copies of call by value parameters }
@@ -2922,7 +2936,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                 reset_reference(hr);
                 hr.offset:=procinfo.retoffset;
                 hr.base:=procinfo.framepointer;
-                finalize(procinfo.retdef,hr);
+                finalize(procinfo.retdef,hr,ret_in_param(procinfo.retdef));
              end;
 
            exprasmlist^.concat(new(pai386,
@@ -3064,48 +3078,15 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
             else
               internalerror(20080);
          end;
-
 {$endif test_dest_loc}
-{
-    procedure removetemps(list : paasmoutput;p : plinkedlist);
-
-      var
-         hp : ptemptodestroy;
-         pushedregs : tpushed;
-
-      begin
-         hp:=ptemptodestroy(p^.first);
-         if not(assigned(hp)) then
-           exit;
-         pushusedregisters(pushedregs,$ff);
-         while assigned(hp) do
-           begin
-              if is_ansistring(hp^.typ) then
-                begin
-                   emitpushreferenceaddr(list,hp^.address);
-                   exprasmlist^.concat(new(pai386,
-                     op_sym(A_CALL,S_NO,newasmsymbol('FPC_ANSISTR_DECR_REF'))));
-                   if not (cs_compilesystem in aktmoduleswitches) then
-                     concat_external('FPC_ANSISTR_DECR_REF',EXT_NEAR);
-                   ungetiftempansi(hp^.address);
-                end
-              else
-                ungetiftemp(hp^.address);
-              hp:=ptemptodestroy(hp^.next);
-           end;
-         popusedregisters(pushedregs);
-     end;
 
-    procedure addtemptodestroy(t : pdef;const addr : treference);
-
-      begin
-         temptoremove^.concat(new(ptemptodestroy,init(addr,t)));
-      end;
-}
 end.
 {
   $Log$
-  Revision 1.5.2.5  1999-07-05 20:03:31  peter
+  Revision 1.5.2.6  1999-07-07 07:53:16  michael
+  + Merged patches from florian
+
+  Revision 1.5.2.5  1999/07/05 20:03:31  peter
     * removed warning/notes
 
   Revision 1.5.2.4  1999/07/04 23:55:52  jonas

compiler/globals.pas

@@ -60,7 +60,7 @@ unit globals;
 
        delphimodeswitches : tmodeswitches=
          [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
-          m_pointer_2_procedure,m_autoderef];
+          m_pointer_2_procedure,m_autoderef,m_tp_procvar];
        fpcmodeswitches    : tmodeswitches=
          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
           m_cvar_support];
@@ -1162,7 +1162,23 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  1999-05-27 19:44:29  peter
+  Revision 1.8.2.1  1999-07-07 07:53:21  michael
+  + Merged patches from florian
+
+  Revision 1.10  1999/07/06 21:48:16  florian
+    * a lot bug fixes:
+       - po_external isn't any longer necessary for procedure compatibility
+       - m_tp_procvar is in -Sd now available
+       - error messages of procedure variables improved
+       - return values with init./finalization fixed
+       - data types with init./finalization aren't any longer allowed in variant
+         record
+
+  Revision 1.9  1999/07/03 00:29:48  peter
+    * new link writing to the ppu, one .ppu is needed for all link types,
+      static (.o) is now always created also when smartlinking is used
+
+  Revision 1.8  1999/05/27 19:44:29  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

compiler/pdecl.pas

@@ -234,6 +234,9 @@ unit pdecl;
          consume(SEMICOLON);
       end;
 
+    const
+       variantrecordlevel : longint = 0;
+
 
     procedure read_var_decs(is_record,is_object,is_threadvar:boolean);
     { reads the filed of a record into a        }
@@ -298,6 +301,8 @@ unit pdecl;
                but should be OK for all modes !! (PM) }
              ignore_equal:=true;
              p:=read_type('');
+             if (variantrecordlevel>0) and p^.needs_inittable then
+               Message(parser_e_cant_use_inittable_here);
              ignore_equal:=false;
              symdone:=false;
              if is_gpc_name then
@@ -560,8 +565,10 @@ unit pdecl;
                 consume(COLON);
                 { read the vars }
                 consume(LKLAMMER);
+                inc(variantrecordlevel);
                 if token<>RKLAMMER then
                   read_var_decs(true,false,false);
+                dec(variantrecordlevel);
                 consume(RKLAMMER);
                 { calculates maximal variant size }
                 maxsize:=max(maxsize,symtablestack^.datasize);
@@ -2114,7 +2121,29 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.127.2.2  1999-07-05 20:03:27  peter
+  Revision 1.127.2.3  1999-07-07 07:53:22  michael
+  + Merged patches from florian
+
+  Revision 1.131  1999/07/06 21:48:23  florian
+    * a lot bug fixes:
+       - po_external isn't any longer necessary for procedure compatibility
+       - m_tp_procvar is in -Sd now available
+       - error messages of procedure variables improved
+       - return values with init./finalization fixed
+       - data types with init./finalization aren't any longer allowed in variant
+         record
+
+  Revision 1.130  1999/07/05 20:25:39  peter
+    * merged
+
+  Revision 1.129  1999/07/02 13:02:26  peter
+    * merged
+
+  Revision 1.128  1999/06/30 22:16:19  florian
+    * use of is_ordinal checked: often a qword/int64 isn't allowed (case/for ...)
+    * small qword problems fixed
+
+  Revision 1.127.2.2  1999/07/05 20:03:27  peter
     * removed warning/notes
 
   Revision 1.127.2.1  1999/07/02 12:59:49  peter

compiler/pexpr.pas

@@ -125,7 +125,7 @@ unit pexpr;
                Must_be_valid:=false;
                firstpass(p);
                Must_be_valid:=Store_valid;
-               if p^.resulttype^.deftype=procvardef then
+               if not(getprocvar) and (p^.resulttype^.deftype=procvardef) then
                  begin
                     p1:=gencallnode(nil,nil);
                     p1^.right:=p;
@@ -2044,7 +2044,29 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.112.2.6  1999-07-01 21:31:59  peter
+  Revision 1.112.2.7  1999-07-07 07:53:10  michael
+  + Merged patches from florian
+
+  Revision 1.120  1999/07/06 22:38:11  florian
+    * another fix for TP/Delphi styled procedure variables
+
+  Revision 1.119  1999/07/05 20:13:16  peter
+    * removed temp defines
+
+  Revision 1.118  1999/07/01 21:33:57  peter
+    * merged
+
+  Revision 1.117  1999/06/30 15:43:20  florian
+    * two bugs regarding method variables fixed
+      - if you take in a method the address of another method
+        don't need self anymore
+      - if the class pointer was in a register, wrong code for a method
+        variable load was generated
+
+  Revision 1.116  1999/06/26 00:24:53  pierre
+   * mereg from fixes-0_99_12 branch
+
+  Revision 1.112.2.6  1999/07/01 21:31:59  peter
     * procvar fixes again
 
   Revision 1.112.2.5  1999/07/01 15:17:17  peter

compiler/symconst.inc

@@ -76,7 +76,7 @@
        { relevant options for assigning a proc or a procvar to a procvar }
        po_compatibility_options = $7FFFFFFF-
          (poassembler+pomsgstr+pomsgint+
-          povirtualmethod+pooverridingmethod);
+          povirtualmethod+pooverridingmethod+poexternal);
 
        { options for objects and classes }
        oo_is_abstract  = $1;         { true, if the object/class has an abstract }
@@ -111,7 +111,19 @@
 
 {
   $Log$
-  Revision 1.11  1999-06-03 09:34:11  peter
+  Revision 1.11.2.1  1999-07-07 07:53:25  michael
+  + Merged patches from florian
+
+  Revision 1.12  1999/07/06 21:48:26  florian
+    * a lot bug fixes:
+       - po_external isn't any longer necessary for procedure compatibility
+       - m_tp_procvar is in -Sd now available
+       - error messages of procedure variables improved
+       - return values with init./finalization fixed
+       - data types with init./finalization aren't any longer allowed in variant
+         record
+
+  Revision 1.11  1999/06/03 09:34:11  peter
     * better methodpointer check for proc->procvar
 
   Revision 1.10  1999/06/01 19:27:56  peter

compiler/types.pas

@@ -249,8 +249,12 @@ implementation
         ismethod : boolean;
       begin
          proc_to_procvar_equal:=false;
+         if not(assigned(def1)) or not(assigned(def2)) then
+           exit;
          { check for method pointer }
-         ismethod:=(def1^.owner^.symtabletype=objectsymtable) and
+         ismethod:=assigned(def1^.owner) and
+                   (def1^.owner^.symtabletype=objectsymtable) and
+                   assigned(def1^.owner^.defowner) and
                    (pobjectdef(def1^.owner^.defowner)^.isclass);
          if (ismethod and not ((def2^.options and pomethodpointer)<>0)) or
             (not(ismethod) and ((def2^.options and pomethodpointer)<>0)) then
@@ -930,7 +934,31 @@ implementation
 end.
 {
   $Log$
-  Revision 1.71.2.1  1999-06-13 22:37:17  peter
+  Revision 1.71.2.2  1999-07-07 07:53:26  michael
+  + Merged patches from florian
+
+  Revision 1.75  1999/07/06 21:48:29  florian
+    * a lot bug fixes:
+       - po_external isn't any longer necessary for procedure compatibility
+       - m_tp_procvar is in -Sd now available
+       - error messages of procedure variables improved
+       - return values with init./finalization fixed
+       - data types with init./finalization aren't any longer allowed in variant
+         record
+
+  Revision 1.74  1999/07/01 15:49:24  florian
+    * int64/qword type release
+    + lo/hi for int64/qword
+
+  Revision 1.73  1999/06/28 22:29:22  florian
+    * qword division fixed
+    + code for qword/int64 type casting added:
+      range checking isn't implemented yet
+
+  Revision 1.72  1999/06/13 22:41:08  peter
+    * merged from fixes
+
+  Revision 1.71.2.1  1999/06/13 22:37:17  peter
     * convertable para's doesn't check for equal, added equal para's to
       proc2procvar check