* more fixes for the ppc

+ wrappers for the tcnvnode.first_* stuff introduced

compiler/ncginl.pas

@@ -106,7 +106,7 @@ implementation
                   second_TypeInfo;
                end;
             in_assigned_x :
-              begin
+              begin                 
                  second_Assigned;
               end;
             in_include_x_y,
@@ -583,7 +583,11 @@ end.
 
 {
   $Log$
-  Revision 1.5  2002-07-28 20:45:22  florian
+  Revision 1.6  2002-07-29 21:23:42  florian
+    * more fixes for the ppc
+    + wrappers for the tcnvnode.first_* stuff introduced
+
+  Revision 1.5  2002/07/28 20:45:22  florian
     + added direct assembler reader for PowerPC
 
   Revision 1.4  2002/07/26 09:45:20  florian
@@ -597,4 +601,4 @@ end.
 
   Revision 1.1  2002/07/24 04:07:49  carl
    + first revision (incomplete)
-}
+}

compiler/ncgutil.pas

@@ -1071,6 +1071,30 @@ implementation
       end;
 
 
+    procedure gen_exception_frame(list : taasmoutput);
+      var
+        tempbuf : treference;
+        tmpreg : tregister;
+      begin
+         include(rg.usedinproc,accumulator);
+
+         { allocate exception frame buffer }
+         { this isn't generic, several APIs doesn't }
+         { allow to change the stack pointer inside }
+         { a procedure                              }
+         { we should allocate a persistent temp.    }
+         { instead                                  }
+         cg.a_op_const_reg(list,OP_SUB,36,STACK_POINTER_REG);
+         tmpreg:=rg.getaddressregister(list);
+         cg.a_load_reg_reg(list,OS_ADDR,STACK_POINTER_REG,tmpreg);
+         reference_reset_base(tempbuf,tmpreg,0);
+         cg.g_push_exception(list,tempbuf,1,aktexitlabel);
+         reference_release(list,tempbuf);
+
+         { probably we've to reload self here }
+         cg.g_maybe_loadself(list);
+      end;
+
     procedure genentrycode(list : TAAsmoutput;
                            make_global:boolean;
                            stackframe:longint;
@@ -1080,7 +1104,6 @@ implementation
         hs : string;
         href : treference;
         p : tsymtable;
-        tempbuf : treference;
         tmpreg : tregister;
       begin
         { Insert alignment and assembler names }
@@ -1160,11 +1183,11 @@ implementation
         { for the save all registers we can simply use a pusha,popa which
           push edi,esi,ebp,esp(ignored),ebx,edx,ecx,eax }
         if (po_saveregisters in aktprocdef.procoptions) then
-         cg.g_save_all_registers(list)
+          cg.g_save_all_registers(list)
         else
          { should we save edi,esi,ebx like C ? }
          if (po_savestdregs in aktprocdef.procoptions) then
-          cg.g_save_standard_registers(list);
+           cg.g_save_standard_registers(list);
 
         { a constructor needs a help procedure }
         if (aktprocdef.proctypeoption=potype_constructor) then
@@ -1253,20 +1276,7 @@ implementation
            if ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
               { but it's useless in init/final code of units }
               not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
-            begin
+             gen_exception_frame(list);
-              include(rg.usedinproc,accumulator);
-
-              { allocate exception frame buffer }
-              cg.a_op_const_reg(list,OP_SUB,36,STACK_POINTER_REG);
-              tmpreg:=rg.getaddressregister(list);
-              cg.a_load_reg_reg(list,OS_ADDR,STACK_POINTER_REG,tmpreg);
-              reference_reset_base(tempbuf,tmpreg,0);
-              cg.g_push_exception(list,tempbuf,1,aktexitlabel);
-              reference_release(list,tempbuf);
-
-              { probably we've to reload self here }
-              cg.g_maybe_loadself(list);
-            end;
 
 {$ifdef GDB}
            if (cs_debuginfo in aktmoduleswitches) then
@@ -1628,7 +1638,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2002-07-28 15:59:57  jonas
+  Revision 1.28  2002-07-29 21:23:42  florian
+    * more fixes for the ppc
+    + wrappers for the tcnvnode.first_* stuff introduced
+
+  Revision 1.27  2002/07/28 15:59:57  jonas
     * fixed bug in location_force_reg32() when converting smaller values to
       64 bit locations
     * use cg.op_const_reg_reg() instead of a move and then cg.op_const_reg()
@@ -1762,4 +1776,4 @@ end.
   Revision 1.2  2002/03/04 19:10:11  peter
     * removed compiler warnings
 
-}
+}

compiler/ncnv.pas

@@ -81,6 +81,30 @@ interface
           function first_char_to_char : tnode;virtual;
           function first_call_helper(c : tconverttype) : tnode;
 
+          { these wrapper are necessary, because the first_* stuff is called }
+          { through a table. Without the wrappers override wouldn't have     }
+          { any effect                                                       }
+          function _first_int_to_int : tnode;
+          function _first_cstring_to_pchar : tnode;
+          function _first_string_to_chararray : tnode;
+          function _first_char_to_string : tnode;
+          function _first_nothing : tnode;
+          function _first_array_to_pointer : tnode;
+          function _first_int_to_real : tnode;
+          function _first_real_to_real : tnode;
+          function _first_pointer_to_array : tnode;
+          function _first_cchar_to_pchar : tnode;
+          function _first_bool_to_int : tnode;
+          function _first_int_to_bool : tnode;
+          function _first_bool_to_bool : tnode;
+          function _first_proc_to_procvar : tnode;
+          function _first_load_smallset : tnode;
+          function _first_cord_to_pointer : tnode;
+          function _first_ansistring_to_pchar : tnode;
+          function _first_arrayconstructor_to_set : tnode;
+          function _first_class_to_intf : tnode;
+          function _first_char_to_char : tnode;
+
           procedure second_int_to_int;virtual;abstract;
           procedure second_string_to_string;virtual;abstract;
           procedure second_cstring_to_pchar;virtual;abstract;
@@ -1485,40 +1509,139 @@ implementation
            registers32:=1;
       end;
 
+    function ttypeconvnode._first_int_to_int : tnode;
+      begin
+         result:=first_int_to_int;
+      end;
+
+    function ttypeconvnode._first_cstring_to_pchar : tnode;
+      begin
+         result:=first_cstring_to_pchar;
+      end;
+
+    function ttypeconvnode._first_string_to_chararray : tnode;
+      begin
+         result:=first_string_to_chararray;
+      end;
+
+    function ttypeconvnode._first_char_to_string : tnode;
+      begin
+         result:=first_char_to_string;
+      end;
+
+    function ttypeconvnode._first_nothing : tnode;
+      begin
+         result:=first_nothing;
+      end;
+
+    function ttypeconvnode._first_array_to_pointer : tnode;
+      begin
+         result:=first_array_to_pointer;
+      end;
+
+    function ttypeconvnode._first_int_to_real : tnode;
+      begin
+         result:=first_int_to_real;
+      end;
+
+    function ttypeconvnode._first_real_to_real : tnode;
+      begin
+         result:=first_real_to_real;
+      end;
+
+    function ttypeconvnode._first_pointer_to_array : tnode;
+      begin
+         result:=first_pointer_to_array;
+      end;
+
+    function ttypeconvnode._first_cchar_to_pchar : tnode;
+      begin
+         result:=first_cchar_to_pchar;
+      end;
+
+    function ttypeconvnode._first_bool_to_int : tnode;
+      begin
+         result:=first_bool_to_int;
+      end;
+
+    function ttypeconvnode._first_int_to_bool : tnode;
+      begin
+         result:=first_int_to_bool;
+      end;
+
+    function ttypeconvnode._first_bool_to_bool : tnode;
+      begin
+         result:=first_bool_to_bool;
+      end;
+
+    function ttypeconvnode._first_proc_to_procvar : tnode;
+      begin
+         result:=first_proc_to_procvar;
+      end;
+
+    function ttypeconvnode._first_load_smallset : tnode;
+      begin
+         result:=first_load_smallset;
+      end;
+
+    function ttypeconvnode._first_cord_to_pointer : tnode;
+      begin
+         result:=first_cord_to_pointer;
+      end;
+
+    function ttypeconvnode._first_ansistring_to_pchar : tnode;
+      begin
+         result:=first_ansistring_to_pchar;
+      end;
+
+    function ttypeconvnode._first_arrayconstructor_to_set : tnode;
+      begin
+         result:=first_arrayconstructor_to_set;
+      end;
+
+    function ttypeconvnode._first_class_to_intf : tnode;
+      begin
+         result:=first_class_to_intf;
+      end;
+
+    function ttypeconvnode._first_char_to_char : tnode;
+      begin
+         result:=first_char_to_char;
+      end;
 
     function ttypeconvnode.first_call_helper(c : tconverttype) : tnode;
 
       const
          firstconvert : array[tconverttype] of pointer = (
-           @ttypeconvnode.first_nothing, {equal}
+           @ttypeconvnode._first_nothing, {equal}
-           @ttypeconvnode.first_nothing, {not_possible}
+           @ttypeconvnode._first_nothing, {not_possible}
            nil, { removed in resulttype_string_to_string }
-           @ttypeconvnode.first_char_to_string,
+           @ttypeconvnode._first_char_to_string,
-           @ttypeconvnode.first_nothing, { char_2_chararray, needs nothing extra }
+           @ttypeconvnode._first_nothing, { char_2_chararray, needs nothing extra }
            nil, { removed in resulttype_chararray_to_string }
-           @ttypeconvnode.first_cchar_to_pchar,
+           @ttypeconvnode._first_cchar_to_pchar,
-           @ttypeconvnode.first_cstring_to_pchar,
+           @ttypeconvnode._first_cstring_to_pchar,
-           @ttypeconvnode.first_ansistring_to_pchar,
+           @ttypeconvnode._first_ansistring_to_pchar,
-           @ttypeconvnode.first_string_to_chararray,
+           @ttypeconvnode._first_string_to_chararray,
            nil, { removed in resulttype_chararray_to_string }
-           @ttypeconvnode.first_array_to_pointer,
+           @ttypeconvnode._first_array_to_pointer,
-           @ttypeconvnode.first_pointer_to_array,
+           @ttypeconvnode._first_pointer_to_array,
-           @ttypeconvnode.first_int_to_int,
+           @ttypeconvnode._first_int_to_int,
-           @ttypeconvnode.first_int_to_bool,
+           @ttypeconvnode._first_int_to_bool,
-           @ttypeconvnode.first_bool_to_bool,
+           @ttypeconvnode._first_bool_to_bool,
-           @ttypeconvnode.first_bool_to_int,
+           @ttypeconvnode._first_bool_to_int,
-           @ttypeconvnode.first_real_to_real,
+           @ttypeconvnode._first_real_to_real,
-           @ttypeconvnode.first_int_to_real,
+           @ttypeconvnode._first_int_to_real,
-           @ttypeconvnode.first_proc_to_procvar,
+           @ttypeconvnode._first_proc_to_procvar,
-           @ttypeconvnode.first_arrayconstructor_to_set,
+           @ttypeconvnode._first_arrayconstructor_to_set,
-           @ttypeconvnode.first_load_smallset,
+           @ttypeconvnode._first_load_smallset,
-           @ttypeconvnode.first_cord_to_pointer,
+           @ttypeconvnode._first_cord_to_pointer,
-           @ttypeconvnode.first_nothing,
+           @ttypeconvnode._first_nothing,
-           @ttypeconvnode.first_nothing,
+           @ttypeconvnode._first_nothing,
-           @ttypeconvnode.first_class_to_intf,
+           @ttypeconvnode._first_class_to_intf,
-           @ttypeconvnode.first_char_to_char,
+           @ttypeconvnode._first_char_to_char,
-           @ttypeconvnode.first_nothing,
+           @ttypeconvnode._first_nothing,
-           @ttypeconvnode.first_nothing
+           @ttypeconvnode._first_nothing
          );
       type
          tprocedureofobject = function : tnode of object;
@@ -1770,7 +1893,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.64  2002-07-23 12:34:30  daniel
+  Revision 1.65  2002-07-29 21:23:42  florian
+    * more fixes for the ppc
+    + wrappers for the tcnvnode.first_* stuff introduced
+
+  Revision 1.64  2002/07/23 12:34:30  daniel
   * Readded old set code. To use it define 'oldset'. Activated by default
     for ppc.
 

compiler/ninl.pas

@@ -2259,94 +2259,94 @@ implementation
       begin
         { create the call to the helper }
         first_pi := ccallnode.createintern('fpc_pi',nil);
-        { now left is nil, nothing left, so no second pass 
+        { now left is nil, nothing left, so no second pass
           required.
-        }        
+        }
         left := nil;
       end;
-      
+
-      
+
      function tinlinenode.first_arctan_real : tnode;
       begin
         { create the call to the helper }
         { on entry left node contains the parameter }
         first_arctan_real := ccallnode.createintern('fpc_arctan_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass 
+        { now left is nil, nothing left, so no second pass
           required.
-        }        
+        }
         left := nil;
       end;
-      
+
      function tinlinenode.first_abs_real : tnode;
       begin
         { create the call to the helper }
         { on entry left node contains the parameter }
         first_abs_real := ccallnode.createintern('fpc_abs_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass 
+        { now left is nil, nothing left, so no second pass
           required.
-        }        
+        }
         left := nil;
       end;
-      
+
      function tinlinenode.first_sqr_real : tnode;
       begin
         { create the call to the helper }
         { on entry left node contains the parameter }
         first_sqr_real := ccallnode.createintern('fpc_sqr_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass 
+        { now left is nil, nothing left, so no second pass
           required.
-        }        
+        }
         left := nil;
       end;
-      
+
      function tinlinenode.first_sqrt_real : tnode;
       begin
         { create the call to the helper }
         { on entry left node contains the parameter }
         first_sqrt_real := ccallnode.createintern('fpc_sqrt_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass 
+        { now left is nil, nothing left, so no second pass
           required.
-        }        
+        }
         left := nil;
       end;
-      
+
      function tinlinenode.first_ln_real : tnode;
       begin
         { create the call to the helper }
         { on entry left node contains the parameter }
         first_ln_real := ccallnode.createintern('fpc_ln_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass 
+        { now left is nil, nothing left, so no second pass
           required.
-        }        
+        }
         left := nil;
       end;
-      
+
      function tinlinenode.first_cos_real : tnode;
       begin
         { create the call to the helper }
         { on entry left node contains the parameter }
         first_cos_real := ccallnode.createintern('fpc_cos_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass 
+        { now left is nil, nothing left, so no second pass
           required.
-        }        
+        }
         left := nil;
       end;
-      
+
      function tinlinenode.first_sin_real : tnode;
       begin
         { create the call to the helper }
         { on entry left node contains the parameter }
         first_sin_real := ccallnode.createintern('fpc_sin_real',
                 ccallparanode.create(left,nil));
-        { now left is nil, nothing left, so no second pass 
+        { now left is nil, nothing left, so no second pass
           required.
-        }        
+        }
         left := nil;
       end;
 
@@ -2356,7 +2356,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.81  2002-07-26 12:28:50  jonas
+  Revision 1.82  2002-07-29 21:23:43  florian
+    * more fixes for the ppc
+    + wrappers for the tcnvnode.first_* stuff introduced
+
+  Revision 1.81  2002/07/26 12:28:50  jonas
     * don't always convert the second argument of inc/dec to a longint, but
       to a type based on the first argument
 

compiler/pdecl.pas

@@ -54,7 +54,7 @@ implementation
        { aasm }
        aasmbase,aasmtai,aasmcpu,fmodule,
        { symtable }
-       symconst,symbase,symtype,symdef,symtable,
+       symconst,symbase,symtype,symdef,symtable,paramgr,
        { pass 1 }
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
        { parser }
@@ -215,6 +215,7 @@ implementation
                        end;
                       { add default calling convention }
                       handle_calling_convention(nil,tabstractprocdef(tt.def));
+                      paramanager.create_param_loc_info(tabstractprocdef(tt.def));
                     end;
                    if not skipequal then
                     begin
@@ -472,6 +473,7 @@ implementation
                         consume(_SEMICOLON);
                        parse_var_proc_directives(tsym(newtype));
                      end;
+                    paramanager.create_param_loc_info(tabstractprocdef(tt.def));
                   end;
                 objectdef,
                 recorddef :
@@ -611,7 +613,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.48  2002-07-01 18:46:25  peter
+  Revision 1.49  2002-07-29 21:23:43  florian
+    * more fixes for the ppc
+    + wrappers for the tcnvnode.first_* stuff introduced
+
+  Revision 1.48  2002/07/01 18:46:25  peter
     * internal linker
     * reorganized aasm layer
 

compiler/pdecvar.pas

@@ -39,7 +39,7 @@ implementation
        globtype,globals,tokens,verbose,
        systems,
        { symtable }
-       symconst,symbase,symtype,symdef,symsym,symtable,defbase,fmodule,
+       symconst,symbase,symtype,symdef,symsym,symtable,defbase,fmodule,paramgr,
        { pass 1 }
        node,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
@@ -334,6 +334,7 @@ implementation
                begin
                   newtype:=ttypesym.create('unnamed',tt);
                   parse_var_proc_directives(tsym(newtype));
+                  paramanager.create_param_loc_info(tabstractprocdef(tt.def));
                   newtype.restype.def:=nil;
                   tt.def.typesym:=nil;
                   newtype.free;
@@ -583,7 +584,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2002-07-26 21:15:40  florian
+  Revision 1.30  2002-07-29 21:23:44  florian
+    * more fixes for the ppc
+    + wrappers for the tcnvnode.first_* stuff introduced
+
+  Revision 1.29  2002/07/26 21:15:40  florian
     * rewrote the system handling
 
   Revision 1.28  2002/07/20 11:57:55  florian

compiler/powerpc/cgcpu.pas

@@ -44,6 +44,7 @@ unit cgcpu;
 
 
         procedure a_call_name(list : taasmoutput;const s : string);override;
+        procedure a_call_ref(list : taasmoutput;const ref : treference);override;
 
         procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
         procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
@@ -91,6 +92,13 @@ unit cgcpu;
         { that's the case, we can use rlwinm to do an AND operation        }
         function get_rlwi_const(a: longint; var l1, l2: longint): boolean;
 
+        procedure g_push_exception(list : taasmoutput;const exceptbuf:treference;l:AWord; exceptlabel:TAsmLabel);override;
+        procedure g_pop_exception(list : taasmoutput;endexceptlabel:tasmlabel);override;
+
+        procedure g_save_standard_registers(list : taasmoutput);override;
+        procedure g_restore_standard_registers(list : taasmoutput);override;
+        procedure g_save_all_registers(list : taasmoutput);override;
+        procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
         private
 
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
@@ -201,7 +209,11 @@ const
                  internalerror(2002072801);
             end;
           else
-            internalerror(2002081103);
+            begin
+               runerror(216);
+               writeln(ord(locpara.loc));
+               internalerror(2002081103);
+            end;
         end;
         if locpara.sp_fixup<>0 then
           internalerror(2002081104);
@@ -231,15 +243,14 @@ const
   {$endif para_sizes_known}
       end;
 
-{ calling a code fragment by name }
+    { calling a code fragment by name }
-
     procedure tcgppc.a_call_name(list : taasmoutput;const s : string);
 
       var
         href : treference;
       begin
- { save our RTOC register value. Only necessary when doing pointer based    }
+         { save our RTOC register value. Only necessary when doing pointer based    }
- { calls or cross TOC calls, but currently done always                      }
+         { calls or cross TOC calls, but currently done always                      }
          reference_reset_base(href,STACK_POINTER_REG,LA_RTOC);
          list.concat(taicpu.op_reg_ref(A_STW,R_TOC,href));
          list.concat(taicpu.op_sym(A_BL,newasmsymbol(s)));
@@ -247,6 +258,12 @@ const
          list.concat(taicpu.op_reg_ref(A_LWZ,R_TOC,href));
       end;
 
+    { calling a code fragment through a reference }
+    procedure tcgppc.a_call_ref(list : taasmoutput;const ref : treference);
+      begin
+         {$warning FIX ME}
+      end;
+
 {********************** load instructions ********************}
 
      procedure tcgppc.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister);
@@ -626,6 +643,36 @@ const
         end;
 
 
+     procedure tcgppc.g_push_exception(list : taasmoutput;const exceptbuf:treference;l:AWord; exceptlabel:TAsmLabel);
+       begin
+         {$warning FIX ME}
+       end;
+
+     procedure tcgppc.g_pop_exception(list : taasmoutput;endexceptlabel:tasmlabel);
+       begin
+         {$warning FIX ME}
+       end;
+
+     procedure tcgppc.g_save_standard_registers(list : taasmoutput);
+       begin
+         {$warning FIX ME}
+       end;
+
+     procedure tcgppc.g_restore_standard_registers(list : taasmoutput);
+       begin
+         {$warning FIX ME}
+       end;
+
+     procedure tcgppc.g_save_all_registers(list : taasmoutput);
+       begin
+         {$warning FIX ME}
+       end;
+
+     procedure tcgppc.g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);
+       begin
+         {$warning FIX ME}
+       end;
+
      procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
 
        begin
@@ -1410,7 +1457,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  2002-07-28 21:38:30  florian
+  Revision 1.30  2002-07-29 21:23:44  florian
+    * more fixes for the ppc
+    + wrappers for the tcnvnode.first_* stuff introduced
+
+  Revision 1.29  2002/07/28 21:38:30  florian
     - removed debug code which was commited by accident
 
   Revision 1.28  2002/07/28 21:34:31  florian

compiler/powerpc/nppccnv.pas

@@ -85,6 +85,7 @@ implementation
               fname := 'fpc_qword_to_double';
             result := ccallnode.createintern(fname,ccallparanode.create(
               left,nil));
+            left:=nil;
             firstpass(result);
             exit;
           end
@@ -416,7 +417,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.18  2002-07-29 09:20:20  jonas
+  Revision 1.19  2002-07-29 21:23:44  florian
+    * more fixes for the ppc
+    + wrappers for the tcnvnode.first_* stuff introduced
+
+  Revision 1.18  2002/07/29 09:20:20  jonas
     + second_int_to_int implementation which is almost the same as the
       generic implementation, but it avoids some unnecessary type conversions