+ TEST_FUNCRET now default (old code removed)

    works also for m68k (at least compiles)

compiler/assemble.pas

@@ -390,7 +390,7 @@ begin
   case aktoutputformat of
 {$ifdef i386}
   {$ifndef NoAg386Att}
-        as_o : a:=new(pi386attasmlist,Init);
+        as_o,as_o_aout,as_asw : a:=new(pi386attasmlist,Init);
   {$endif NoAg386Att}
   {$ifndef NoAg386Nsm}
  as_nasmcoff,
@@ -437,7 +437,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.17  1998-08-17 09:17:43  peter
+  Revision 1.18  1998-08-21 14:08:39  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.17  1998/08/17 09:17:43  peter
     * static/shared linking updates
 
   Revision 1.16  1998/08/14 21:56:30  peter

compiler/cg386ld.pas

@@ -514,18 +514,11 @@ implementation
     procedure secondfuncret(var p : ptree);
       var
          hr : tregister;
-{$ifdef TEST_FUNCRET}
          hp : preference;
          pp : pprocinfo;
          hr_valid : boolean;
-{$endif TEST_FUNCRET}
       begin
          clear_reference(p^.location.reference);
-{$ifndef TEST_FUNCRET}
-         p^.location.reference.base:=procinfo.framepointer;
-         p^.location.reference.offset:=procinfo.retoffset;
-         if ret_in_param(procinfo.retdef) then
-{$else TEST_FUNCRET}
          hr_valid:=false;
          if @procinfo<>pprocinfo(p^.funcretprocinfo) then
            begin
@@ -549,11 +542,8 @@ implementation
            p^.location.reference.base:=procinfo.framepointer;
          p^.location.reference.offset:=procinfo.retoffset;
          if ret_in_param(p^.retdef) then
-{$endif TEST_FUNCRET}
            begin
-{$ifdef TEST_FUNCRET}
               if not hr_valid then
-{$endif TEST_FUNCRET}
                 hr:=getregister32;
               exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hr)));
               p^.location.reference.base:=hr;
@@ -565,7 +555,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  1998-08-20 09:26:37  pierre
+  Revision 1.10  1998-08-21 14:08:40  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.9  1998/08/20 09:26:37  pierre
     + funcret setting in underproc testing
       compile with _dTEST_FUNCRET
 

compiler/cga68k.pas

@@ -1182,7 +1182,7 @@ end;
 
            { the following check is appropriate, because all }
            { 4 registers are rarely used and it is thereby   }
-           { achieved that the extra code is being dropped   }
+                      { achieved that the extra code is being dropped   }
            { by exchanging not commutative operators         }
            and (p^.right^.registers32<=4) then
            begin
@@ -1195,19 +1195,41 @@ end;
       end;
 
     procedure secondfuncret(var p : ptree);
-
       var
-         hregister : tregister;
-
+         hr : tregister;
+         hp : preference;
+         pp : pprocinfo;
+         hr_valid : boolean;
       begin
          clear_reference(p^.location.reference);
-         p^.location.reference.base:=procinfo.framepointer;
+         hr_valid:=false;
+         if @procinfo<>pprocinfo(p^.funcretprocinfo) then
+           begin
+              hr:=getaddressreg;
+              hr_valid:=true;
+              hp:=new_reference(procinfo.framepointer,
+                procinfo.framepointer_offset);
+              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,hp,hr)));
+              pp:=procinfo.parent;
+              { walk up the stack frame }
+              while pp<>pprocinfo(p^.funcretprocinfo) do
+                begin
+                   hp:=new_reference(hr,
+                     pp^.framepointer_offset);
+                   exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,hp,hr)));
+                   pp:=pp^.parent;
+                end;
+              p^.location.reference.base:=hr;
+           end
+         else
+           p^.location.reference.base:=procinfo.framepointer;
          p^.location.reference.offset:=procinfo.retoffset;
-         if ret_in_param(procinfo.retdef) then
+         if ret_in_param(p^.retdef) then
            begin
-              hregister:=getaddressreg;
-              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,newreference(p^.location.reference),hregister)));
-              p^.location.reference.base:=hregister;
+              if not hr_valid then
+                hr:=getaddressreg;
+              exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,newreference(p^.location.reference),hr)));
+              p^.location.reference.base:=hr;
               p^.location.reference.offset:=0;
            end;
       end;
@@ -1215,7 +1237,11 @@ end;
   end.
 {
   $Log$
-  Revision 1.9  1998-08-17 10:10:04  peter
+  Revision 1.10  1998-08-21 14:08:41  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.9  1998/08/17 10:10:04  peter
     - removed OLDPPU
 
   Revision 1.8  1998/08/10 14:43:16  peter

compiler/hcodegen.pas

@@ -54,10 +54,8 @@ unit hcodegen;
           retdef : pdef;
           { return type }
           sym : pprocsym;
-{$ifdef TEST_FUNCRET }
           { symbol of the function }
           funcretsym : pfuncretsym;
-{$endif TEST_FUNCRET }
           { the definition of the proc itself }
           { why was this a pdef only ?? PM    }
           def : pprocdef;
@@ -409,7 +407,11 @@ end.
 
 {
   $Log$
-  Revision 1.13  1998-08-20 09:26:38  pierre
+  Revision 1.14  1998-08-21 14:08:43  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.13  1998/08/20 09:26:38  pierre
     + funcret setting in underproc testing
       compile with _dTEST_FUNCRET
 

compiler/m68k.pas

@@ -359,6 +359,8 @@ type
 
     function newreference(const r : treference) : preference;
 
+    function new_reference(base : tregister;offset : longint) : preference;
+    
     function reg2str(r : tregister) : string;
 
     { generates an help record for constants }
@@ -897,6 +899,18 @@ type
         end;
       end;
 
+      function new_reference(base : tregister;offset : longint) : preference;
+
+        var
+           r : preference;
+        begin
+           new(r);
+           reset_reference(r^);
+           r^.base:=base;
+           r^.offset:=offset;
+           new_reference:=r;
+        end;
+
     procedure clear_reference(var ref : treference);
 
       begin
@@ -1565,7 +1579,11 @@ type
 end.
 {
   $Log$
-  Revision 1.5  1998-06-04 23:51:45  peter
+  Revision 1.6  1998-08-21 14:08:44  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.5  1998/06/04 23:51:45  peter
     * m68k compiles
     + .def file creation moved to gendef.pas so it could also be used
       for win32

compiler/makefile

@@ -196,6 +196,7 @@ COMPILER=$(PP) $(PPOPTS)
 
 PPEXENAME=pp$(EXEEXT)
 EXENAME=ppc386$(EXEEXT)
+M68KEXENAME=ppc68k$(EXEEXT)
 TEMPNAME=ppc$(EXEEXT)
 TEMPNAME1=ppc1$(EXEEXT)
 TEMPNAME2=ppc2$(EXEEXT)
@@ -441,10 +442,20 @@ rtl :
 rtlclean :
 	make -C $(UNITDIR) clean
 
+# just a quick way to get ppc68k
+$(M68KEXENAME):
+	make clean
+	$(PP) -uI386 -uSUPPORT_MMX -dm68k -o$(M68KEXENAME) pp
+	make clean
+
 # Test of log at the end
 # does CVS add # at start of each line ??
 # $Log$
-# Revision 1.25  1998-08-18 09:24:41  pierre
+# Revision 1.26  1998-08-21 14:08:46  pierre
+#   + TEST_FUNCRET now default (old code removed)
+#     works also for m68k (at least compiles)
+#
+# Revision 1.25  1998/08/18 09:24:41  pierre
 #   * small warning position bug fixed
 #   * support_mmx switches splitting was missing
 #   * rhide error and warning output corrected

compiler/pass_1.pas

@@ -585,7 +585,6 @@ unit pass_1;
          p^.registersmmx:=0;
 {$endif SUPPORT_MMX}
          clear_reference(p^.location.reference);
-{$ifdef TEST_FUNCRET}
          if p^.symtableentry^.typ=funcretsym then
            begin
               putnode(p);
@@ -595,7 +594,6 @@ unit pass_1;
               firstpass(p);
               exit;
            end;
-{$endif TEST_FUNCRET}
          if p^.symtableentry^.typ=absolutesym then
            begin
               p^.resulttype:=pabsolutesym(p^.symtableentry)^.definition;
@@ -3619,7 +3617,6 @@ unit pass_1;
     procedure firstfuncret(var p : ptree);
 
       begin
-{$ifdef TEST_FUNCRET}
          p^.resulttype:=p^.retdef;
          p^.location.loc:=LOC_REFERENCE;
          if ret_in_param(p^.retdef) or
@@ -3632,17 +3629,6 @@ unit pass_1;
            Message(sym_w_function_result_not_set);
          if count_ref then
            pprocinfo(p^.funcretprocinfo)^.funcret_is_valid:=true;
-{$else TEST_FUNCRET}
-         p^.resulttype:=procinfo.retdef;
-         p^.location.loc:=LOC_REFERENCE;
-         if ret_in_param(procinfo.retdef) then
-           p^.registers32:=1;
-         if must_be_valid and
-           not(procinfo.funcret_is_valid) {and
-           ((procinfo.flags and pi_uses_asm)=0)} then
-           Message(sym_w_function_result_not_set);
-         if count_ref then procinfo.funcret_is_valid:=true;
-{$endif TEST_FUNCRET}
           end;
 
 
@@ -5248,7 +5234,11 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.60  1998-08-20 12:59:57  peter
+  Revision 1.61  1998-08-21 14:08:47  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.60  1998/08/20 12:59:57  peter
     - removed obsolete in_*
 
   Revision 1.59  1998/08/20 09:26:39  pierre

compiler/pexpr.pas

@@ -667,6 +667,53 @@ unit pexpr;
          propsym  : ppropertysym;
          filepos  : tfileposinfo;
 
+         {---------------------------------------------
+                         Is_func_ret
+         ---------------------------------------------}
+
+        function is_func_ret(sym : psym) : boolean;
+        var
+           p : pprocinfo;
+           storesymtablestack : psymtable;
+
+        begin
+          is_func_ret:=false;
+          if (sym^.typ<>funcretsym) and ((procinfo.flags and pi_operator)=0) then
+            exit;
+          p:=@procinfo;
+          while assigned(p) do
+            begin
+               { is this an access to a function result ? }
+               if assigned(p^.funcretsym) and
+                  ((sym=p^.funcretsym) or
+                  ((pvarsym(sym)=opsym) and
+                  ((p^.flags and pi_operator)<>0))) and
+                  (p^.retdef<>pdef(voiddef)) and
+                  (token<>LKLAMMER) and
+                  (not ((cs_tp_compatible in aktmoduleswitches) and
+                  (afterassignment or in_args))) then
+                 begin
+                    p1:=genzeronode(funcretn);
+                    pd:=p^.retdef;
+                    p1^.funcretprocinfo:=p;
+                    p1^.retdef:=pd;
+                    is_func_ret:=true;
+                    exit;
+                 end;
+               p:=p^.parent;
+            end;
+          { we must use the function call }
+          if(sym^.typ=funcretsym) then
+            begin
+               storesymtablestack:=symtablestack;
+               symtablestack:=srsymtable^.next;
+               getsym(sym^.name,true);
+               if srsym^.typ<>procsym then
+                 Message(cg_e_illegal_expression);
+               symtablestack:=storesymtablestack;
+            end;
+        end;
+
          {---------------------------------------------
                          Factor_read_id
          ---------------------------------------------}
@@ -683,10 +730,8 @@ unit pexpr;
               consume(ID);
               p1:=genzeronode(funcretn);
               pd:=procinfo.retdef;
-    {$ifdef TEST_FUNCRET}
               p1^.funcretprocinfo:=pointer(@procinfo);
               p1^.retdef:=pd;
-    {$endif TEST_FUNCRET}
             end
            else
             begin
@@ -699,24 +744,7 @@ unit pexpr;
               else
                getsym(pattern,true);
               consume(ID);
-    {$ifndef TEST_FUNCRET}
-              { is this an access to a function result ? }
-              if assigned(aktprocsym) and
-                 ((srsym^.name=aktprocsym^.name){ or
-                 ((pvarsym(srsym)=opsym) and
-                  ((procinfo.flags and pi_operator)<>0))}) and
-                 (procinfo.retdef<>pdef(voiddef)) and
-                 (token<>LKLAMMER) and
-                 (not ((cs_tp_compatible in aktmoduleswitches) and
-                 (afterassignment or in_args))) then
-               begin
-                 p1:=genzeronode(funcretn);
-                 pd:=procinfo.retdef;
-               end
-              else
-    {$else TEST_FUNCRET}
                if not is_func_ret(srsym) then
-    {$endif TEST_FUNCRET}
               { else it's a normal symbol }
                 begin
                 { is it defined like UNIT.SYMBOL ? }
@@ -1112,51 +1140,6 @@ unit pexpr;
         end;
 
 
-{$ifdef TEST_FUNCRET}
-        function is_func_ret(sym : psym) : boolean;
-        var
-           p : pprocinfo;
-           storesymtablestack : psymtable;
-
-        begin
-          is_func_ret:=false;
-          if (sym^.typ<>funcretsym) and ((procinfo.flags and pi_operator)=0) then
-            exit;
-          p:=@procinfo;
-          while assigned(p) do
-            begin
-               { is this an access to a function result ? }
-               if assigned(p^.funcretsym) and
-                  ((sym=p^.funcretsym) or
-                  ((pvarsym(sym)=opsym) and
-                  ((p^.flags and pi_operator)<>0))) and
-                  (p^.retdef<>pdef(voiddef)) and
-                  (token<>LKLAMMER) and
-                  (not ((cs_tp_compatible in aktmoduleswitches) and
-                  (afterassignment or in_args))) then
-                 begin
-                    p1:=genzeronode(funcretn);
-                    pd:=p^.retdef;
-                    p1^.funcretprocinfo:=p;
-                    p1^.retdef:=pd;
-                    is_func_ret:=true;
-                    exit;
-                 end;
-               p:=p^.parent;
-            end;
-          { we must use the function call }
-          if(sym^.typ=funcretsym) then
-            begin
-               storesymtablestack:=symtablestack;
-               symtablestack:=srsymtable^.next;
-               getsym(sym^.name,true);
-               if srsym^.typ<>procsym then
-                 Message(cg_e_illegal_expression);
-               symtablestack:=storesymtablestack;
-            end;
-        end;
-{$endif TEST_FUNCRET}
-
 
          {---------------------------------------------
                         PostFixOperators
@@ -1873,7 +1856,11 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.41  1998-08-20 21:36:39  peter
+  Revision 1.42  1998-08-21 14:08:50  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.41  1998/08/20 21:36:39  peter
     * fixed 'with object do' bug
 
   Revision 1.40  1998/08/20 09:26:41  pierre

compiler/pstatmnt.pas

@@ -1083,13 +1083,10 @@ unit pstatmnt;
 
     function block(islibrary : boolean) : ptree;
 
-{$ifdef TEST_FUNCRET }
       var
          funcretsym : pfuncretsym;
-{$endif TEST_FUNCRET }
 
       begin
-{$ifdef TEST_FUNCRET }
          if procinfo.retdef<>pdef(voiddef) then
            begin
               { if the current is a function aktprocsym is non nil }
@@ -1101,7 +1098,6 @@ unit pstatmnt;
                 procinfo.retoffset:=-funcretsym^.address;
               procinfo.funcretsym:=funcretsym;
            end;
-{$endif TEST_FUNCRET }
          read_declarations(islibrary);
 
          { temporary space is set, while the BEGIN of the procedure }
@@ -1126,15 +1122,8 @@ unit pstatmnt;
                    (psetdef(procinfo.retdef)^.settype=smallset)
                  ) then  }
                 begin
-{$ifdef TEST_FUNCRET }
                    { the space has been set in the local symtable }
                    procinfo.retoffset:=-funcretsym^.address;
-{$else  TEST_FUNCRET }
-                   { align func result at 4 byte }
-                   procinfo.retoffset:=
-                     -((-procinfo.firsttemp+(procinfo.retdef^.size+3)) div 4)*4;
-                   procinfo.firsttemp:=procinfo.retoffset;
-{$endif TEST_FUNCRET }
                    if (procinfo.flags and pi_operator)<>0 then
                      {opsym^.address:=procinfo.call_offset; is wrong PM }
                      opsym^.address:=-procinfo.retoffset;
@@ -1238,7 +1227,11 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.36  1998-08-20 21:36:41  peter
+  Revision 1.37  1998-08-21 14:08:52  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.36  1998/08/20 21:36:41  peter
     * fixed 'with object do' bug
 
   Revision 1.35  1998/08/20 09:26:42  pierre

compiler/symsym.inc

@@ -595,7 +595,6 @@
                                   TFUNCRETSYM
 ****************************************************************************}
 
-{$ifdef TEST_FUNCRET}
     constructor tfuncretsym.init(const n : string;approcinfo : pointer{pprocinfo});
 
       begin
@@ -615,7 +614,6 @@
       end;
 {$endif GDB}
 
-{$endif TEST_FUNCRET}
 
 {****************************************************************************
                                   TABSOLUTESYM
@@ -1554,7 +1552,11 @@
 
 {
   $Log$
-  Revision 1.33  1998-08-20 12:53:27  peter
+  Revision 1.34  1998-08-21 14:08:53  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.33  1998/08/20 12:53:27  peter
     * object_options are always written for object syms
 
   Revision 1.32  1998/08/20 09:26:46  pierre

compiler/tree.pas

@@ -211,9 +211,7 @@ unit tree;
              ordconstn : (value : longint);
              realconstn : (valued : bestreal;labnumber : longint;realtyp : tait);
              fixconstn : (valuef: longint);
-{$ifdef TEST_FUNCRET}
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
-{$endif TEST_FUNCRET}
              subscriptn : (vs : pvarsym);
              vecn : (memindex,memseg:boolean);
              { stringconstn : (length : longint; values : pstring;labstrnumber : longint); }
@@ -1385,9 +1383,7 @@ unit tree;
                end;
              (*realconstn : (valued : bestreal;labnumber : longint;realtyp : tait);
              fixconstn : (valuef: longint);
-{$ifdef TEST_FUNCRET}
              funcretn : (funcretprocinfo : pointer;retdef : pdef);
-{$endif TEST_FUNCRET}
              subscriptn : (vs : pvarsym);
              vecn : (memindex,memseg:boolean);
              { stringconstn : (length : longint; values : pstring;labstrnumber : longint); }
@@ -1557,7 +1553,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.30  1998-08-18 09:24:47  pierre
+  Revision 1.31  1998-08-21 14:08:58  pierre
+    + TEST_FUNCRET now default (old code removed)
+      works also for m68k (at least compiles)
+
+  Revision 1.30  1998/08/18 09:24:47  pierre
     * small warning position bug fixed
     * support_mmx switches splitting was missing
     * rhide error and warning output corrected