* float routines all use internproc and compilerproc helpers

compiler/compinnr.inc

@@ -64,38 +64,34 @@ const
    in_cycle             = 52; {macpas}
 
 { Internal constant functions }
-   in_const_trunc      = 100;
-   in_const_round      = 101;
-   in_const_frac       = 102;
-   in_const_abs        = 103;
-   in_const_int        = 104;
-   in_const_sqr        = 105;
-   in_const_odd        = 106;
-   in_const_ptr        = 107;
-   in_const_swap_word  = 108;
-   in_const_swap_long  = 109;
-   in_const_pi         = 110;
-   in_const_sqrt       = 111;
-   in_const_arctan     = 112;
-   in_const_cos        = 113;
-   in_const_exp        = 114;
-   in_const_ln         = 115;
-   in_const_sin        = 116;
-   in_lo_qword         = 117;
-   in_hi_qword         = 118;
-   in_cos_extended     = 119;
-   in_pi               = 121;
-   in_abs_extended     = 122;
-   in_sqr_extended     = 123;
-   in_sqrt_extended    = 124;
-   in_arctan_extended  = 125;
-   in_ln_extended      = 126;
-   in_sin_extended     = 127;
-   in_const_swap_qword = 128;
-   in_prefetch_var     = 129;
+   in_const_sqr        = 100;
+   in_const_abs        = 101;
+   in_const_odd        = 102;
+   in_const_ptr        = 103;
+   in_const_swap_word  = 104;
+   in_const_swap_long  = 105;
+   in_lo_qword         = 106;
+   in_hi_qword         = 107;
+   in_const_swap_qword = 108;
+   in_prefetch_var     = 109;
+
+{ FPU functions }
+   in_trunc_real       = 120;
+   in_round_real       = 121;
+   in_frac_real        = 122;
+   in_int_real         = 123;
+   in_exp_real         = 124;
+   in_cos_real         = 125;
+   in_pi_real          = 126;
+   in_abs_real         = 127;
+   in_sqr_real         = 128;
+   in_sqrt_real        = 129;
+   in_arctan_real      = 130;
+   in_ln_real          = 131;
+   in_sin_real         = 132;
 
 { MMX functions }
-{ these contants are used by the mmx unit }
+  { these contants are used by the mmx unit }
 
    { MMX }
    in_mmx_pcmpeqb      = 200;
@@ -111,7 +107,10 @@ const
 
 {
   $Log$
-  Revision 1.14  2004-07-05 21:49:43  olle
+  Revision 1.15  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.14  2004/07/05 21:49:43  olle
     + macpas style: exit, cycle, leave
     + macpas compiler directive: PUSH POP
 

compiler/ncginl.pas

@@ -111,35 +111,35 @@ implementation
               begin
                  second_IncludeExclude;
               end;
-            in_pi:
+            in_pi_real:
               begin
                 second_pi;
               end;
-            in_sin_extended:
+            in_sin_real:
               begin
                 second_sin_real;
               end;
-            in_arctan_extended:
+            in_arctan_real:
               begin
                 second_arctan_real;
               end;
-            in_abs_extended:
+            in_abs_real:
               begin
                 second_abs_real;
               end;
-            in_sqr_extended:
+            in_sqr_real:
               begin
                 second_sqr_real;
               end;
-            in_sqrt_extended:
+            in_sqrt_real:
               begin
                 second_sqrt_real;
               end;
-            in_ln_extended:
+            in_ln_real:
               begin
                 second_ln_real;
               end;
-            in_cos_extended:
+            in_cos_real:
               begin
                  second_cos_real;
               end;
@@ -679,7 +679,10 @@ end.
 
 {
   $Log$
-  Revision 1.66  2004-11-08 21:59:34  florian
+  Revision 1.67  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.66  2004/11/08 21:59:34  florian
     * include/exclude for sets in registers fixed
 
   Revision 1.65  2004/10/31 21:45:03  peter

compiler/ncnv.pas

@@ -910,7 +910,7 @@ implementation
         if left.nodetype=realconstn then
           result:=cordconstnode.create(round(trealconstnode(left).value_real),resulttype,false)
         else
-          result:=ccallnode.createinternres('fpc_round',
+          result:=ccallnode.createinternres('fpc_round_real',
             ccallparanode.create(left,nil),resulttype);
         left:=nil;
       end;
@@ -2482,7 +2482,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.162  2004-11-02 20:15:53  jonas
+  Revision 1.163  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.162  2004/11/02 20:15:53  jonas
     * copy totype field in ttypeconvnode.getcopy()
 
   Revision 1.161  2004/11/02 12:55:16  peter

compiler/ninl.pas

@@ -54,6 +54,11 @@ interface
           function first_ln_real: tnode; virtual;
           function first_cos_real: tnode; virtual;
           function first_sin_real: tnode; virtual;
+          function first_exp_real: tnode; virtual;
+          function first_frac_real: tnode; virtual;
+          function first_round_real: tnode; virtual;
+          function first_trunc_real: tnode; virtual;
+          function first_int_real: tnode; virtual;
         private
           function handle_str: tnode;
           function handle_reset_rewrite_typed: tnode;
@@ -1207,7 +1212,7 @@ implementation
             if not assigned(left) then
              begin
                case inlinenumber of
-                 in_const_pi :
+                 in_pi_real :
                    hp:=crealconstnode.create(pi,pbestrealtype^);
                  else
                    internalerror(89);
@@ -1217,13 +1222,11 @@ implementation
              begin
                vl:=0;
                vl2:=0; { second parameter Ex: ptr(vl,vl2) }
-               vr:=0;
-               isreal:=false;
                case left.nodetype of
                  realconstn :
                    begin
-                     isreal:=true;
-                     vr:=trealconstnode(left).value_real;
+                     { Real functions are all handled with internproc below }
+                     CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
                    end;
                  ordconstn :
                    vl:=tordconstnode(left).value;
@@ -1237,149 +1240,20 @@ implementation
                    CGMessage(parser_e_illegal_expression);
                end;
                case inlinenumber of
-                 in_const_trunc :
-                   begin
-                     if isreal then
-                       begin
-                          if (vr>=9223372036854775808.0) or (vr<=-9223372036854775809.0) then
-                            begin
-                               CGMessage(parser_e_range_check_error);
-                               hp:=cordconstnode.create(1,s64inttype,false)
-                            end
-                          else
-                            hp:=cordconstnode.create(trunc(vr),s64inttype,true)
-                       end
-                     else
-                      hp:=cordconstnode.create(trunc(vl),s64inttype,true);
-                   end;
-                 in_const_round :
-                   begin
-                     if isreal then
-                       begin
-                          if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
-                            begin
-                               CGMessage(parser_e_range_check_error);
-                               hp:=cordconstnode.create(1,s64inttype,false)
-                            end
-                          else
-                            hp:=cordconstnode.create(round(vr),s64inttype,true)
-                       end
-                     else
-                      hp:=cordconstnode.create(round(vl),s64inttype,true);
-                   end;
-                 in_const_frac :
-                   begin
-                     if isreal then
-                      hp:=crealconstnode.create(frac(vr),pbestrealtype^)
-                     else
-                      hp:=crealconstnode.create(frac(vl),pbestrealtype^);
-                   end;
-                 in_const_int :
-                   begin
-                     if isreal then
-                      hp:=crealconstnode.create(int(vr),pbestrealtype^)
-                     else
-                      hp:=crealconstnode.create(int(vl),pbestrealtype^);
-                   end;
                  in_const_abs :
-                   begin
-                     if isreal then
-                      hp:=crealconstnode.create(abs(vr),pbestrealtype^)
-                     else
-                      hp:=genintconstnode(abs(vl));
-                   end;
+                   hp:=genintconstnode(abs(vl));
                  in_const_sqr :
-                   begin
-                     if isreal then
-                      hp:=crealconstnode.create(sqr(vr),pbestrealtype^)
-                     else
-                      hp:=genintconstnode(sqr(vl));
-                   end;
+                   hp:=genintconstnode(sqr(vl));
                  in_const_odd :
-                   begin
-                     if isreal then
-                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
-                     else
-                      hp:=cordconstnode.create(byte(odd(vl)),booltype,true);
-                   end;
+                   hp:=cordconstnode.create(byte(odd(vl)),booltype,true);
                  in_const_swap_word :
-                   begin
-                     if isreal then
-                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
-                     else
-                      hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resulttype,true);
-                   end;
+                   hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resulttype,true);
                  in_const_swap_long :
-                   begin
-                     if isreal then
-                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
-                     else
-                      hp:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resulttype,true);
-                   end;
+                   hp:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resulttype,true);
                  in_const_swap_qword :
-                   begin
-                     if isreal then
-                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
-                     else
-                      hp:=cordconstnode.create((vl and $ffff) shl 32+(vl shr 32),left.resulttype,true);
-                   end;
+                   hp:=cordconstnode.create((vl and $ffff) shl 32+(vl shr 32),left.resulttype,true);
                  in_const_ptr :
-                   begin
-                     if isreal then
-                      CGMessage1(type_e_integer_expr_expected,left.resulttype.def.typename)
-                     else
-                      hp:=cpointerconstnode.create((vl2 shl 4)+vl,voidfarpointertype);
-                   end;
-                 in_const_sqrt :
-                   begin
-                     if isreal then
-                       hp:=handle_sqrt_const(vr)
-                     else
-                       hp:=handle_sqrt_const(vl)
-                   end;
-                 in_const_arctan :
-                   begin
-                     if isreal then
-                      hp:=crealconstnode.create(arctan(vr),pbestrealtype^)
-                     else
-                      hp:=crealconstnode.create(arctan(vl),pbestrealtype^);
-                   end;
-                 in_const_cos :
-                   begin
-                     if isreal then
-                      hp:=crealconstnode.create(cos(vr),pbestrealtype^)
-                     else
-                      hp:=crealconstnode.create(cos(vl),pbestrealtype^);
-                   end;
-                 in_const_sin :
-                   begin
-                     if isreal then
-                      hp:=crealconstnode.create(sin(vr),pbestrealtype^)
-                     else
-                      hp:=crealconstnode.create(sin(vl),pbestrealtype^);
-                   end;
-                 in_const_exp :
-                   begin
-                     if isreal then
-                       hp:=crealconstnode.create(exp(vr),pbestrealtype^)
-                     else
-                       hp:=crealconstnode.create(exp(vl),pbestrealtype^);
-
-                     if (trealconstnode(hp).value_real=double(MathInf)) and
-                        ((cs_check_range in aktlocalswitches) or
-                        (cs_check_overflow in aktlocalswitches)) then
-                       begin
-                         result:=crealconstnode.create(0,pbestrealtype^);
-                         CGMessage(parser_e_range_check_error);
-                       end;
-                   end;
-                 in_const_ln :
-                   begin
-                     if isreal then
-                       hp:=handle_ln_const(vr)
-                     else
-                       hp:=handle_ln_const(vl)
-                   end;
+                   hp:=cpointerconstnode.create((vl2 shl 4)+vl,voidfarpointertype);
                  else
                    internalerror(88);
                end;
@@ -1690,8 +1564,7 @@ implementation
               in_seg_x :
                 begin
                   set_varstate(left,vs_used,false);
-                  hp:=cordconstnode.create(0,s32inttype,false);
-                  result:=hp;
+                  result:=cordconstnode.create(0,s32inttype,false);
                   goto myexit;
                 end;
 
@@ -1719,10 +1592,9 @@ implementation
                    if left.nodetype=ordconstn then
                     begin
                       if inlinenumber=in_succ_x then
-                       hp:=cordconstnode.create(tordconstnode(left).value+1,left.resulttype,checkrange)
+                        result:=cordconstnode.create(tordconstnode(left).value+1,left.resulttype,checkrange)
                       else
-                       hp:=cordconstnode.create(tordconstnode(left).value-1,left.resulttype,checkrange);
-                      result:=hp;
+                        result:=cordconstnode.create(tordconstnode(left).value-1,left.resulttype,checkrange);
                     end;
                 end;
 
@@ -1781,9 +1653,8 @@ implementation
                   srsym:=searchsymonlyin(systemunit,'SETTEXTBUF');
                   hp:=ccallparanode.create(cordconstnode.create(
                      tcallparanode(left).left.resulttype.def.size,s32inttype,true),left);
-                  hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil,[]);
+                  result:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil,[]);
                   left:=nil;
-                  result:=hp;
                 end;
 
               { the firstpass of the arg has been done in firstcalln ? }
@@ -1890,14 +1761,102 @@ implementation
                   end;
                 end;
 
-             in_pi:
+              in_exp_real :
+                begin
+                  if left.nodetype in [ordconstn,realconstn] then
+                    begin
+                      result:=crealconstnode.create(exp(getconstrealvalue),pbestrealtype^);
+                      if (trealconstnode(result).value_real=double(MathInf)) and
+                         ((cs_check_range in aktlocalswitches) or
+                          (cs_check_overflow in aktlocalswitches)) then
+                        begin
+                          result:=crealconstnode.create(0,pbestrealtype^);
+                          CGMessage(parser_e_range_check_error);
+                        end;
+                    end
+                  else
+                    begin
+                      set_varstate(left,vs_used,true);
+                      inserttypeconv(left,pbestrealtype^);
+                      resulttype:=pbestrealtype^;
+                    end;
+                end;
+
+              in_trunc_real :
+                begin
+                  if left.nodetype in [ordconstn,realconstn] then
+                    begin
+                      vr:=getconstrealvalue;
+                      if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
+                        begin
+                          CGMessage(parser_e_range_check_error);
+                          result:=cordconstnode.create(1,s64inttype,false)
+                        end
+                      else
+                        result:=cordconstnode.create(trunc(vr),s64inttype,true)
+                    end
+                  else
+                    begin
+                      set_varstate(left,vs_used,true);
+                      inserttypeconv(left,pbestrealtype^);
+                      resulttype:=s64inttype;
+                    end;
+                end;
+
+              in_round_real :
+                begin
+                  if left.nodetype in [ordconstn,realconstn] then
+                    begin
+                      vr:=getconstrealvalue;
+                      if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then
+                        begin
+                          CGMessage(parser_e_range_check_error);
+                          result:=cordconstnode.create(1,s64inttype,false)
+                        end
+                      else
+                        result:=cordconstnode.create(round(vr),s64inttype,true)
+                    end
+                  else
+                    begin
+                      set_varstate(left,vs_used,true);
+                      inserttypeconv(left,pbestrealtype^);
+                      resulttype:=s64inttype;
+                    end;
+                end;
+
+              in_frac_real :
+                begin
+                  if left.nodetype in [ordconstn,realconstn] then
+                    setconstrealvalue(frac(getconstrealvalue))
+                  else
+                    begin
+                      set_varstate(left,vs_used,true);
+                      inserttypeconv(left,pbestrealtype^);
+                      resulttype:=pbestrealtype^;
+                    end;
+                end;
+
+              in_int_real :
+                begin
+                  if left.nodetype in [ordconstn,realconstn] then
+                    setconstrealvalue(int(getconstrealvalue))
+                  else
+                    begin
+                      set_varstate(left,vs_used,true);
+                      inserttypeconv(left,pbestrealtype^);
+                      resulttype:=pbestrealtype^;
+                    end;
+                end;
+
+             in_pi_real :
                 begin
                   if block_type=bt_const then
                      setconstrealvalue(pi)
                   else
                      resulttype:=pbestrealtype^;
                 end;
-              in_cos_extended :
+
+              in_cos_real :
                 begin
                   if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(cos(getconstrealvalue))
@@ -1909,7 +1868,7 @@ implementation
                    end;
                 end;
 
-              in_sin_extended :
+              in_sin_real :
                 begin
                   if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(sin(getconstrealvalue))
@@ -1921,7 +1880,7 @@ implementation
                    end;
                 end;
 
-              in_arctan_extended :
+              in_arctan_real :
                 begin
                   if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(arctan(getconstrealvalue))
@@ -1933,7 +1892,7 @@ implementation
                    end;
                 end;
 
-              in_abs_extended :
+              in_abs_real :
                 begin
                   if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(abs(getconstrealvalue))
@@ -1945,7 +1904,7 @@ implementation
                    end;
                 end;
 
-              in_sqr_extended :
+              in_sqr_real :
                 begin
                   if left.nodetype in [ordconstn,realconstn] then
                    setconstrealvalue(sqr(getconstrealvalue))
@@ -1957,7 +1916,7 @@ implementation
                    end;
                 end;
 
-              in_sqrt_extended :
+              in_sqrt_real :
                 begin
                   if left.nodetype in [ordconstn,realconstn] then
                    begin
@@ -1975,7 +1934,7 @@ implementation
                    end;
                 end;
 
-              in_ln_extended :
+              in_ln_real :
                 begin
                   if left.nodetype in [ordconstn,realconstn] then
                    begin
@@ -2256,42 +2215,67 @@ implementation
 {$endif SUPPORT_MMX}
            end;
 
-         in_cos_extended:
+         in_exp_real:
+           begin
+             result:= first_exp_real;
+           end;
+
+         in_round_real:
+           begin
+             result:= first_round_real;
+           end;
+
+         in_trunc_real:
+           begin
+             result:= first_trunc_real;
+           end;
+
+         in_int_real:
+           begin
+             result:= first_int_real;
+           end;
+
+         in_frac_real:
+           begin
+             result:= first_frac_real;
+           end;
+
+         in_cos_real:
            begin
              result:= first_cos_real;
            end;
 
-         in_sin_extended:
+         in_sin_real:
            begin
              result := first_sin_real;
            end;
 
-         in_arctan_extended:
+         in_arctan_real:
            begin
              result := first_arctan_real;
            end;
 
-         in_pi:
+         in_pi_real :
            begin
              result := first_pi;
            end;
 
-         in_abs_extended:
+         in_abs_real:
            begin
              result := first_abs_real;
            end;
 
-         in_sqr_extended:
+         in_sqr_real:
            begin
              result := first_sqr_real;
            end;
 
-         in_sqrt_extended:
+         in_sqrt_real:
            begin
              result := first_sqrt_real;
            end;
 
-         in_ln_extended:
+         in_ln_real:
            begin
              result := first_ln_real;
            end;
@@ -2434,13 +2418,55 @@ implementation
         left := nil;
       end;
 
+     function tinlinenode.first_exp_real : tnode;
+      begin
+        { create the call to the helper }
+        { on entry left node contains the parameter }
+        result := ccallnode.createintern('fpc_exp_real',ccallparanode.create(left,nil));
+        left := nil;
+      end;
+
+     function tinlinenode.first_int_real : tnode;
+      begin
+        { create the call to the helper }
+        { on entry left node contains the parameter }
+        result := ccallnode.createintern('fpc_int_real',ccallparanode.create(left,nil));
+        left := nil;
+      end;
+
+     function tinlinenode.first_frac_real : tnode;
+      begin
+        { create the call to the helper }
+        { on entry left node contains the parameter }
+        result := ccallnode.createintern('fpc_frac_real',ccallparanode.create(left,nil));
+        left := nil;
+      end;
+
+     function tinlinenode.first_round_real : tnode;
+      begin
+        { create the call to the helper }
+        { on entry left node contains the parameter }
+        result := ccallnode.createintern('fpc_round_real',ccallparanode.create(left,nil));
+        left := nil;
+      end;
+
+     function tinlinenode.first_trunc_real : tnode;
+      begin
+        { create the call to the helper }
+        { on entry left node contains the parameter }
+        result := ccallnode.createintern('fpc_trunc_real',ccallparanode.create(left,nil));
+        left := nil;
+      end;
 
 begin
    cinlinenode:=tinlinenode;
 end.
 {
   $Log$
-  Revision 1.151  2004-11-09 23:10:22  peter
+  Revision 1.152  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.151  2004/11/09 23:10:22  peter
     * use helper call to retrieve address of input/output to reduce
       code that is generated in the main program for loading the
       threadvar

compiler/powerpc/rappcgas.pas

@@ -48,16 +48,14 @@ Unit rappcgas;
       { helpers }
       cutils,
       { global }
-      globtype,globals,verbose,
+      globtype,verbose,
       systems,
       { aasm }
-      cpubase,cpuinfo,aasmbase,aasmtai,aasmcpu,
+      cpubase,aasmbase,aasmtai,aasmcpu,
       { symtable }
-      symconst,symbase,symtype,symsym,symtable,
+      symconst,symsym,
       { parser }
-      scanner,
       procinfo,
-      itcpugas,
       rabase,rautils,
       cgbase,cgobj
       ;
@@ -442,19 +440,6 @@ Unit rappcgas;
                           else
                            if expr = '__OLDEBP' then
                             oper.SetupOldEBP
-                          else
-                            { check for direct symbolic names   }
-                            { only if compiling the system unit }
-                            if (cs_compilesystem in aktmoduleswitches) then
-                             begin
-                               if not oper.SetupDirectVar(expr) then
-                                Begin
-                                  { not found, finally ... add it anyways ... }
-                                  Message1(asmr_w_id_supposed_external,expr);
-                                  oper.InitRef;
-                                  oper.opr.ref.symbol:=objectlibrary.newasmsymbol(expr,AB_EXTERNAL,AT_FUNCTION);
-                                end;
-                             end
                           else
                             Message1(sym_e_unknown_id,expr);
                         end;
@@ -629,8 +614,6 @@ Unit rappcgas;
       var
         str2opentry: tstr2opentry;
         cond  : tasmcondflag;
-        j,
-        sufidx : longint;
         hs : string;
 
       Begin
@@ -696,8 +679,6 @@ Unit rappcgas;
       end;
 
     procedure tppcattreader.ConvertCalljmp(instr : tppcinstruction);
-      var
-        newopr : toprrec;
       begin
         if instr.Operands[1].opr.typ=OPR_REFERENCE then
           begin
@@ -753,7 +734,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.17  2004-11-11 19:31:33  peter
+  Revision 1.18  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.17  2004/11/11 19:31:33  peter
     * fixed compile of powerpc,sparc,arm
 
   Revision 1.16  2004/06/20 08:55:32  florian

compiler/raatt.pas

@@ -40,7 +40,7 @@ unit raatt;
       { symtable }
       symconst,
       { cg }
-      cgbase,node;
+      cgbase;
 
     type
       tasmtoken = (
@@ -88,7 +88,7 @@ unit raatt;
          procedure BuildRealConstant(typ : tfloattype);
          procedure BuildStringConstant(asciiz: boolean);
          procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint);
-         procedure BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string);
+         procedure BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype);
          function BuildConstExpression(allowref,betweenbracket:boolean): aint;
          function Assemble: tlinkedlist;override;
          procedure handleopcode;virtual;abstract;
@@ -758,6 +758,7 @@ unit raatt;
 
     Procedure tattreader.BuildConstant(constsize: longint);
       var
+       asmsymtyp : TAsmSymType;
        asmsym,
        expr: string;
        value : aint;
@@ -786,7 +787,7 @@ unit raatt;
             AS_NOT,
             AS_ID :
               Begin
-                BuildConstSymbolExpression(false,false,false,value,asmsym);
+                BuildConstSymbolExpression(false,false,false,value,asmsym,asmsymtyp);
                 if asmsym<>'' then
                  begin
                    if constsize<>sizeof(aint) then
@@ -1181,8 +1182,9 @@ unit raatt;
       end;
 
 
-    procedure tattreader.BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string);
+    procedure tattreader.BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype);
       var
+        hssymtyp : TAsmSymType;
         hs,tempstr,expr : string;
         parenlevel : longint;
         l,k : aint;
@@ -1193,6 +1195,7 @@ unit raatt;
         hl  : tasmlabel;
       Begin
         asmsym:='';
+        asmsymtyp:=AT_DATA;
         value:=0;
         errorflag:=FALSE;
         tempstr:='';
@@ -1356,6 +1359,7 @@ unit raatt;
             AS_ID:
               Begin
                 hs:='';
+                hssymtyp:=AT_DATA;
                 tempstr:=actasmpattern;
                 prevtok:=prevasmtoken;
                 consume(AS_ID);
@@ -1369,11 +1373,15 @@ unit raatt;
                    if is_locallabel(tempstr) then
                     begin
                       CreateLocalLabel(tempstr,hl,false);
-                      hs:=hl.name
+                      hs:=hl.name;
+                      hssymtyp:=AT_FUNCTION;
                     end
                    else
                     if SearchLabel(tempstr,hl,false) then
-                     hs:=hl.name
+                      begin
+                        hs:=hl.name;
+                        hssymtyp:=AT_FUNCTION;
+                      end
                    else
                     begin
                       searchsym(tempstr,sym,srsymtable);
@@ -1393,6 +1401,7 @@ unit raatt;
                                  if procdef_count>1 then
                                    message(asmr_w_calling_overload_func);
                                  hs:=first_procdef.mangledname;
+                                 hssymtyp:=AT_FUNCTION;
                                end;
                            typesym :
                              begin
@@ -1412,9 +1421,12 @@ unit raatt;
                       if needofs and (prevtok<>AS_DOLLAR) then
                        Message(asmr_e_need_dollar);
                       if asmsym='' then
-                       asmsym:=hs
+                        begin
+                          asmsym:=hs;
+                          asmsymtyp:=hssymtyp;
+                        end
                       else
-                       Message(asmr_e_cant_have_multiple_relocatable_symbols);
+                        Message(asmr_e_cant_have_multiple_relocatable_symbols);
                       if (expr='') or (expr[length(expr)]='+') then
                        begin
                          { don't remove the + if there could be a record field }
@@ -1469,8 +1481,9 @@ unit raatt;
       var
         l : aint;
         hs : string;
+        hssymtyp : TAsmSymType;
       begin
-        BuildConstSymbolExpression(allowref,betweenbracket,false,l,hs);
+        BuildConstSymbolExpression(allowref,betweenbracket,false,l,hs,hssymtyp);
         if hs<>'' then
          Message(asmr_e_relocatable_symbol_not_allowed);
         BuildConstExpression:=l;
@@ -1481,13 +1494,14 @@ unit raatt;
       var
         l : aint;
         tempstr : string;
+        tempsymtyp : TAsmSymType;
       begin
-        BuildConstSymbolExpression(false,false,true,l,tempstr);
+        BuildConstSymbolExpression(false,false,true,l,tempstr,tempsymtyp);
         if tempstr<>'' then
          begin
            oper.opr.typ:=OPR_SYMBOL;
            oper.opr.symofs:=l;
-           oper.opr.symbol:=objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,AT_FUNCTION);
+           oper.opr.symbol:=objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,tempsymtyp);
          end
         else
          begin
@@ -1500,7 +1514,10 @@ end.
 
 {
   $Log$
-  Revision 1.13  2004-11-08 22:09:59  peter
+  Revision 1.14  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.13  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.12  2004/06/20 08:55:30  florian

compiler/rautils.pas

@@ -100,7 +100,6 @@ type
     Function  SetupSelf:boolean;
     Function  SetupOldEBP:boolean;
     Function  SetupVar(const s:string;GetOffset : boolean): Boolean;
-    Function  SetupDirectVar(const hs:string): Boolean;
     Procedure InitRef;
   end;
   TCOperand = class of TOperand;
@@ -989,23 +988,6 @@ Begin
 end;
 
 
-{ looks for internal names of variables and routines }
-Function TOperand.SetupDirectVar(const hs:string): Boolean;
-var
-  p : tasmsymbol;
-begin
-  SetupDirectVar:=false;
-  p:=objectlibrary.getasmsymbol(hs);
-  if assigned(p) then
-   begin
-     InitRef;
-     opr.ref.symbol:=p;
-     hasvar:=true;
-     SetupDirectVar:=true;
-   end;
-end;
-
-
 procedure TOperand.InitRef;
 {*********************************************************************}
 {  Description: This routine first check if the opcode is of     }
@@ -1635,7 +1617,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.95  2004-11-09 22:32:59  peter
+  Revision 1.96  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.95  2004/11/09 22:32:59  peter
     * small m68k updates to bring it up2date
     * give better error for external local variable
 

compiler/sparc/racpugas.pas

@@ -49,7 +49,7 @@ Interface
       { helpers }
       cutils,
       { global }
-      globtype,globals,verbose,
+      globtype,verbose,
       systems,
       { aasm }
       cpubase,aasmbase,aasmtai,aasmcpu,
@@ -281,6 +281,7 @@ Interface
       var
         tempreg : tregister;
         tempstr : string;
+        tempsymtyp : TAsmSymType;
         hl : tasmlabel;
         gotplus,
         negative : boolean;
@@ -341,9 +342,9 @@ Interface
                   oper.opr.ref.refaddr:=addr_hi;
                 Consume(actasmtoken);
                 Consume(AS_LPAREN);
-                BuildConstSymbolExpression(false, true,false,l,tempstr);
+                BuildConstSymbolExpression(false, true,false,l,tempstr,tempsymtyp);
                 if not assigned(oper.opr.ref.symbol) then
-                  oper.opr.ref.symbol:=objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,AT_FUNCTION)
+                  oper.opr.ref.symbol:=objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,tempsymtyp)
                 else
                   Message(asmr_e_cant_have_multiple_relocatable_symbols);
                 case oper.opr.typ of
@@ -426,19 +427,6 @@ Interface
                             else
                              if expr = '__OLDEBP' then
                               oper.SetupOldEBP
-                            else
-                              { check for direct symbolic names   }
-                              { only if compiling the system unit }
-                              if (cs_compilesystem in aktmoduleswitches) then
-                               begin
-                                 if not oper.SetupDirectVar(expr) then
-                                  Begin
-                                    { not found, finally ... add it anyways ... }
-                                    Message1(asmr_w_id_supposed_external,expr);
-                                    oper.InitRef;
-                                    oper.opr.ref.symbol:=objectlibrary.newasmsymbol(expr,AB_EXTERNAL,AT_FUNCTION);
-                                  end;
-                               end
                             else
                               Message1(sym_e_unknown_id,expr);
                           end;
@@ -684,7 +672,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.11  2004-11-11 19:31:33  peter
+  Revision 1.12  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.11  2004/11/11 19:31:33  peter
     * fixed compile of powerpc,sparc,arm
 
   Revision 1.10  2004/06/20 08:55:32  florian

compiler/x86/rax86att.pas

@@ -507,19 +507,6 @@ Implementation
                           else
                            if expr = '__OLDEBP' then
                             oper.SetupOldEBP
-                          else
-                            { check for direct symbolic names   }
-                            { only if compiling the system unit }
-                            if (cs_compilesystem in aktmoduleswitches) then
-                             begin
-                               if not oper.SetupDirectVar(expr) then
-                                Begin
-                                  { not found, finally ... add it anyways ... }
-                                  Message1(asmr_w_id_supposed_external,expr);
-                                  oper.InitRef;
-                                  oper.opr.ref.symbol:=objectlibrary.newasmsymbol(expr,AB_EXTERNAL,AT_FUNCTION);
-                                end;
-                             end
                           else
                             Message1(sym_e_unknown_id,expr);
                         end;
@@ -788,7 +775,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.7  2004-11-08 22:09:59  peter
+  Revision 1.8  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.7  2004/11/08 22:09:59  peter
     * tvarsym splitted
 
   Revision 1.6  2004/10/31 21:45:04  peter

rtl/i386/math.inc

@@ -39,27 +39,88 @@
                        EXTENDED data type routines
  ****************************************************************************}
 
-{$ifndef INTERNCONSTINTF}
+{$ifdef INTERNCONSTINTF}
     {$define FPC_SYSTEM_HAS_PI}
-    function pi : extended;[internproc:fpc_in_pi];
+    function fpc_pi_real : ValReal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
     {$define FPC_SYSTEM_HAS_ABS}
-    function abs(d : extended) : extended;[internproc:fpc_in_abs_extended];
+    function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
     {$define FPC_SYSTEM_HAS_SQR}
-    function sqr(d : extended) : extended;[internproc:fpc_in_sqr_extended];
+    function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
     {$define FPC_SYSTEM_HAS_SQRT}
-    function sqrt(d : extended) : extended;[internproc:fpc_in_sqrt_extended];
+    function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
     {$define FPC_SYSTEM_HAS_ARCTAN}
-    function arctan(d : extended) : extended;[internproc:fpc_in_arctan_extended];
+    function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
     {$define FPC_SYSTEM_HAS_LN}
-    function ln(d : extended) : extended;[internproc:fpc_in_ln_extended];
+    function fpc_ln_real(d : ValReal) : ValReal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
     {$define FPC_SYSTEM_HAS_SIN}
-    function sin(d : extended) : extended;[internproc:fpc_in_sin_extended];
+    function fpc_sin_real(d : ValReal) : ValReal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
     {$define FPC_SYSTEM_HAS_COS}
-    function cos(d : extended) : extended;[internproc:fpc_in_cos_extended];
+    function fpc_cos_real(d : ValReal) : ValReal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+{$else}
+    {$define FPC_SYSTEM_HAS_PI}
+    function pi : ValReal;[internproc:fpc_in_pi];
+    {$define FPC_SYSTEM_HAS_ABS}
+    function abs(d : ValReal) : ValReal;[internproc:fpc_in_abs_real];
+    {$define FPC_SYSTEM_HAS_SQR}
+    function sqr(d : ValReal) : ValReal;[internproc:fpc_in_sqr_real];
+    {$define FPC_SYSTEM_HAS_SQRT}
+    function sqrt(d : ValReal) : ValReal;[internproc:fpc_in_sqrt_real];
+    {$define FPC_SYSTEM_HAS_ARCTAN}
+    function arctan(d : ValReal) : ValReal;[internproc:fpc_in_arctan_real];
+    {$define FPC_SYSTEM_HAS_LN}
+    function ln(d : ValReal) : ValReal;[internproc:fpc_in_ln_real];
+    {$define FPC_SYSTEM_HAS_SIN}
+    function sin(d : ValReal) : ValReal;[internproc:fpc_in_sin_real];
+    {$define FPC_SYSTEM_HAS_COS}
+    function cos(d : ValReal) : ValReal;[internproc:fpc_in_cos_real];
 {$endif}
 
     {$define FPC_SYSTEM_HAS_EXP}
-    function exp(d : extended) : extended;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_exp];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_exp_real(d : ValReal) : ValReal;assembler;compilerproc;
+  {$else}
+    function exp(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_exp];
+  {$endif}
        asm
             // comes from DJ GPP
             fldt        d
@@ -93,7 +154,11 @@
 
 
     {$define FPC_SYSTEM_HAS_FRAC}
-    function frac(d : extended) : extended;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_frac];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_frac_real(d : ValReal) : ValReal;assembler;compilerproc;
+  {$else}
+    function frac(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_frac];
+  {$endif}
       asm
             subl $16,%esp
             fnstcw -4(%ebp)
@@ -114,7 +179,11 @@
 
 
     {$define FPC_SYSTEM_HAS_INT}
-    function int(d : extended) : extended;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_int];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_int_real(d : ValReal) : ValReal;assembler;compilerproc;
+  {$else}
+    function int(d : ValReal) : ValReal;assembler;[internconst:fpc_in_const_int];
+  {$endif}
       asm
             subl $16,%esp
             fnstcw -4(%ebp)
@@ -133,7 +202,11 @@
 
 
     {$define FPC_SYSTEM_HAS_TRUNC}
-    function trunc(d : extended) : int64;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_trunc];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_trunc_real(d : ValReal) : int64;assembler;compilerproc;
+  {$else}
+    function trunc(d : ValReal) : int64;assembler;[internconst:fpc_in_const_trunc];
+  {$endif}
       var
         oldcw,
         newcw : word;
@@ -150,21 +223,22 @@
             fistpq res
             movl res,%eax
             movl res+4,%edx
-	    fclex
+            fclex
             fldcw oldcw
       end;
 
 
     {$define FPC_SYSTEM_HAS_ROUND}
-{$ifdef hascompilerproc}
-  {$ifndef internconstintf}
-    function round(d : extended) : int64;[internconst:fpc_in_const_round, external name 'FPC_ROUND'];
-  {$endif internconstintf}
-
-    function fpc_round(d : extended) : int64;assembler;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
-{$else}
-    function round(d : extended) : int64;assembler;[internconst:fpc_in_const_round];
-{$endif hascompilerproc}
+  {$ifdef internconstintf}
+    function fpc_round_real(d : ValReal) : int64;assembler;compilerproc;
+  {$else}
+    {$ifdef hascompilerproc}
+      function round(d : ValReal) : int64;[internconst:fpc_in_const_round, external name 'FPC_ROUND'];
+      function fpc_round(d : ValReal) : int64;assembler;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+    {$else}
+      function round(d : ValReal) : int64;assembler;[internconst:fpc_in_const_round];
+    {$endif hascompilerproc}
+  {$endif}
       var
         oldcw,
         newcw : word;
@@ -173,20 +247,20 @@
             fnstcw oldcw
             fwait
             movw $0x1372,newcw
-	    fclex
+            fclex
             fldcw newcw
             fwait
             fldt d
             fistpq res
             movl res,%eax
             movl res+4,%edx
-	    fclex
+            fclex
             fldcw oldcw
       end;
 
 
     {$define FPC_SYSTEM_HAS_POWER}
-   function power(bas,expo : extended) : extended;
+   function power(bas,expo : ValReal) : ValReal;
      begin
         if bas=0 then
           begin
@@ -214,7 +288,10 @@
 
 {
   $Log$
-  Revision 1.20  2004-11-17 22:19:04  peter
+  Revision 1.21  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.20  2004/11/17 22:19:04  peter
   internconst, internproc and some external declarations moved to interface
 
   Revision 1.19  2004/07/09 23:06:11  peter

rtl/inc/cgenmath.inc

@@ -22,8 +22,12 @@
 
 {$ifdef SUPPORT_DOUBLE}
     function c_trunc(d: double): double; cdecl; external 'c' name 'trunc';
-    
-    function int(d: double): double; {$ifdef MATHINLINE}inline;{$endif}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_int];{$endif}
+
+  {$ifdef INTERNCONSTINTF}    
+    function fpc_int_real(d: double): double;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+  {$else}  
+    function int(d: double): double; {$ifdef MATHINLINE}inline;{$endif}[internconst:fpc_in_const_int];
+  {$endif}  
     begin
       result := c_trunc(d);
     end;
@@ -33,12 +37,11 @@
 
     function c_truncf(d: real): double; cdecl; external 'c' name 'truncf';
     
-    function int(d: real): real; {$ifdef MATHINLINE}inline; dsfqsdfqs{$endif}
-    begin
-      result := c_truncf(d);
-    end;
-    
-    function int(d: real) : real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_int];{$endif}
+  {$ifdef INTERNCONSTINTF}    
+    function fpc_int_real(d: real): real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+  {$else}  
+    function int(d: real) : real;[internconst:fpc_in_const_int];
+  {$endif}
       begin
         { this will be correct since real = single in the case of }
         { the motorola version of the compiler...                 }
@@ -79,15 +82,18 @@
 
     function c_sqrt(d: double): double; cdecl; external 'c' name 'sqrt';
 
-    function sqrt(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqrt];{$endif} [public, alias: 'FPC_SQRT_REAL']; {$ifdef MATHINLINE}inline;{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_sqrt_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+  {$else}    
+    function sqrt(d:Real):Real;[internproc:fpc_in_const_sqrt];[public, alias: 'FPC_SQRT_REAL']; {$ifdef MATHINLINE}inline;{$endif}
+    {$ifdef hascompilerproc}
+      function fpc_sqrt_real(d:Real):Real;compilerproc; external name 'FPC_SQRT_REAL';
+    {$endif hascompilerproc}
+  {$endif}  
     begin
-      sqrt := c_sqrt(d);
+      result := c_sqrt(d);
     end;
 
-{$ifdef hascompilerproc}
-    function fpc_sqrt_real(d:Real):Real;compilerproc; external name 'FPC_SQRT_REAL';
-{$endif hascompilerproc}
-
 {$endif}
 
 
@@ -95,9 +101,13 @@
 {$define FPC_SYSTEM_HAS_EXP}
     function c_exp(d: double): double; cdecl; external 'c' name 'exp';
 
-    function Exp(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_exp];{$endif} {$ifdef MATHINLINE}inline;{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_Exp_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+  {$else}  
+    function Exp(d:Real):Real;[internconst:fpc_in_const_exp]; {$ifdef MATHINLINE}inline;{$endif}
+  {$endif}  
     begin
-      exp := c_exp(d);
+      result := c_exp(d);
     end;
 {$endif}
 
@@ -132,9 +142,13 @@ Not supported on Mac OS X 10.1
 
     function c_log(d: double): double; cdecl; external 'c' name 'log';
 
-    function Ln(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_ln];{$endif}{$ifdef MATHINLINE}inline;{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_Ln_real(d:Real):Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+  {$else}  
+    function Ln(d:Real):Real;[internconst:fpc_in_const_ln];{$ifdef MATHINLINE}inline;{$endif}
+  {$endif}  
     begin
-      ln := c_log(d);
+      result := c_log(d);
     end;
 {$endif}
 
@@ -143,9 +157,13 @@ Not supported on Mac OS X 10.1
 {$define FPC_SYSTEM_HAS_SIN}
     function c_sin(d: double): double; cdecl; external 'c' name 'sin';
 
-    function Sin(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sin];{$endif} {$ifdef MATHINLINE}inline;{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_Sin_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+  {$else}  
+    function Sin(d:Real):Real;[internconst:fpc_in_const_sin]; {$ifdef MATHINLINE}inline;{$endif}
+  {$endif}  
     begin
-      sin := c_sin(d);
+      result := c_sin(d);
     end;
 {$endif}
 
@@ -155,9 +173,13 @@ Not supported on Mac OS X 10.1
 {$define FPC_SYSTEM_HAS_COS}
     function c_cos(d: double): double; cdecl; external 'c' name 'cos';
 
-    function Cos(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_cos];{$endif} {$ifdef MATHINLINE}inline;{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_Cos_real(d:Real):Real;compilerproc; {$ifdef MATHINLINE}inline;{$endif}
+  {$else}  
+    function Cos(d:Real):Real;[internconst:fpc_in_const_cos];{$ifdef MATHINLINE}inline;{$endif}
+  {$endif}  
     begin
-      cos := c_cos(d);
+      result := c_cos(d);
     end;
 {$endif}
 
@@ -167,9 +189,13 @@ Not supported on Mac OS X 10.1
 {$define FPC_SYSTEM_HAS_ARCTAN}
     function c_atan(d: double): double; cdecl; external 'c' name 'atan';
 
-    function ArcTan(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_arctan];{$endif} {$ifdef MATHINLINE}inline;{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_ArcTan_real(d:Real):Real;compiler; {$ifdef MATHINLINE}inline;{$endif}
+  {$else}  
+    function ArcTan(d:Real):Real;[internconst:fpc_in_const_arctan];{$ifdef MATHINLINE}inline;{$endif}
+  {$endif}  
     begin
-      arctan := c_atan(d);
+      result := c_atan(d);
     end;
 {$endif}
 
@@ -177,7 +203,10 @@ Not supported on Mac OS X 10.1
 
 {
   $Log$
-  Revision 1.3  2004-11-20 15:49:21  jonas
+  Revision 1.4  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.3  2004/11/20 15:49:21  jonas
     * some compilation fixes for powerpc after all the internconst and
       internproc changes, still crashes with internalerror(88) for ppc1
       on real2str.inc(193,39)

rtl/inc/compproc.inc

@@ -239,7 +239,21 @@ function fpc_shl_int64(value,shift : int64) : int64; compilerproc;
 function fpc_shr_int64(value,shift : int64) : int64; compilerproc;
 {$endif  FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
 
-function fpc_round(d : Extended) : int64;compilerproc;
+{$ifdef INTERNCONSTINTF}
+function fpc_abs_real(d : ValReal) : ValReal;compilerproc;
+function fpc_arctan_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_cos_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_exp_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_frac_real(d : ValReal) : ValReal;compilerproc;
+function fpc_int_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_ln_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_pi_real : ValReal;compilerproc;
+function fpc_sin_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_sqr_real(d : ValReal) : ValReal;compilerproc;
+function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+function fpc_round_real(d : ValReal) : int64;compilerproc;
+function fpc_trunc_real(d : ValReal) : int64;compilerproc;
+{$endif INTERNCONSTINTF}
 
 function fpc_do_is(aclass : tclass;aobject : tobject) : boolean; compilerproc;
 function fpc_do_as(aclass : tclass;aobject : tobject): tobject; compilerproc;
@@ -332,7 +346,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
 
 {
   $Log$
-  Revision 1.59  2004-11-09 23:10:22  peter
+  Revision 1.60  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.59  2004/11/09 23:10:22  peter
     * use helper call to retrieve address of input/output to reduce
       code that is generated in the main program for loading the
       threadvar

rtl/inc/genmath.inc

@@ -274,7 +274,11 @@ type
     End;
 
 
-  function trunc(d : real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_trunc];{$endif}
+{$ifdef INTERNCONSTINTF}
+  function fpc_trunc_real(d : real) : int64;compilerproc;
+{$else}  
+  function trunc(d : real) : int64;[internconst:fpc_in_const_trunc];
+{$endif}  
     var
 {$ifdef cpuarm}
      l: longint;
@@ -297,15 +301,15 @@ type
          f64.high:=l;
 {$endif cpuarm}
 {$ifdef VER1_0}
-         trunc:=float64_to_int32_round_to_zero(f64);
+         result:=float64_to_int32_round_to_zero(f64);
 {$else VER1_0}
-         trunc:=float64_to_int64_round_to_zero(f64);
+         result:=float64_to_int64_round_to_zero(f64);
 {$endif VER1_0}
        end
      else
        begin
          move(d,f32,sizeof(f32));
-         trunc:=float32_to_int32_round_to_zero(f32);
+         result:=float32_to_int32_round_to_zero(f32);
        end;
     end;
 {$endif}
@@ -318,7 +322,11 @@ type
 
     { straight Pascal translation of the code for __trunc() in }
     { the file sysdeps/libm-ieee754/s_trunc.c of glibc (JM)    }
-    function int(d: double): double;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_int];{$endif}
+{$ifdef INTERNCONSTINTF}    
+    function fpc_int_real(d: double): double;compilerproc;
+{$else}    
+    function int(d: double): double;[internconst:fpc_in_const_int];
+{$endif}    
       var
         i0, j0: longint;
         i1: cardinal;
@@ -372,12 +380,15 @@ type
 
 {$else SUPPORT_DOUBLE}
 
-
-    function int(d : real) : real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_int];{$endif}
+{$ifdef INTERNCONSTINTF}
+    function fpc_int_real(d : real) : real;compilerproc;
+{$else}    
+    function int(d : real) : real;[internconst:fpc_in_const_int];
+{$endif}
       begin
         { this will be correct since real = single in the case of }
         { the motorola version of the compiler...                 }
-        int:=real(trunc(d));
+        result:=real(trunc(d));
       end;
 {$endif SUPPORT_DOUBLE}
 
@@ -388,29 +399,39 @@ type
 
 {$ifdef SUPPORT_DOUBLE}
 
+  {$ifdef INTERNCONSTINTF}
+    function fpc_abs_real(d : Double) : Double;compilerproc;
+  {$else}  
     function abs(d : Double) : Double;[public,alias:'FPC_ABS_REAL'];
+  {$endif}  
     begin
        if (d<0.0) then
-         abs := -d
+         result := -d
       else
-         abs := d ;
+         result := d ;
     end;
 
 {$else}
 
+  {$ifdef INTERNCONSTINTF}
+    function fpc_abs_real(d : Double) : Double;compilerproc;
+  {$else}  
     function abs(d : Real) : Real;[public,alias:'FPC_ABS_REAL'];
+  {$endif}  
     begin
        if (d<0.0) then
-         abs := -d
+         result := -d
       else
-         abs := d ;
+         result := d ;
     end;
 
 {$endif}
 
-{$ifdef hascompilerproc}
+{$ifndef INTERNCONSTINTF}
+  {$ifdef hascompilerproc}
     function fpc_abs_real(d:Real):Real;compilerproc; external name 'FPC_ABS_REAL';
-{$endif hascompilerproc}
+  {$endif hascompilerproc}
+{$endif}  
 
 {$endif not FPC_SYSTEM_HAS_ABS}
 
@@ -527,22 +548,37 @@ type
 
 
 {$ifndef FPC_SYSTEM_HAS_SQR}
-    function sqr(d : Real) : Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$endif}
+{$ifdef INTERNCONSTINTF}
+    function fpc_sqr_real(d : Real) : Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+{$else}    
+    function sqr(d : Real) : Real;[internconst:fpc_in_const_sqr];
+{$endif}    
     begin
-      sqr := d*d;
+      result := d*d;
     end;
 {$endif}
 
 {$ifndef FPC_SYSTEM_HAS_PI}
-    function pi : Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_pi];{$endif}
+{$ifdef INTERNCONSTINTF}
+    function fpc_pi_real : Real;compilerproc;{$ifdef MATHINLINE}inline;{$endif}
+{$else}    
+    function pi : Real;[internconst:fpc_in_const_pi];
+{$endif}    
     begin
-      pi := 3.1415926535897932385;
+      result := 3.1415926535897932385;
     end;
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_SQRT}
-    function sqrt(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqrt];{$endif} [public, alias: 'FPC_SQRT_REAL'];
+  {$ifdef INTERNCONSTINTF}
+    function fpc_sqrt_real(d:Real):Real;compilerproc;
+  {$else}    
+    {$ifdef hascompilerproc}
+       function fpc_sqrt_real(d:Real):Real;compilerproc; external name 'FPC_SQRT_REAL';
+    {$endif hascompilerproc}
+    function sqrt(d:Real):Real;[internconst:fpc_in_const_sqrt];[public, alias: 'FPC_SQRT_REAL'];
+  {$endif}  
     {*****************************************************************}
     { Square root                                                     }
     {*****************************************************************}
@@ -569,7 +605,7 @@ type
        begin
            if( d < 0.0 ) then
                HandleError(207);
-           sqrt := 0.0;
+           result := 0.0;
        end
      else
        begin
@@ -595,19 +631,19 @@ type
           d := 0.5*(d + w/d);
           d := 0.5*(d + w/d);
           d := 0.5*(d + w/d);
-          sqrt := d;
+          result := d;
        end;
     end;
 
-{$ifdef hascompilerproc}
-    function fpc_sqrt_real(d:Real):Real;compilerproc; external name 'FPC_SQRT_REAL';
-{$endif hascompilerproc}
-
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_EXP}
-    function Exp(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_exp];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_exp_real(d:Real):Real;compilerproc;
+  {$else}    
+    function Exp(d:Real):Real;[internconst:fpc_in_const_exp];
+  {$endif}  
     {*****************************************************************}
     { Exponential Function                                            }
     {*****************************************************************}
@@ -675,20 +711,23 @@ type
         d  := ldexp( d, 1 );
         d  :=  d + 1.0;
         d  := ldexp( d, n );
-        Exp := d;
+        result := d;
       end;
     end;
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_ROUND}
-{$ifdef hascompilerproc}
-    function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif} external name 'FPC_ROUND';
-
-    function fpc_round(d : Real) : int64;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
-{$else}
-    function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif}
-{$endif hascompilerproc}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_round_real(d : Real) : int64;compilerproc;
+  {$else}    
+    {$ifdef hascompilerproc}
+      function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif} external name 'FPC_ROUND';
+      function fpc_round(d : Real) : int64;[public, alias:'FPC_ROUND'];{$ifdef hascompilerproc}compilerproc;{$endif hascompilerproc}
+   {$else}
+      function round(d : Real) : int64;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_round];{$endif}
+   {$endif hascompilerproc}
+ {$endif}  
      var
       fr: Real;
       tr: Int64;
@@ -764,7 +803,11 @@ type
 
 
 {$ifndef FPC_SYSTEM_HAS_LN}
-    function Ln(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_ln];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_ln_real(d:Real):Real;compilerproc;
+  {$else}  
+    function Ln(d:Real):Real;[internconst:fpc_in_const_ln];
+  {$endif}  
     {*****************************************************************}
     { Natural Logarithm                                               }
     {*****************************************************************}
@@ -882,13 +925,17 @@ type
          z := z + y * 0.693359375;
        end;
 
-       Ln:= z;
+       result:= z;
     end;
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_SIN}
-    function Sin(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sin];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_Sin_real(d:Real):Real;compilerproc;
+  {$else}  
+    function Sin(d:Real):Real;[internconst:fpc_in_const_sin];
+  {$endif}  
     {*****************************************************************}
     { Circular Sine                                                   }
     {*****************************************************************}
@@ -926,7 +973,7 @@ type
       { above this value, approximate towards 0 }
       if( d > lossth ) then
       begin
-        sin := 0.0;
+        result := 0.0;
         exit;
       end;
 
@@ -967,14 +1014,18 @@ type
 
       if(sign < 0) then
       y := -y;
-      sin := y;
+      result := y;
     end;
 {$endif}
 
 
 
 {$ifndef FPC_SYSTEM_HAS_COS}
-    function Cos(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_cos];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_Cos_real(d:Real):Real;compilerproc;
+  {$else}  
+    function Cos(d:Real):Real;[internconst:fpc_in_const_cos];
+  {$endif}  
     {*****************************************************************}
     { Circular cosine                                                 }
     {*****************************************************************}
@@ -1011,7 +1062,7 @@ type
       { above this value, round towards zero }
       if( d > lossth ) then
       begin
-        cos := 0.0;
+        result := 0.0;
         exit;
       end;
 
@@ -1050,14 +1101,18 @@ type
       if(sign < 0) then
         y := -y;
 
-      cos := y ;
+      result := y ;
     end;
 {$endif}
 
 
 
 {$ifndef FPC_SYSTEM_HAS_ARCTAN}
-    function ArcTan(d:Real):Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_arctan];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_ArcTan_real(d:Real):Real;compilerproc;
+  {$else}  
+    function ArcTan(d:Real):Real;[internconst:fpc_in_const_arctan];
+  {$endif}
     {*****************************************************************}
     { Inverse circular tangent (arctangent)                           }
     {*****************************************************************}
@@ -1126,15 +1181,19 @@ type
 
       if( sign < 0 ) then
         y := -y;
-      Arctan := y;
+      result := y;
     end;
 {$endif}
 
 
 {$ifndef FPC_SYSTEM_HAS_FRAC}
-    function frac(d : Real) : Real;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_frac];{$endif}
+  {$ifdef INTERNCONSTINTF}
+    function fpc_frac_real(d : Real) : Real;compilerproc;
+  {$else}  
+    function frac(d : Real) : Real;[internconst:fpc_in_const_frac];
+  {$endif}  
     begin
-       frac := d - Int(d);
+       result := d - Int(d);
     end;
 {$endif}
 
@@ -1248,7 +1307,10 @@ function fpc_int64_to_double(i : int64): double; compilerproc;
 
 {
   $Log$
-  Revision 1.28  2004-11-20 15:49:21  jonas
+  Revision 1.29  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.28  2004/11/20 15:49:21  jonas
     * some compilation fixes for powerpc after all the internconst and
       internproc changes, still crashes with internalerror(88) for ppc1
       on real2str.inc(193,39)

rtl/inc/genstr.inc

@@ -13,19 +13,6 @@
 
  **********************************************************************}
 
-{$ifndef FPC_UNIT_HAS_STRLEN}
- function strlen(P : pchar) : SizeInt;
-  var
-   counter : SizeInt;
- Begin
-   counter := 0;
-   while P[counter] <> #0 do
-     Inc(counter);
-   strlen := counter;
- end;
-{$endif FPC_UNIT_HAS_STRLEN}
-
-
 {$ifndef FPC_UNIT_HAS_STREND}
  Function StrEnd(P: PChar): PChar;
  var
@@ -281,7 +268,10 @@
 
 {
   $Log$
-  Revision 1.3  2004-05-01 23:55:18  peter
+  Revision 1.4  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.3  2004/05/01 23:55:18  peter
     * replace strlenint with sizeint
 
   Revision 1.2  2003/07/07 20:22:05  peter

rtl/inc/genstrs.inc

@@ -35,14 +35,12 @@
  end;
 {$endif FPC_UNIT_HAS_STRPCOPY}
 
-{$ifndef FPC_UNIT_HAS_STRPAS}
-{ also add a strpas alias for internal use in the system unit (JM) }
-function strpas(p:pchar):string; [external name 'FPC_PCHAR_TO_SHORTSTR'];
-{$endif FPC_UNIT_HAS_STRPCOPY}
-
 {
   $Log$
-  Revision 1.1  2003-07-07 20:22:05  peter
+  Revision 1.2  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.1  2003/07/07 20:22:05  peter
     * generic string routines added
 
 }

rtl/inc/innr.inc

@@ -63,6 +63,34 @@ const
    fpc_in_leave             = 51; {macpas}
    fpc_in_cycle             = 52; {macpas}
 
+{$ifdef INTERNCONSTINTF}
+{ Internal constant functions }
+   fpc_in_const_sqr        = 100;
+   fpc_in_const_abs        = 101;
+   fpc_in_const_odd        = 102;
+   fpc_in_const_ptr        = 103;
+   fpc_in_const_swap_word  = 104;
+   fpc_in_const_swap_long  = 105;
+   fpc_in_lo_qword         = 106;
+   fpc_in_hi_qword         = 107;
+   fpc_in_const_swap_qword = 108;
+   fpc_in_prefetch_var     = 109;
+
+{ FPU functions }
+   fpc_in_trunc_real       = 120;
+   fpc_in_round_real       = 121;
+   fpc_in_frac_real        = 122;
+   fpc_in_int_real         = 123;
+   fpc_in_exp_real         = 124;
+   fpc_in_cos_real         = 125;
+   fpc_in_pi_real          = 126;
+   fpc_in_abs_real         = 127;
+   fpc_in_sqr_real         = 128;
+   fpc_in_sqrt_real        = 129;
+   fpc_in_arctan_real      = 130;
+   fpc_in_ln_real          = 131;
+   fpc_in_sin_real         = 132;
+{$else}
 { Internal constant functions }
    fpc_in_const_trunc      = 100;
    fpc_in_const_round      = 101;
@@ -83,16 +111,17 @@ const
    fpc_in_const_sin        = 116;
    fpc_in_lo_qword         = 117;
    fpc_in_hi_qword         = 118;
-   fpc_in_cos_extended     = 119;
+   fpc_in_cos_real     = 119;
    fpc_in_pi               = 121;
-   fpc_in_abs_extended     = 122;
-   fpc_in_sqr_extended     = 123;
-   fpc_in_sqrt_extended    = 124;
-   fpc_in_arctan_extended  = 125;
-   fpc_in_ln_extended      = 126;
-   fpc_in_sin_extended     = 127;
+   fpc_in_abs_real     = 122;
+   fpc_in_sqr_real     = 123;
+   fpc_in_sqrt_real    = 124;
+   fpc_in_arctan_real  = 125;
+   fpc_in_ln_real      = 126;
+   fpc_in_sin_real     = 127;
    fpc_in_const_swap_qword = 128;
-   fpc_in_prefetch_var      = 129;
+   fpc_in_prefetch_var     = 129;
+{$endif}
 
 { MMX functions }
 { these contants are used by the mmx unit }
@@ -111,7 +140,10 @@ const
 
 {
   $Log$
-  Revision 1.8  2004-11-17 22:19:04  peter
+  Revision 1.9  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.8  2004/11/17 22:19:04  peter
   internconst, internproc and some external declarations moved to interface
 
   Revision 1.7  2004/07/05 21:59:18  olle

rtl/inc/mathh.inc

@@ -46,61 +46,36 @@
 {$endif}
 
 {$ifdef internconstintf}
-  {$ifdef INTERNMATH}
-    {$define FPC_SYSTEM_HAS_PI}
-    function pi : extended;[internproc:fpc_in_pi];
-    {$define FPC_SYSTEM_HAS_ABS}
-    function abs(d : extended) : extended;[internproc:fpc_in_abs_extended];
-    {$define FPC_SYSTEM_HAS_SQR}
-    function sqr(d : extended) : extended;[internproc:fpc_in_sqr_extended];
-    {$define FPC_SYSTEM_HAS_SQRT}
-    function sqrt(d : extended) : extended;[internproc:fpc_in_sqrt_extended];
-    {$define FPC_SYSTEM_HAS_ARCTAN}
-    function arctan(d : extended) : extended;[internproc:fpc_in_sqr_extended];
-    {$define FPC_SYSTEM_HAS_LN}
-    function ln(d : extended) : extended;[internproc:fpc_in_ln_extended];
-    {$define FPC_SYSTEM_HAS_SIN}
-    function sin(d : extended) : extended;[internproc:fpc_in_sin_extended];
-    {$define FPC_SYSTEM_HAS_COS}
-    function cos(d : extended) : extended;[internproc:fpc_in_cos_extended];
-    function exp(d : extended) : extended;[internconst:fpc_in_const_exp];
-
-    function round(d : extended) : int64;[internconst:fpc_in_const_round];external name 'FPC_ROUND';
-    function frac(d : extended) : extended;[internconst:fpc_in_const_frac];
-    function int(d : extended) : extended;[internconst:fpc_in_const_int];
-    function trunc(d : extended) : int64;[internconst:fpc_in_const_trunc];
-  {$else}
-    function abs(d : extended) : extended;[internconst:fpc_in_abs_extended];
-    function arctan(d : extended) : extended;[internconst:fpc_in_arctan_extended];{$ifdef MATHINLINE}inline;{$endif}
-    function cos(d : extended) : extended;[internconst:fpc_in_sqr_extended];{$ifdef MATHINLINE}inline;{$endif}
-    function exp(d : extended) : extended;[internconst:fpc_in_const_exp];{$ifdef MATHINLINE}inline;{$endif}
-    function frac(d : extended) : extended;[internconst:fpc_in_const_frac];
-    function int(d : extended) : extended;[internconst:fpc_in_const_int];{$ifdef MATHINLINE}inline;{$endif}
-    function ln(d : extended) : extended;[internconst:fpc_in_ln_extended];{$ifdef MATHINLINE}inline;{$endif}
-    function pi : extended; [internconst:fpc_in_pi];
-    function sin(d : extended) : extended;[internconst:fpc_in_sin_extended];{$ifdef MATHINLINE}inline;{$endif}
-    function sqr(d : extended) : extended;[internconst:fpc_in_sqr_extended];
-    function sqrt(d : extended) : extended;[internconst:fpc_in_sqrt_extended];{$ifdef MATHINLINE}inline;{$endif}
-    function round(d : extended) : int64;[internconst:fpc_in_const_exp];
-    function trunc(d : extended) : int64;[internconst:fpc_in_const_trunc];
-  {$endif}
+    function pi : ValReal;[internproc:fpc_in_pi_real];
+    function abs(d : ValReal) : ValReal;[internproc:fpc_in_abs_real];
+    function sqr(d : ValReal) : ValReal;[internproc:fpc_in_sqr_real];
+    function sqrt(d : ValReal) : ValReal;[internproc:fpc_in_sqrt_real];
+    function arctan(d : ValReal) : ValReal;[internproc:fpc_in_sqr_real];
+    function ln(d : ValReal) : ValReal;[internproc:fpc_in_ln_real];
+    function sin(d : ValReal) : ValReal;[internproc:fpc_in_sin_real];
+    function cos(d : ValReal) : ValReal;[internproc:fpc_in_cos_real];
+    function exp(d : ValReal) : ValReal;[internproc:fpc_in_exp_real];
+    function round(d : ValReal) : int64;[internproc:fpc_in_round_real];
+    function frac(d : ValReal) : ValReal;[internproc:fpc_in_frac_real];
+    function int(d : ValReal) : ValReal;[internproc:fpc_in_int_real];
+    function trunc(d : ValReal) : int64;[internproc:fpc_in_trunc_real];
 {$else}
-    function abs(d : extended) : extended;
-    function arctan(d : extended) : extended;{$ifdef MATHINLINE}inline;{$endif}
-    function cos(d : extended) : extended;{$ifdef MATHINLINE}inline;{$endif}
-    function exp(d : extended) : extended;{$ifdef MATHINLINE}inline;{$endif}
-    function frac(d : extended) : extended;
-    function int(d : extended) : extended;{$ifdef MATHINLINE}inline;{$endif}
-    function ln(d : extended) : extended;{$ifdef MATHINLINE}inline;{$endif}
-    function pi : extended;
-    function sin(d : extended) : extended;{$ifdef MATHINLINE}inline;{$endif}
-    function sqr(d : extended) : extended;
-    function sqrt(d : extended) : extended;{$ifdef MATHINLINE}inline;{$endif}
-    function round(d : extended) : int64;
-    function trunc(d : extended) : int64;
+    function abs(d : ValReal) : ValReal;
+    function arctan(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+    function cos(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+    function exp(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+    function frac(d : ValReal) : ValReal;
+    function int(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+    function ln(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+    function pi : ValReal;
+    function sin(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+    function sqr(d : ValReal) : ValReal;
+    function sqrt(d : ValReal) : ValReal;{$ifdef MATHINLINE}inline;{$endif}
+    function round(d : ValReal) : int64;
+    function trunc(d : ValReal) : int64;
 {$endif internconstintf}
 
-    function power(bas,expo : extended) : extended;
+    function power(bas,expo : ValReal) : ValReal;
     function power(bas,expo : int64) : int64;
 
 {$ifdef FPC_CURRENCY_IS_INT64}
@@ -124,7 +99,10 @@
 
 {
   $Log$
-  Revision 1.18  2004-11-18 10:03:36  michael
+  Revision 1.19  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.18  2004/11/18 10:03:36  michael
   + Patch from peter to fix pasjpeg compile
 
   Revision 1.17  2004/11/17 22:19:04  peter

rtl/inc/strings.pp

@@ -17,15 +17,13 @@ unit strings;
 {$S-}
 interface
 
-    { Returns the length of a string }
-    function strlen(p : pchar) : SizeInt;
+    { Implemented in System Unit }
+    function strpas(p:pchar):shortstring;external name 'FPC_PCHAR_TO_SHORTSTR';
+    function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
 
     { Converts a Pascal string to a null-terminated string }
     function strpcopy(d : pchar;const s : string) : pchar;
 
-    { Converts a null-terminated string to a Pascal string }
-    function strpas(p : pchar) : string;
-
     { Copies source to dest, returns a pointer to dest }
     function strcopy(dest,source : pchar) : pchar;
 
@@ -148,7 +146,10 @@ end.
 
 {
   $Log$
-  Revision 1.8  2004-05-01 23:55:18  peter
+  Revision 1.9  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.8  2004/05/01 23:55:18  peter
     * replace strlenint with sizeint
 
   Revision 1.7  2004/05/01 15:26:33  jonas

rtl/objpas/sysutils/syspchh.inc

@@ -22,7 +22,7 @@
 }
 
 { shared with strings unit }
-function strlen(p : pchar) : SizeInt;
+function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
 function strcopy(dest,source : pchar) : pchar;
 function strlcopy(dest,source : pchar;maxlen : SizeInt) : pchar;
 function strecopy(dest,source : pchar) : pchar;
@@ -51,7 +51,10 @@ procedure StrDispose(Str: PChar);
 
 {
   $Log$
-  Revision 1.3  2004-05-01 23:55:18  peter
+  Revision 1.4  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.3  2004/05/01 23:55:18  peter
     * replace strlenint with sizeint
 
   Revision 1.2  2004/02/20 22:15:16  florian

rtl/powerpc/int64p.inc

@@ -125,6 +125,8 @@
 
 
 {$define FPC_SYSTEM_HAS_MOD_QWORD}
+    function int_div_qword(n,z : qword) : qword;external name 'FPC_DIV_QWORD';
+    
     function fpc_mod_qword(n,z : qword) : qword;assembler;[public,alias: 'FPC_MOD_QWORD']; {$ifdef hascompilerproc} compilerproc; {$endif}
       assembler;
       var
@@ -132,7 +134,7 @@
       asm
         mflr r0
         stw  r0,oldlr
-        bl   FPC_DIV_QWORD
+        bl   INT_DIV_QWORD
         lwz  r0,oldlr
         mtlr r0
         mr   R3,R5
@@ -198,7 +200,10 @@
 
 {
   $Log$
-  Revision 1.5  2004-10-19 18:51:15  jonas
+  Revision 1.6  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.5  2004/10/19 18:51:15  jonas
     + "nostackframe" modifier, because the automatic detection in the
       compiler to determine that a stack frame is not needed no longer works
 

rtl/powerpc/math.inc

@@ -26,7 +26,32 @@ const
                        EXTENDED data type routines
  ****************************************************************************}
 
-{$ifndef INTERNCONSTINTF}
+{$ifdef INTERNCONSTINTF}
+    {$define FPC_SYSTEM_HAS_PI}
+    function fpc_pi_real : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+    {$define FPC_SYSTEM_HAS_ABS}
+    function fpc_abs_real(d : valreal) : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+    {$define FPC_SYSTEM_HAS_SQR}
+    function fpc_sqr_real(d : valreal) : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+{$else}
     {$define FPC_SYSTEM_HAS_PI}
     function pi : double;[internproc:fpc_in_pi];
 
@@ -43,7 +68,11 @@ const
 
 {$ifndef FPC_SYSTEM_HAS_TRUNC}
     {$define FPC_SYSTEM_HAS_TRUNC}
-    function trunc(d : extended) : int64;assembler;{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_trunc];{$endif}
+    {$ifdef INTERNCONSTINTF}
+    function fpc_trunc_real(d : valreal) : int64;assembler;compilerproc;
+    {$else}
+    function trunc(d : extended) : int64;assembler;[internconst:fpc_in_const_trunc];
+    {$endif}
       { input: d in fr1      }
       { output: result in r3 }
       assembler;
@@ -320,7 +349,10 @@ end;
 
 {
   $Log$
-  Revision 1.36  2004-11-20 15:49:21  jonas
+  Revision 1.37  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.36  2004/11/20 15:49:21  jonas
     * some compilation fixes for powerpc after all the internconst and
       internproc changes, still crashes with internalerror(88) for ppc1
       on real2str.inc(193,39)

rtl/powerpc/strings.inc

@@ -200,13 +200,6 @@ end;
 {$endif FPC_UNIT_HAS_STRLCOPY}
 
 
-{$ifndef FPC_UNIT_HAS_STRLEN}
-{$define FPC_UNIT_HAS_STRLEN}
-function strlen(p : pchar) : longint;assembler;
-{$i strlen.inc}
-{$endif FPC_UNIT_HAS_STRLEN}
-
-
 {$ifndef FPC_UNIT_HAS_STREND}
 {$define FPC_UNIT_HAS_STREND}
 function strend(p : pchar) : pchar;assembler;
@@ -512,7 +505,10 @@ end;
 
 {
   $Log$
-  Revision 1.26  2004-08-17 13:34:15  olle
+  Revision 1.27  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.26  2004/08/17 13:34:15  olle
     * bugfix
 
   Revision 1.25  2004/08/09 16:43:33  jonas

rtl/powerpc/stringss.inc

@@ -16,12 +16,6 @@
 
  **********************************************************************}
 
-{$ifndef FPC_UNIT_HAS_STRPAS}
-{$define FPC_UNIT_HAS_STRPAS}
-function strpas(p : pchar) : string; assembler;
-{$i strpas.inc}
-{$endif FPC_UNIT_HAS_STRPAS}
-
 {$ifndef FPC_UNIT_HAS_STRPCOPY}
 {$define FPC_UNIT_HAS_STRPCOPY}
 function strpcopy(d : pchar;const s : string) : pchar;assembler;
@@ -47,7 +41,10 @@ end;
 
 {
   $Log$
-  Revision 1.12  2004-05-01 17:02:37  jonas
+  Revision 1.13  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.12  2004/05/01 17:02:37  jonas
     * use some more string routines from libc if FPC_USE_LIBC is used
 
   Revision 1.11  2003/11/29 16:27:19  jonas

rtl/sparc/math.inc

@@ -15,6 +15,34 @@
 
  **********************************************************************}
 
+{$ifdef INTERNCONSTINTF}
+
+    {$define FPC_SYSTEM_HAS_ABS}
+    function fpc_abs_real(d : valreal) : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+    {$define FPC_SYSTEM_HAS_SQR}
+    function fpc_sqr_real(d : valreal) : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+    {$define FPC_SYSTEM_HAS_SQRT}
+    function fpc_sqrt_real(d : valreal) : valreal;compilerproc;
+    begin
+      { Function is handled internal in the compiler }
+      runerror(207);
+      result:=0;
+    end;
+
+{$else}
+
     {$define FPC_SYSTEM_HAS_ABS}
     function abs(d : extended) : extended;[internproc:in_abs_extended];
 
@@ -24,9 +52,14 @@
     {$define FPC_SYSTEM_HAS_SQRT}
     function sqrt(d : extended) : extended;[internproc:in_sqrt_extended];
 
+{$endif}
+
 {
   $Log$
-  Revision 1.10  2004-10-03 12:41:30  florian
+  Revision 1.11  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.10  2004/10/03 12:41:30  florian
     * made sqrt, sqr and abs internal for the sparc
 
   Revision 1.9  2004/05/31 14:31:57  peter

rtl/sparc/sparc.inc

@@ -286,7 +286,7 @@ procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];
 ****************************************************************************}
 
 {$define FPC_SYSTEM_HAS_ABS_LONGINT}
-function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif}nostackframe;[internconst:in_const_abs];
+function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif}nostackframe;{$ifndef INTERNCONSTINTF}[internconst:in_const_abs];{$endif}
 asm
   sra %o0,31,%g1
   add %o0,%g1,%o0
@@ -352,7 +352,10 @@ end;
 
 {
   $Log$
-  Revision 1.14  2004-11-03 20:53:58  florian
+  Revision 1.15  2004-11-21 15:35:23  peter
+    * float routines all use internproc and compilerproc helpers
+
+  Revision 1.14  2004/11/03 20:53:58  florian
     * get_frame fixed
 
   Revision 1.13  2004/10/14 19:45:39  florian