* implicit result variable generation for assembler routines

 * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead

compiler/globals.pas

@@ -56,9 +56,9 @@ interface
 {$endif Splitheap}
 
        delphimodeswitches : tmodeswitches=
-         [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
+         [m_delphi,m_all,m_class,m_objpas,m_result,m_string_pchar,
           m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
-          m_out,m_default_para,m_hintdirective];
+          m_out,m_default_para,m_hintdirective,m_duplicate_names];
        fpcmodeswitches    : tmodeswitches=
          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
           m_cvar_support,m_initfinal,m_add_pointer];
@@ -66,7 +66,7 @@ interface
          [m_objfpc,m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
           m_repeat_forward,m_cvar_support,m_initfinal,m_add_pointer,m_out,m_default_para];
        tpmodeswitches     : tmodeswitches=
-         [m_tp7,m_tp,m_all,m_tp_procvar];
+         [m_tp7,m_all,m_tp_procvar,m_duplicate_names];
        gpcmodeswitches    : tmodeswitches=
          [m_gpc,m_all];
 
@@ -1453,7 +1453,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.50  2001-12-06 17:57:33  florian
+  Revision 1.51  2002-01-24 18:25:48  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.50  2001/12/06 17:57:33  florian
     + parasym to tparaitem added
 
   Revision 1.49  2001/10/25 21:22:32  peter

compiler/globtype.pas

@@ -125,7 +125,7 @@ interface
        { Switches which can be changed by a mode (fpc,tp7,delphi) }
        tmodeswitch = (m_none,m_all, { needed for keyword }
          { generic }
-         m_fpc,m_objfpc,m_delphi,m_tp,m_tp7,m_gpc,
+         m_fpc,m_objfpc,m_delphi,m_tp7,m_gpc,
          { more specific }
          m_class,               { delphi class model }
          m_objpas,              { load objpas unit }
@@ -143,7 +143,8 @@ interface
          m_default_ansistring,  { ansistring turned on by default }
          m_out,                 { support the calling convention OUT }
          m_default_para,        { support default parameters }
-         m_hintdirective        { support hint directives }
+         m_hintdirective,       { support hint directives }
+         m_duplicate_names      { allow locals/paras to have duplicate names of globals }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -245,7 +246,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  2001-10-25 21:22:32  peter
+  Revision 1.20  2002-01-24 18:25:48  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.19  2001/10/25 21:22:32  peter
     * calling convention rewrite
 
   Revision 1.18  2001/10/24 11:46:06  marco

compiler/i386/cga.pas

@@ -2677,50 +2677,55 @@ implementation
          emitcall('FPC_DO_EXIT');
        end;
 
-      { handle return value }
+      { handle return value, this is not done for assembler routines when
+        they didn't reference the result variable }
       uses_eax:=false;
       uses_edx:=false;
       uses_esi:=false;
-      if not(po_assembler in aktprocdef.procoptions) then
+      if not(po_assembler in aktprocdef.procoptions) or
+         (assigned(aktprocdef.funcretsym) and
+          (tfuncretsym(aktprocdef.funcretsym).refcount>1)) then
+        begin
           if (aktprocdef.proctypeoption<>potype_constructor) then
             handle_return_value(inlined,uses_eax,uses_edx)
           else
-              begin
-                  { successful constructor deletes the zero flag }
-                  { and returns self in eax                   }
-                  { eax must be set to zero if the allocation failed !!! }
-                  getlabel(okexitlabel);
-                  emitjmp(C_NONE,okexitlabel);
-                  emitlab(faillabel);
-                  if is_class(procinfo^._class) then
-                    begin
-                      emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI);
-                      emitcall('FPC_HELP_FAIL_CLASS');
-                    end
-                  else if is_object(procinfo^._class) then
-                    begin
-                      emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
-                       getexplicitregister32(R_EDI);
-                      emit_const_reg(A_MOV,S_L,procinfo^._class.vmt_offset,R_EDI);
-                      emitcall('FPC_HELP_FAIL');
-                      ungetregister32(R_EDI);
-                    end
-                  else
-                    Internalerror(200006161);
+            begin
+              { successful constructor deletes the zero flag }
+              { and returns self in eax                   }
+              { eax must be set to zero if the allocation failed !!! }
+              getlabel(okexitlabel);
+              emitjmp(C_NONE,okexitlabel);
+              emitlab(faillabel);
+              if is_class(procinfo^._class) then
+                begin
+                  emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,8),R_ESI);
+                  emitcall('FPC_HELP_FAIL_CLASS');
+                end
+              else if is_object(procinfo^._class) then
+                begin
+                  emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
+                  getexplicitregister32(R_EDI);
+                  emit_const_reg(A_MOV,S_L,procinfo^._class.vmt_offset,R_EDI);
+                  emitcall('FPC_HELP_FAIL');
+                  ungetregister32(R_EDI);
+                end
+              else
+                Internalerror(200006161);
 
-                  emitlab(okexitlabel);
+              emitlab(okexitlabel);
 
-                  { for classes this is done after the call to }
-                  { AfterConstruction                          }
-                  if is_object(procinfo^._class) then
-                    begin
-                       exprasmList.concat(Tairegalloc.Alloc(R_EAX));
-                       emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
-                       uses_eax:=true;
-                    end;
-                  emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI);
-                  uses_esi:=true;
-              end;
+              { for classes this is done after the call to }
+              { AfterConstruction                          }
+              if is_object(procinfo^._class) then
+                begin
+                  exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+                  emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
+                  uses_eax:=true;
+                end;
+              emit_reg_reg(A_TEST,S_L,R_ESI,R_ESI);
+              uses_esi:=true;
+            end;
+        end;
 
       if aktexit2label.is_used and not aktexit2label.is_set then
         emitlab(aktexit2label);
@@ -2982,7 +2987,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  2002-01-19 14:21:17  peter
+  Revision 1.15  2002-01-24 18:25:53  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.14  2002/01/19 14:21:17  peter
     * fixed init/final for value parameters
 
   Revision 1.13  2001/12/30 17:24:45  jonas

compiler/i386/ra386.pas

@@ -39,7 +39,6 @@ Procedure FWaitWarning;
 type
   T386Operand=class(TOperand)
     Procedure SetCorrectSize(opcode:tasmop);override;
-    Function SetupResult : boolean;override;
   end;
 
   T386Instruction=class(TInstruction)
@@ -185,57 +184,6 @@ begin
     end;
 end;
 
-Function T386Operand.SetupResult:boolean;
-var
-  Res : boolean;
-Begin
-  Res:=inherited setupResult;
-  { replace by ref by register if not place was
-    reserved on stack }
-  if res and (procinfo^.return_offset=0) then
-   begin
-     opr.typ:=OPR_REGISTER;
-     if is_fpu(aktprocdef.rettype.def) then
-       begin
-         opr.reg:=R_ST0;
-         case tfloatdef(aktprocdef.rettype.def).typ of
-           s32real : size:=S_FS;
-           s64real : size:=S_FL;
-           s80real : size:=S_FX;
-           s64comp : size:=S_IQ;
-         else
-           begin
-             Message(asmr_e_cannot_use_RESULT_here);
-             res:=false;
-           end;
-         end;
-       end
-     else if ret_in_acc(aktprocdef.rettype.def) then
-       case aktprocdef.rettype.def.size of
-       1 : begin
-             opr.reg:=R_AL;
-             size:=S_B;
-           end;
-       2 : begin
-             opr.reg:=R_AX;
-             size:=S_W;
-           end;
-       3,4 : begin
-               opr.reg:=R_EAX;
-               size:=S_L;
-             end;
-       else
-         begin
-           Message(asmr_e_cannot_use_RESULT_here);
-           res:=false;
-         end;
-       end;
-     Message1(asmr_h_RESULT_is_reg,reg2str(opr.reg));
-   end;
-  SetupResult:=res;
-end;
-
-
 
 {*****************************************************************************
                               T386Instruction
@@ -683,7 +631,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.13  2001-11-02 22:58:11  peter
+  Revision 1.14  2002-01-24 18:25:53  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.13  2001/11/02 22:58:11  peter
     * procsym definition rewrite
 
   Revision 1.12  2001/08/26 13:37:01  florian

compiler/i386/ra386att.pas

@@ -1892,10 +1892,6 @@ Var
 Begin
   Message1(asmr_d_start_reading,'AT&T');
   firsttoken:=TRUE;
-  if assigned(aktprocdef.funcretsym) and
-     (is_fpu(aktprocdef.rettype.def) or
-     ret_in_acc(aktprocdef.rettype.def)) then
-    tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
   { sets up all opcode and register tables in uppercase }
   if not _asmsorted then
    Begin
@@ -2139,7 +2135,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.15  2001-11-02 22:58:11  peter
+  Revision 1.16  2002-01-24 18:25:53  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.15  2001/11/02 22:58:11  peter
     * procsym definition rewrite
 
   Revision 1.14  2001/08/26 13:37:02  florian

compiler/i386/ra386int.pas

@@ -1847,10 +1847,6 @@ Begin
   Message1(asmr_d_start_reading,'intel');
   inexpression:=FALSE;
   firsttoken:=TRUE;
-  if assigned(aktprocdef.funcretsym) and
-     (is_fpu(aktprocdef.rettype.def) or
-     ret_in_acc(aktprocdef.rettype.def)) then
-    tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
  { sets up all opcode and register tables in uppercase }
   if not _asmsorted then
    Begin
@@ -1968,7 +1964,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.19  2001-11-02 22:58:11  peter
+  Revision 1.20  2002-01-24 18:25:53  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.19  2001/11/02 22:58:11  peter
     * procsym definition rewrite
 
   Revision 1.18  2001/09/17 21:29:14  peter

compiler/ncal.pas

@@ -780,8 +780,11 @@ implementation
 
       var
         i : longint;
+        found,
         is_const : boolean;
         bestord  : torddef;
+        srprocsym  : tprocsym;
+        srsymtable : tsymtable;
       begin
          result:=nil;
 
@@ -878,36 +881,73 @@ implementation
                         pd:=pd^.next;
                      end;
 
-{$ifdef CROSSUNIT}
                    { when the definition has overload directive set, we search for
-                     overloaded definitions in the other used units unitsymtable. The found
-                     entries are only added to the procs list and not the procsym }
+                     overloaded definitions in the symtablestack. The found
+                     entries are only added to the procs list and not the procsym, because
+                     the list can change in every situation }
                    if (po_overload in symtableprocentry.defs^.def.procoptions) and
                       (symtableprocentry.owner.symtabletype<>objectsymtable) then
                      begin
-
-
-                 srpdl:=srsym.defs;
-                 while assigned(srpdl) do
-                  begin
-                    found:=false;
-                    pdl:=aprocsym.defs;
-                    while assigned(pdl) do
-                     begin
-                       if equal_paras(pdl^.def.para,srpdl^.def.para,cp_value_equal_const) then
+                       srsymtable:=symtableprocentry.owner.next;
+                       while assigned(srsymtable) do
                         begin
-                          found:=true;
-                          break;
+                          if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
+                           begin
+                             srprocsym:=tprocsym(srsymtable.speedsearch(symtableprocentry.name,symtableprocentry.speedvalue));
+                             { process only visible procsyms }
+                             if assigned(srprocsym) and
+                                (srprocsym.typ=procsym) and
+                                srprocsym.is_visible_for_proc(aktprocdef) then
+                              begin
+                                { if this procedure doesn't have overload we can stop
+                                  searching }
+                                if not(po_overload in srprocsym.defs^.def.procoptions) then
+                                 break;
+                                { process all overloaded definitions }
+                                pd:=srprocsym.defs;
+                                while assigned(pd) do
+                                 begin
+                                   { only when the # of parameter are supported by the
+                                     procedure }
+                                   if (paralength>=pd^.def.minparacount) and
+                                      ((po_varargs in pd^.def.procoptions) or { varargs }
+                                      (paralength<=pd^.def.maxparacount)) then
+                                    begin
+                                      found:=false;
+                                      hp:=procs;
+                                      while assigned(hp) do
+                                       begin
+                                         if equal_paras(hp^.data.para,pd^.def.para,cp_value_equal_const) then
+                                          begin
+                                            found:=true;
+                                            break;
+                                          end;
+                                         hp:=hp^.next;
+                                       end;
+                                      if not found then
+                                       begin
+                                         new(hp);
+                                         hp^.data:=pd^.def;
+                                         hp^.next:=procs;
+                                         hp^.firstpara:=tparaitem(pd^.def.Para.first);
+                                         if not(po_varargs in pd^.def.procoptions) then
+                                          begin
+                                            { if not all parameters are given, then skip the
+                                              default parameters }
+                                            for i:=1 to pd^.def.maxparacount-paralength do
+                                             hp^.firstpara:=tparaitem(hp^.firstPara.next);
+                                          end;
+                                         hp^.nextpara:=hp^.firstpara;
+                                         procs:=hp;
+                                       end;
+                                    end;
+                                   pd:=pd^.next;
+                                 end;
+                              end;
+                           end;
+                          srsymtable:=srsymtable.next;
                         end;
-                       pdl:=pdl^.next;
                      end;
-                    if not found then
-                     aprocsym.addprocdef(srpdl^.def);
-                    srpdl:=srpdl^.next;
-                  end;
-
-                     end;
-{$endif CROSSUNIT}
 
                    { no procedures found? then there is something wrong
                      with the parameter size }
@@ -1796,7 +1836,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.63  2002-01-24 12:33:52  jonas
+  Revision 1.64  2002-01-24 18:25:48  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.63  2002/01/24 12:33:52  jonas
     * adapted ranges of native types to int64 (e.g. high cardinal is no
       longer longint($ffffffff), but just $fffffff in psystem)
     * small additional fix in 64bit rangecheck code generation for 32 bit

compiler/ninl.pas

@@ -1299,7 +1299,7 @@ implementation
                 begin
                   { give warning for incompatibility with tp and delphi }
                   if (inlinenumber in [in_lo_long,in_hi_long,in_lo_qword,in_hi_qword]) and
-                     ((m_tp in aktmodeswitches) or
+                     ((m_tp7 in aktmodeswitches) or
                       (m_delphi in aktmodeswitches)) then
                     CGMessage(type_w_maybe_wrong_hi_lo);
                   { constant folding }
@@ -2341,7 +2341,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.68  2002-01-19 11:53:56  peter
+  Revision 1.69  2002-01-24 18:25:48  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.68  2002/01/19 11:53:56  peter
     * constant evaluation for assinged added
 
   Revision 1.67  2001/12/28 14:09:21  jonas

compiler/pdecobj.pas

@@ -577,7 +577,7 @@ implementation
            include(aktclass.objectoptions,oo_has_destructor);
            consume(_SEMICOLON);
            if not(aktprocdef.Para.empty) then
-             if not (m_tp in aktmodeswitches) then
+             if (m_fpc in aktmodeswitches) then
                Message(parser_e_no_paras_for_destructor);
            { no return value }
            aktprocdef.rettype:=voidtype;
@@ -905,9 +905,8 @@ implementation
            Message(parser_e_no_local_objects);
 
          storetypecanbeforward:=typecanbeforward;
-         { for tp mode don't allow forward types }
-         if (m_tp in aktmodeswitches) and
-            not (m_delphi in aktmodeswitches) then
+         { for tp7 don't allow forward types }
+         if (m_tp7 in aktmodeswitches) then
            typecanbeforward:=false;
 
          if not(readobjecttype) then
@@ -1111,7 +1110,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.36  2002-01-06 12:08:15  peter
+  Revision 1.37  2002-01-24 18:25:48  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.36  2002/01/06 12:08:15  peter
     * removed uauto from orddef, use new range_to_basetype generating
       the correct ordinal type for a range
 

compiler/pdecsub.pas

@@ -538,7 +538,7 @@ implementation
             begin
               { when the other symbol is a unit symbol then hide the unit
                 symbol. Only in tp mode because it's bad programming }
-              if (m_tp in aktmodeswitches) and
+              if (m_duplicate_names in aktmodeswitches) and
                  (aktprocsym.typ=unitsym) then
                begin
                  aktprocsym.owner.rename(aktprocsym.name,'hidden'+aktprocsym.name);
@@ -2014,7 +2014,11 @@ const
 end.
 {
   $Log$
-  Revision 1.45  2002-01-09 07:38:03  michael
+  Revision 1.46  2002-01-24 18:25:49  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.45  2002/01/09 07:38:03  michael
   + Patch from peter for library imports
 
   Revision 1.44  2002/01/06 21:54:07  peter

compiler/pexpr.pas

@@ -301,7 +301,7 @@ implementation
                   do_member_read(false,sym,p2,again)
                 else
                   begin
-                    if (m_tp in aktmodeswitches) then
+                    if not(m_fpc in aktmodeswitches) then
                       do_member_read(false,sym,p2,again)
                     else
                       begin
@@ -357,7 +357,7 @@ implementation
                   if (tpointerdef(p.resulttype.def).pointertype.def.deftype=orddef) and
                      (torddef(tpointerdef(p.resulttype.def).pointertype.def).typ=uvoid) then
                     begin
-                      if (m_tp in aktmodeswitches) or
+                      if (m_tp7 in aktmodeswitches) or
                          (m_delphi in aktmodeswitches) then
                        Message(parser_w_no_new_dispose_on_void_pointers)
                       else
@@ -1189,7 +1189,7 @@ implementation
                     ((tvarsym(sym)=otsym) and ((p^.flags and pi_operator)<>0))) and
                    (not is_void(p^.procdef.rettype.def)) and
                    (token<>_LKLAMMER) and
-                   (not ((m_tp in aktmodeswitches) and (afterassignment or in_args)))
+                   (not (not(m_fpc in aktmodeswitches) and (afterassignment or in_args)))
                   ) then
                  begin
                     if ((tvarsym(sym)=otsym) and
@@ -2483,7 +2483,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2002-01-06 21:47:32  peter
+  Revision 1.55  2002-01-24 18:25:49  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.54  2002/01/06 21:47:32  peter
     * removed getprocvar, use only getprocvardef
 
   Revision 1.53  2001/12/31 16:59:42  peter

compiler/pmodules.pas

@@ -621,7 +621,7 @@ implementation
         if (m_delphi in aktmodeswitches) then
          current_scanner.def_macro('FPC_DELPHI')
         else
-         if (m_tp in aktmodeswitches) then
+         if (m_tp7 in aktmodeswitches) then
           current_scanner.def_macro('FPC_TP')
         else
          if (m_objfpc in aktmodeswitches) then
@@ -1349,7 +1349,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  2001-12-09 03:34:58  carl
+  Revision 1.51  2002-01-24 18:25:49  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.50  2001/12/09 03:34:58  carl
   + Stack checking for solaris
 
   Revision 1.49  2001/11/02 23:16:51  peter

compiler/pstatmnt.pas

@@ -42,7 +42,7 @@ implementation
        cutils,
        { global }
        globtype,globals,verbose,
-       systems,cpuinfo,
+       systems,cpuinfo,cpuasm,
        { aasm }
        cpubase,aasm,
        { symtable }
@@ -1044,7 +1044,76 @@ implementation
 
     function assembler_block : tnode;
 
+      procedure OptimizeFramePointer(p:tasmnode);
+      var
+        hp : tai;
+        parafixup,
+        i : longint;
+      begin
+        { replace framepointer with stackpointer }
+        procinfo^.framepointer:=stack_pointer;
+        { set the right value for parameters }
+        dec(aktprocdef.parast.address_fixup,target_info.size_of_pointer);
+        dec(procinfo^.para_offset,target_info.size_of_pointer);
+        { replace all references to parameters in the instructions,
+          the parameters can be identified by the parafixup option
+          that is set. For normal user coded [ebp+4] this field is not
+          set }
+        parafixup:=aktprocdef.parast.address_fixup;
+        hp:=tai(p.p_asm.first);
+        while assigned(hp) do
+         begin
+           if hp.typ=ait_instruction then
+            begin
+              { fixup the references }
+              for i:=1 to taicpu(hp).ops do
+               begin
+                 with taicpu(hp).oper[i-1] do
+                  if typ=top_ref then
+                   begin
+                     case ref^.options of
+                       ref_parafixup :
+                         begin
+                           ref^.offsetfixup:=parafixup;
+                           ref^.base:=stack_pointer;
+                         end;
+                     end;
+                   end;
+               end;
+            end;
+           hp:=tai(hp.next);
+         end;
+      end;
+
+{$ifdef CHECKFORPUSH}
+      function UsesPush(p:tasmnode):boolean;
+      var
+        hp : tai;
+      begin
+        hp:=tai(p.p_asm.first);
+        while assigned(hp) do
+         begin
+           if (hp.typ=ait_instruction) and
+              (taicpu(hp).opcode=A_PUSH) then
+            begin
+              UsesPush:=true;
+              exit;
+            end;
+           hp:=tai(hp.next);
+         end;
+        UsesPush:=false;
+      end;
+{$endif CHECKFORPUSH}
+
+      var
+        p : tnode;
+        haslocals,hasparas : boolean;
       begin
+         { retrieve info about locals and paras before a result
+           is inserted in the symtable }
+         haslocals:=(aktprocdef.localst.datasize>0);
+         hasparas:=(aktprocdef.parast.datasize>0);
+
          { temporary space is set, while the BEGIN of the procedure }
          if symtablestack.symtabletype=localsymtable then
            procinfo^.firsttemp_offset := -symtablestack.datasize
@@ -1053,75 +1122,74 @@ implementation
 
          { assembler code does not allocate }
          { space for the return value       }
-          if not is_void(aktprocdef.rettype.def) then
+         if not is_void(aktprocdef.rettype.def) then
            begin
               aktprocdef.funcretsym:=tfuncretsym.create(aktprocsym.name,aktprocdef.rettype);
+              { insert in local symtable }
+              { but with another name, so that recursive calls are possible }
+              symtablestack.insert(aktprocdef.funcretsym);
+              symtablestack.rename(aktprocdef.funcretsym.name,'$result');
+              { set the used flag for the return }
               if ret_in_acc(aktprocdef.rettype.def) then
                 begin
-                   { in assembler code the result should be directly in %eax
-                   procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef.size;
-                   procinfo^.firsttemp:=procinfo^.retoffset;                 }
-
-{$ifndef newcg}
 {$ifdef i386}
                    usedinproc:=usedinproc or ($80 shr byte(R_EAX))
 {$else}
-{$ifdef POWERPC}
+  {$ifdef POWERPC}
                    usedinproc:=0;
-{$else POWERPC}
+  {$else POWERPC}
                    usedinproc:=usedinproc + [accumulator];
-{$endif POWERPC}
+  {$endif POWERPC}
 {$endif i386}
-{$endif newcg}
-                end
-              {
-              else if not is_fpu(procinfo^.retdef) then
-               should we allow assembler functions of big elements ?
-                YES (FK)!!
-               Message(parser_e_asm_incomp_with_function_return);
-              }
-            end;
-           { set the framepointer to esp for assembler functions }
-           { but only if the are no local variables           }
-           { added no parameter also (PM)                       }
-           { disable for methods, because self pointer is expected }
-           { at -8(%ebp) (JM)                                      }
-           { why if se use %esp then self is still at the correct address PM }
-           if {not(assigned(procinfo^._class)) and}
-              (po_assembler in aktprocdef.procoptions) and
-              (aktprocdef.localst.datasize=0) and
-              (aktprocdef.parast.datasize=0) and
-              not(ret_in_param(aktprocdef.rettype.def)) then
-             begin
-               procinfo^.framepointer:=stack_pointer;
-               { set the right value for parameters }
-               dec(aktprocdef.parast.address_fixup,target_info.size_of_pointer);
-               dec(procinfo^.para_offset,target_info.size_of_pointer);
-             end;
-          { only insert now in the symtable, otherwise the              }
-          { "aktprocdef.localst.datasize=0" check above will }
-          { always fail (JM)                                            }
-          if not is_void(aktprocdef.rettype.def) then
-            begin
-              { insert in local symtable }
-              { but with another name, so that recursive calls are possible }
-              symtablestack.insert(aktprocdef.funcretsym);
-              symtablestack.rename(aktprocdef.funcretsym.name,'$result');
+                end;
             end;
-          { force the asm statement }
-            if token<>_ASM then
-             consume(_ASM);
-            procinfo^.Flags := procinfo^.Flags Or pi_is_assembler;
-            assembler_block:=_asm_statement;
-          { becuase the END is already read we need to get the
-            last_endtoken_filepos here (PFV) }
-            last_endtoken_filepos:=akttokenpos;
-          end;
+         { force the asm statement }
+         if token<>_ASM then
+           consume(_ASM);
+         procinfo^.Flags := procinfo^.Flags Or pi_is_assembler;
+         p:=_asm_statement;
+
+
+         { set the framepointer to esp for assembler functions when the
+           following conditions are met:
+           - if the are no local variables
+           - no reference to the result variable (refcount<=1)
+           - result is not stored as parameter }
+         if (po_assembler in aktprocdef.procoptions) and
+            (not haslocals) and
+            (not hasparas) and
+            (aktprocdef.owner.symtabletype<>objectsymtable) and
+            (not assigned(aktprocdef.funcretsym) or
+             (tfuncretsym(aktprocdef.funcretsym).refcount<=1)) and
+            not(ret_in_param(aktprocdef.rettype.def))
+{$ifdef CHECKFORPUSH}
+            and not(UsesPush(tasmnode(p)))
+{$endif CHECKFORPUSH}
+            then
+           OptimizeFramePointer(tasmnode(p));
+
+        { Flag the result as assigned when it is returned in the
+          accumulator or on the fpu stack }
+        if assigned(aktprocdef.funcretsym) and
+           (is_fpu(aktprocdef.rettype.def) or
+           ret_in_acc(aktprocdef.rettype.def)) then
+          tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+
+        { because the END is already read we need to get the
+          last_endtoken_filepos here (PFV) }
+        last_endtoken_filepos:=akttokenpos;
+
+        assembler_block:=p;
+      end;
 
 end.
 {
   $Log$
-  Revision 1.44  2001-11-09 10:06:56  jonas
+  Revision 1.45  2002-01-24 18:25:49  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.44  2001/11/09 10:06:56  jonas
     * allow recursive calls again in assembler procedure
 
   Revision 1.43  2001/11/02 22:58:05  peter

compiler/ptconst.pas

@@ -291,7 +291,7 @@ implementation
                       begin
                         len:=tstringconstnode(p).len;
                         { For tp7 the maximum lentgh can be 255 }
-                        if (m_tp in aktmodeswitches) and
+                        if (m_tp7 in aktmodeswitches) and
                            (len>255) then
                          len:=255;
                         getmem(ca,len+2);
@@ -624,7 +624,7 @@ implementation
                     begin
                       len:=tstringconstnode(p).len;
                       { For tp7 the maximum lentgh can be 255 }
-                      if (m_tp in aktmodeswitches) and
+                      if (m_tp7 in aktmodeswitches) and
                          (len>255) then
                        len:=255;
                       ca:=tstringconstnode(p).value_str;
@@ -872,7 +872,7 @@ implementation
                 end
               { for objects we allow it only if it doesn't contain a vmt }
               else if (oo_has_vmt in tobjectdef(t.def).objectoptions) and
-                      not(m_tp in aktmodeswitches) then
+                      (m_fpc in aktmodeswitches) then
                  Message(parser_e_type_const_not_possible)
               else
                 begin
@@ -910,7 +910,7 @@ implementation
                                Message(parser_e_invalid_record_const);
 
                              { check in VMT needs to be added for TP mode }
-                             if (m_tp in aktmodeswitches) and
+                             if not(m_fpc in aktmodeswitches) and
                                 (oo_has_vmt in tobjectdef(t.def).objectoptions) and
                                 (tobjectdef(t.def).vmt_offset<tvarsym(srsym).address) then
                                begin
@@ -937,7 +937,7 @@ implementation
                              else break;
                           end;
                      end;
-                   if (m_tp in aktmodeswitches) and
+                   if not(m_fpc in aktmodeswitches) and
                       (oo_has_vmt in tobjectdef(t.def).objectoptions) and
                       (tobjectdef(t.def).vmt_offset>=aktpos) then
                      begin
@@ -970,7 +970,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  2002-01-06 21:47:32  peter
+  Revision 1.41  2002-01-24 18:25:49  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.40  2002/01/06 21:47:32  peter
     * removed getprocvar, use only getprocvardef
 
   Revision 1.39  2001/12/06 17:57:38  florian

compiler/ptype.pas

@@ -218,8 +218,8 @@ implementation
          old_object_option:=current_object_option;
          current_object_option:=[sp_public];
          storetypecanbeforward:=typecanbeforward;
-         { for tp mode don't allow forward types }
-         if m_tp in aktmodeswitches then
+         { for tp7 don't allow forward types }
+         if m_tp7 in aktmodeswitches then
            typecanbeforward:=false;
          read_var_decs(true,false,false);
          consume(_END);
@@ -612,7 +612,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.33  2002-01-15 16:13:34  jonas
+  Revision 1.34  2002-01-24 18:25:49  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.33  2002/01/15 16:13:34  jonas
     * fixed web bugs 1758 and 1760
 
   Revision 1.32  2002/01/06 12:08:15  peter

compiler/rautils.pas

@@ -728,8 +728,8 @@ Begin
   { replace by correct offset. }
   if (not is_void(aktprocdef.rettype.def)) then
    begin
-     if (procinfo^.return_offset=0) and ((m_tp in aktmodeswitches) or
-        (m_delphi in aktmodeswitches)) then
+     if (m_tp7 in aktmodeswitches) and
+        ret_in_acc(aktprocdef.rettype.def) then
        begin
          Message(asmr_e_cannot_use_RESULT_here);
          exit;
@@ -739,6 +739,9 @@ Begin
      opr.ref.options:=ref_parafixup;
      { always assume that the result is valid. }
      tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+     { increase reference count, this is also used to check
+       if the result variable is actually used or not }
+     inc(tfuncretsym(aktprocdef.funcretsym).refcount);
      SetupResult:=true;
    end
   else
@@ -806,7 +809,8 @@ Begin
                 register is still free, and loading it first is also
                 not possible, because this could break code }
               { Be TP/Delphi compatible in Delphi or TP modes }
-              if (m_tp in aktmodeswitches) then
+              if (m_tp7 in aktmodeswitches) or
+                 (m_delphi in aktmodeswitches) then
                 begin
                   opr.typ:=OPR_CONSTANT;
                   opr.val:=tvarsym(sym).address;
@@ -1581,7 +1585,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.25  2001-11-02 22:58:06  peter
+  Revision 1.26  2002-01-24 18:25:50  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.25  2001/11/02 22:58:06  peter
     * procsym definition rewrite
 
   Revision 1.24  2001/09/02 21:18:28  peter

compiler/scanner.pas

@@ -1981,7 +1981,7 @@ implementation
 
              '%' :
                begin
-                 if (m_tp in aktmodeswitches) then
+                 if not(m_fpc in aktmodeswitches) then
                   Illegal_Char(c)
                  else
                   begin
@@ -2656,7 +2656,11 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.27  2001-10-22 20:25:49  peter
+  Revision 1.28  2002-01-24 18:25:50  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.27  2001/10/22 20:25:49  peter
     * fixed previous commit
 
   Revision 1.26  2001/10/22 19:55:44  peter

compiler/symtable.pas

@@ -554,7 +554,7 @@ implementation
               same name as the function, the function is then hidden for
               the user. (Under delphi it can still be accessed using result),
               but don't allow hiding of RESULT }
-            if (m_tp in aktmodeswitches) and
+            if (m_duplicate_names in aktmodeswitches) and
                (hsym.typ=funcretsym) and
                not((m_result in aktmodeswitches) and
                    (hsym.name='RESULT')) then
@@ -1195,7 +1195,7 @@ implementation
                 begin
                   { a parameter and the function can have the same
                     name in TP and Delphi, but RESULT not }
-                  if (m_tp in aktmodeswitches) and
+                  if (m_duplicate_names in aktmodeswitches) and
                      (sym.typ=funcretsym) and
                      not((m_result in aktmodeswitches) and
                          (sym.name='RESULT')) then
@@ -1577,7 +1577,7 @@ implementation
             { Delphi you can have a symbol with the same name as the
               unit, the unit can then not be accessed anymore using
               <unit>.<id>, so we can hide the symbol }
-            if (m_tp in aktmodeswitches) and
+            if (m_duplicate_names in aktmodeswitches) and
                (hsym.typ=symconst.unitsym) then
              hsym.owner.rename(hsym.name,'hidden'+hsym.name)
             else
@@ -2023,7 +2023,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.51  2001-12-31 16:59:43  peter
+  Revision 1.52  2002-01-24 18:25:50  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.51  2001/12/31 16:59:43  peter
     * protected/private symbols parsing fixed
 
   Revision 1.50  2001/11/18 18:43:17  peter

compiler/types.pas

@@ -1239,7 +1239,7 @@ implementation
                  end
                else
                 begin
-                  b:=not(m_tp in aktmodeswitches) and
+                  b:=not(m_tp7 in aktmodeswitches) and
                      not(m_delphi in aktmodeswitches) and
                      (tarraydef(def1).lowrange=tarraydef(def2).lowrange) and
                      (tarraydef(def1).highrange=tarraydef(def2).highrange) and
@@ -1953,7 +1953,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.63  2002-01-24 12:33:53  jonas
+  Revision 1.64  2002-01-24 18:25:53  peter
+   * implicit result variable generation for assembler routines
+   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
+
+  Revision 1.63  2002/01/24 12:33:53  jonas
     * adapted ranges of native types to int64 (e.g. high cardinal is no
       longer longint($ffffffff), but just $fffffff in psystem)
     * small additional fix in 64bit rangecheck code generation for 32 bit