* jmpbuf size allocation for exceptions is now cpu specific (as it should)

  * more generic nodes for maths
  * several fixes for better m68k support

compiler/i386/cpuinfo.pas

@@ -65,6 +65,11 @@ Const
 
    { target cpu string (used by compiler options) }
    target_cpu_string = 'i386';
+   { size of the buffer used for setjump/longjmp  
+     the size of this buffer is deduced from the
+     jmp_buf structure in setjumph.inc file 
+   }
+   jmp_buf_size = 24;
    
 
 Implementation
@@ -72,7 +77,12 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.12  2002-08-12 15:08:41  carl
+  Revision 1.13  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.12  2002/08/12 15:08:41  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/i386/n386flw.pas

@@ -200,7 +200,7 @@ implementation
          objectlibrary.getlabel(endexceptlabel);
          objectlibrary.getlabel(lastonlabel);
 
-         tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
+         tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
          tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
          cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
          cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
@@ -278,7 +278,7 @@ implementation
               objectlibrary.getlabel(doobjectdestroy);
               objectlibrary.getlabel(doobjectdestroyandreraise);
 
-              tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
+              tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
               tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
               cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
               cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
@@ -448,7 +448,7 @@ implementation
          objectlibrary.getlabel(doobjectdestroyandreraise);
 
          tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
-         tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
+         tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
          cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
          cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
          cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
@@ -602,7 +602,7 @@ implementation
           end;
 
          tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
-         tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
+         tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
          cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
          cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
          { Type of stack-frame must be pushed}
@@ -726,7 +726,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  2002-08-11 14:32:30  peter
+  Revision 1.33  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.32  2002/08/11 14:32:30  peter
     * renamed current_library to objectlibrary
 
   Revision 1.31  2002/08/11 13:24:17  peter

compiler/i386/n386mat.pas

@@ -36,6 +36,8 @@ interface
 
       ti386shlshrnode = class(tshlshrnode)
          procedure pass_2;override;
+         { everything will be handled in pass_2 }
+         function first_shlshr64bitint: tnode; override;
       end;
 
       ti386unaryminusnode = class(tunaryminusnode)
@@ -266,6 +268,12 @@ implementation
                              TI386SHLRSHRNODE
 *****************************************************************************}
 
+
+    function ti386shlshrnode.first_shlshr64bitint: tnode; 
+      begin
+        result := nil;
+      end;
+
     procedure ti386shlshrnode.pass_2;
       var
          hregister2,hregister3,
@@ -830,7 +838,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.38  2002-08-14 19:18:16  carl
+  Revision 1.39  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.38  2002/08/14 19:18:16  carl
     * bugfix of unaryminus node with left LOC_CREGISTER
 
   Revision 1.37  2002/08/12 15:08:42  carl

compiler/m68k/cpuinfo.pas

@@ -54,7 +54,11 @@ Const
    pointer_size  = 4;
    {# Size of a multimedia register               }
    mmreg_size = 16;
-   
+   { size of the buffer used for setjump/longjmp  
+     the size of this buffer is deduced from the
+     jmp_buf structure in setjumph.inc file 
+   }
+   jmp_buf_size = 28;
    { target cpu string (used by compiler options) }
    target_cpu_string = 'm68k';
 
@@ -63,7 +67,12 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.2  2002-08-12 15:08:44  carl
+  Revision 1.3  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.2  2002/08/12 15:08:44  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/m68k/n68kmat.pas

@@ -30,17 +30,12 @@ interface
       node,nmat;
 
     type
-      tm68kmoddivnode = class(tmoddivnode)
-         procedure pass_2;override;
-      end;
 
-      tm68kshlshrnode = class(tshlshrnode)
-         procedure pass_2;override;
-      end;
 
       tm68knotnode = class(tnotnode)
          procedure pass_2;override;
       end;
+      
 
 implementation
 
@@ -53,212 +48,6 @@ implementation
       cpubase,cpuinfo,paramgr,
       tgobj,ncgutil,cgobj,rgobj,rgcpu,cgcpu,cg64f32;
 
-{*****************************************************************************
-                             TM68kMODDIVNODE
-*****************************************************************************}
-
-    procedure tm68kmoddivnode.pass_2;
-      var
-         hreg1 : tregister;
-         hdenom,hnumerator : tregister;
-         shrdiv,popeax,popedx : boolean;
-         power : longint;
-         hl : tasmlabel;
-         pushedregs : tmaybesave;
-      begin
-         shrdiv := false;
-         secondpass(left);
-         if codegenerror then
-          exit;
-         maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
-         secondpass(right);
-         maybe_restore(exprasmlist,left.location,pushedregs);
-         if codegenerror then
-          exit;
-         location_copy(location,left.location);
-
-         if is_64bitint(resulttype.def) then
-           begin
-             { should be handled in pass_1 (JM) }
-             internalerror(200109052);
-           end
-         else
-           begin
-              { put numerator in register }
-              location_force_reg(exprasmlist,left.location,OS_INT,false);
-              hreg1:=left.location.register;
-
-              if (nodetype=divn) and
-                 (right.nodetype=ordconstn) and
-                 ispowerof2(tordconstnode(right).value,power) then
-                Begin
-                  shrdiv := true;
-                  { for signed numbers, the numerator must be adjusted before the
-                    shift instruction, but not wih unsigned numbers! Otherwise,
-                    "Cardinal($ffffffff) div 16" overflows! (JM) }
-                  If is_signed(left.resulttype.def) Then
-                    Begin
-                      objectlibrary.getlabel(hl);
-                      cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_GT,0,hreg1,hl);
-                      if power=1 then
-                          cg.a_op_const_reg(exprasmlist,OP_ADD,1,hreg1)
-                      else
-                          cg.a_op_const_reg(exprasmlist,OP_ADD,
-                             tordconstnode(right).value-1,hreg1);
-                      cg.a_label(exprasmlist,hl);    
-                      cg.a_op_const_reg(exprasmlist,OP_SAR,power,hreg1);
-                      End
-                    Else { not signed }
-                     Begin
-                      cg.a_op_const_reg(exprasmlist,OP_SHR,power,hreg1);
-                     end;
-                End
-              else
-                begin
-                  { bring denominator to hdenom }
-                  { hdenom is always free, it's }
-                  { only used for temporary }
-                  { purposes                }
-                  hdenom := rg.getregisterint(exprasmlist);
-                  if right.location.loc<>LOC_CREGISTER then
-                   location_release(exprasmlist,right.location);
-                  cg.a_load_loc_reg(exprasmlist,right.location,hdenom);
-                  if nodetype = modn then
-                    begin
-                      hnumerator := rg.getregisterint(exprasmlist);
-                      cg.a_load_reg_reg(exprasmlist,OS_INT,hreg1,hnumerator);
-                    end;
-                  
-                  { verify if the divisor is zero, if so return an error
-                    immediately
-                  }
-                  objectlibrary.getlabel(hl);
-                  cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl);
-                  cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(1));
-                  cg.a_call_name(exprasmlist,'FPC_HANDLERROR');
-                  cg.a_label(exprasmlist,hl);
-                  if is_signed(left.resulttype.def) then
-                     cg.a_op_reg_reg(exprasmlist,OP_IDIV,OS_INT,hdenom,hreg1)
-                  else
-                     cg.a_op_reg_reg(exprasmlist,OP_DIV,OS_INT,hdenom,hreg1);
-                     
-                  if nodetype = modn then
-                    begin
-{$warning modnode should be tested}                    
-                     {  I mod J = I - (I div J) * J }
-                      cg.a_op_reg_reg(exprasmlist,OP_IMUL,OS_INT,hdenom,hreg1);
-                      cg.a_op_reg_reg(exprasmlist,OP_SUB,OS_INT,hnumerator,hreg1);
-                      rg.ungetregister(exprasmlist,hnumerator);
-                    end;
-                end;
-              location_reset(location,LOC_REGISTER,OS_INT);
-              location.register:=hreg1;
-           end;
-        cg.g_overflowcheck(exprasmlist,self);
-      end;
-
-
-{*****************************************************************************
-                             TI386SHLRSHRNODE
-*****************************************************************************}
-
-    procedure tm68kshlshrnode.pass_2;
-      var
-         hcountreg : tregister;
-         op : topcg;
-         l1,l2,l3 : tasmlabel;
-         pushedregs : tmaybesave;
-         freescratch : boolean;
-      begin
-         freescratch:=false;
-         secondpass(left);
-         maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
-         secondpass(right);
-         maybe_restore(exprasmlist,left.location,pushedregs);
-         { determine operator }
-         case nodetype of
-           shln: op:=OP_SHL;
-           shrn: op:=OP_SHR;
-         end;
-         
-         if is_64bitint(left.resulttype.def) then
-           begin
-              location_reset(location,LOC_REGISTER,OS_64);
-
-              { load left operator in a register }
-              location_force_reg(exprasmlist,left.location,OS_64,false);
-              location_copy(location,left.location);
-
-              if (right.nodetype=ordconstn) then
-                begin
-                   cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
-                     joinreg64(location.registerlow,location.registerhigh));
-                end
-              else
-                begin
-                   { load right operators in a register - this  
-                     is done since most target cpu which will use this
-                     node do not support a shift count in a mem. location (cec)
-                   }
-                   
-                   if right.location.loc<>LOC_REGISTER then
-                     begin
-                       if right.location.loc<>LOC_CREGISTER then
-                        location_release(exprasmlist,right.location);
-                       hcountreg:=cg.get_scratch_reg_int(exprasmlist);
-                       cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
-                       freescratch := true;
-                     end
-                   else
-                      hcountreg:=right.location.register;
-                   cg64.a_op64_reg_reg(exprasmlist,op,hcountreg,
-                     joinreg64(location.registerlow,location.registerhigh));
-                   if freescratch then
-                      cg.free_scratch_reg(exprasmlist,hcountreg);
-                end;
-           end
-         else
-           begin
-              { load left operators in a register }
-              location_copy(location,left.location);
-              location_force_reg(exprasmlist,location,OS_INT,false);
-
-              { shifting by a constant directly coded: }
-              if (right.nodetype=ordconstn) then
-                begin
-                   { l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
-                   if right.value<=31 then
-                   }
-                   cg.a_op_const_reg(exprasmlist,op,tordconstnode(right).value and 31,
-                     location.register);
-                   {
-                   else
-                     emit_reg_reg(A_XOR,S_L,hregister1,
-                       hregister1);
-                   }
-                end
-              else
-                begin
-                   { load right operators in a register - this  
-                     is done since most target cpu which will use this
-                     node do not support a shift count in a mem. location (cec)
-                   }
-                   if right.location.loc<>LOC_REGISTER then
-                     begin
-                       if right.location.loc<>LOC_CREGISTER then
-                        location_release(exprasmlist,right.location);
-                       hcountreg:=cg.get_scratch_reg_int(exprasmlist);
-                       freescratch := true;
-                       cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
-                     end
-                   else
-                     hcountreg:=right.location.register;
-                   cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
-                   if freescratch then
-                      cg.free_scratch_reg(exprasmlist,hcountreg);
-                end;
-           end;
-      end;
 
 
 
@@ -332,14 +121,19 @@ implementation
           end;
       end;
 
+
+
 begin
-   cmoddivnode:=tm68kmoddivnode;
-   cshlshrnode:=tm68kshlshrnode;
    cnotnode:=tm68knotnode;
 end.
 {
   $Log$
-  Revision 1.2  2002-08-15 08:13:54  carl
+  Revision 1.3  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.2  2002/08/15 08:13:54  carl
     - a_load_sym_ofs_reg removed
     * loadvmt now calls loadaddr_ref_reg instead
 

compiler/nadd.pas

@@ -45,6 +45,13 @@ interface
           { only implements "muln" nodes, the rest always has to be done in }
           { the code generator for performance reasons (JM)                 }
           function first_add64bitint: tnode; virtual;
+          { This routine calls internal runtime library helpers
+            for all floating point arithmetic in the case
+            where the emulation switches is on. Otherwise
+            returns nil, and everything must be done in
+            the code generation phase.
+          }  
+          function first_addfloat : tnode; virtual;
        end;
        taddnodeclass = class of taddnode;
 
@@ -1415,6 +1422,63 @@ implementation
         right := nil;
         firstpass(result);
       end;
+      
+      
+    function taddnode.first_addfloat: tnode;
+      var
+        procname: string[31];
+        temp: tnode;
+        power: longint;
+        { do we need to reverse the result ? }
+        notnode : boolean;
+      begin
+        result := nil;
+        notnode := false;
+        { In non-emulation mode, real opcodes are
+          emitted for floating point values.
+        }  
+        if not (cs_fp_emulation in aktmoduleswitches) then
+          exit;
+          
+        procname := 'FPC_REAL_';  
+        case nodetype of
+          addn : procname := procname + 'ADD';
+          muln : procname := procname + 'MUL';
+          subn : procname := procname + 'SUB';
+          slashn : procname := procname + 'DIV';
+          ltn : procname := procname + 'LESS_THAN';
+          lten: procname := procname + 'LESS_EQUAL_THAN';
+          gtn: 
+            begin
+             procname := procname + 'LESS_EQUAL_THAN';
+             notnode := true;
+            end;
+          gten:
+            begin
+              procname := procname + 'LESS_THAN';
+              notnode := true;
+            end;
+          equaln: procname := procname + 'EQUAL';
+          unequaln : 
+            begin
+              procname := procname + 'EQUAL';
+              notnode := true;
+            end;
+          else
+            CGMessage(type_e_mismatch);
+        end;
+        { otherwise, create the parameters for the helper }
+        right := ccallparanode.create(right,ccallparanode.create(left,nil));
+        left := nil;
+        { do we need to reverse the result }
+        if notnode then
+           result := cnotnode.create(ccallnode.createintern(procname,right))
+        else
+           result := ccallnode.createintern(procname,right);
+        right := nil;
+        firstpass(result);
+      end;
+      
 
     function taddnode.pass_1 : tnode;
       var
@@ -1439,6 +1503,9 @@ implementation
          { int/int gives real/real! }
          if nodetype=slashn then
            begin
+             result := first_addfloat;
+             if assigned(result) then
+               exit;
              location.loc:=LOC_FPUREGISTER;
              { maybe we need an integer register to save }
              { a reference                               }
@@ -1616,6 +1683,9 @@ implementation
          { is one a real float ? }
          else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
             begin
+              result := first_addfloat;
+              if assigned(result) then
+                exit;
               location.loc:=LOC_FPUREGISTER;
               calcregisters(self,0,1,0);
               { an add node always first loads both the left and the    }
@@ -1744,7 +1814,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.60  2002-08-12 15:08:39  carl
+  Revision 1.61  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.60  2002/08/12 15:08:39  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/ncgflw.pas

@@ -695,7 +695,7 @@ do_jmp:
     procedure try_new_exception(list : taasmoutput;var jmpbuf,envbuf, href : treference;
       a : aword; exceptlabel : tasmlabel);
      begin
-       tg.gettempofsizereferencepersistant(list,24,jmpbuf);
+       tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,jmpbuf);
        tg.gettempofsizereferencepersistant(list,12,envbuf);
        tg.gettempofsizereferencepersistant(list,sizeof(aword),href);
        new_exception(list, jmpbuf,envbuf, href, a, exceptlabel);
@@ -1225,7 +1225,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.35  2002-08-13 18:01:52  carl
+  Revision 1.36  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.35  2002/08/13 18:01:52  carl
     * rename swatoperands to swapoperands
     + m68k first compilable version (still needs a lot of testing):
         assembler generator, system information , inline

compiler/ncgmat.pas

@@ -32,6 +32,7 @@ interface
 type
       tcgunaryminusnode = class(tunaryminusnode)
          procedure pass_2;override;
+      protected
          { This routine is called to change the sign of the 
            floating point value in the floating point 
            register r.
@@ -45,6 +46,53 @@ type
          procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual;
       end;
 
+      tcgmoddivnode = class(tmoddivnode)
+         procedure pass_2;override;
+      protected
+         { This routine must do an actual 32-bit division, be it 
+           signed or unsigned. The result must set into the the
+           @var(num) register. 
+           
+           @param(signed Indicates if the division must be signed)
+           @param(denum  Register containing the denominator
+           @param(num    Register containing the numerator, will also receive result)
+           
+           The actual optimizations regarding shifts have already
+           been done and emitted, so this should really a do a divide.
+         }  
+         procedure emit_div_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract;
+         { This routine must do an actual 32-bit modulo, be it 
+           signed or unsigned. The result must set into the the
+           @var(num) register. 
+           
+           @param(signed Indicates if the modulo must be signed)
+           @param(denum  Register containing the denominator
+           @param(num    Register containing the numerator, will also receive result)
+           
+           The actual optimizations regarding shifts have already
+           been done and emitted, so this should really a do a modulo.
+         }  
+         procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract;
+         { This routine must do an actual 64-bit division, be it 
+           signed or unsigned. The result must set into the the
+           @var(num) register. 
+           
+           @param(signed Indicates if the division must be signed)
+           @param(denum  Register containing the denominator
+           @param(num    Register containing the numerator, will also receive result)
+           
+           The actual optimizations regarding shifts have already
+           been done and emitted, so this should really a do a divide.
+           Currently, this routine should only be implemented on 
+           64-bit systems, otherwise a helper is called in 1st pass.
+         }  
+         procedure emit64_div_reg_reg(signed: boolean;denum,num : tregister64);virtual;
+      end;
+      
+      tcgshlshrnode = class(tshlshrnode)
+         procedure pass_2;override;
+      end;
+      
 
 implementation
 
@@ -55,7 +103,7 @@ implementation
       pass_1,pass_2,
       ncon,
       cpuinfo,
-      tgobj,ncgutil,cgobj,rgobj,rgcpu,cg64f32;
+      tgobj,ncgutil,cgobj,rgobj,rgcpu,paramgr,cg64f32;
 
 {*****************************************************************************
                           TCGUNARYMINUSNODE
@@ -184,14 +232,234 @@ implementation
       end;
 
 
+{*****************************************************************************
+                             TCGMODDIVNODE
+*****************************************************************************}
+
+    procedure tcgmoddivnode.emit64_div_reg_reg(signed: boolean; denum,num:tregister64);
+      begin
+        { handled in pass_1 already, unless pass_1 is 
+          overriden
+        }  
+        { should be handled in pass_1 (JM) }
+        internalerror(200109052);
+      end;
+
+
+    procedure tcgmoddivnode.pass_2;
+      var
+         hreg1 : tregister;
+         hdenom,hnumerator : tregister;
+         shrdiv,popeax,popedx : boolean;
+         power : longint;
+         hl : tasmlabel;
+         pushedregs : tmaybesave;
+      begin
+         shrdiv := false;
+         secondpass(left);
+         if codegenerror then
+          exit;
+         maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+         secondpass(right);
+         maybe_restore(exprasmlist,left.location,pushedregs);
+         if codegenerror then
+          exit;
+         location_copy(location,left.location);
+
+         if is_64bitint(resulttype.def) then
+           begin  
+             { this code valid for 64-bit cpu's only ,
+               otherwise helpers are called in pass_1
+             }  
+             location_force_reg(exprasmlist,location,OS_64,false);
+             location_copy(location,left.location);
+             location_force_reg(exprasmlist,right.location,OS_64,false);
+             emit64_div_reg_reg(is_signed(left.resulttype.def),
+               joinreg64(right.location.registerlow,right.location.registerhigh),
+               joinreg64(location.registerlow,location.registerhigh));
+           end
+         else
+           begin
+              { put numerator in register }
+              location_force_reg(exprasmlist,left.location,OS_INT,false);
+              hreg1:=left.location.register;
+
+              if (nodetype=divn) and
+                 (right.nodetype=ordconstn) and
+                 ispowerof2(tordconstnode(right).value,power) then
+                Begin
+                  shrdiv := true;
+                  { for signed numbers, the numerator must be adjusted before the
+                    shift instruction, but not wih unsigned numbers! Otherwise,
+                    "Cardinal($ffffffff) div 16" overflows! (JM) }
+                  If is_signed(left.resulttype.def) Then
+                    Begin
+                      objectlibrary.getlabel(hl);
+                      cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_GT,0,hreg1,hl);
+                      if power=1 then
+                          cg.a_op_const_reg(exprasmlist,OP_ADD,1,hreg1)
+                      else
+                          cg.a_op_const_reg(exprasmlist,OP_ADD,
+                             tordconstnode(right).value-1,hreg1);
+                      cg.a_label(exprasmlist,hl);    
+                      cg.a_op_const_reg(exprasmlist,OP_SAR,power,hreg1);
+                      End
+                    Else { not signed }
+                     Begin
+                      cg.a_op_const_reg(exprasmlist,OP_SHR,power,hreg1);
+                     end;
+                End
+              else
+                begin
+                  { bring denominator to hdenom }
+                  { hdenom is always free, it's }
+                  { only used for temporary }
+                  { purposes                }
+                  hdenom := rg.getregisterint(exprasmlist);
+                  if right.location.loc<>LOC_CREGISTER then
+                   location_release(exprasmlist,right.location);
+                  cg.a_load_loc_reg(exprasmlist,right.location,hdenom);
+                  { verify if the divisor is zero, if so return an error
+                    immediately
+                  }
+                  objectlibrary.getlabel(hl);
+                  cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl);
+                  cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(1));
+                  cg.a_call_name(exprasmlist,'FPC_HANDLERROR');
+                  cg.a_label(exprasmlist,hl);
+                  if nodetype = modn then
+                    emit_mod_reg_reg(is_signed(left.resulttype.def),hdenom,hreg1)
+                  else
+                    emit_div_reg_reg(is_signed(left.resulttype.def),hdenom,hreg1);
+                end;
+              location_reset(location,LOC_REGISTER,OS_INT);
+              location.register:=hreg1;
+           end;
+        cg.g_overflowcheck(exprasmlist,self);
+      end;
+
+
+{*****************************************************************************
+                             TCGSHLRSHRNODE
+*****************************************************************************}
+
+
+    procedure tcgshlshrnode.pass_2;
+      var
+         hcountreg : tregister;
+         op : topcg;
+         l1,l2,l3 : tasmlabel;
+         pushedregs : tmaybesave;
+         freescratch : boolean;
+      begin
+         freescratch:=false;
+         secondpass(left);
+         maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+         secondpass(right);
+         maybe_restore(exprasmlist,left.location,pushedregs);
+         { determine operator }
+         case nodetype of
+           shln: op:=OP_SHL;
+           shrn: op:=OP_SHR;
+         end;
+         
+         if is_64bitint(left.resulttype.def) then
+           begin
+              { already hanled in 1st pass }
+              internalerror(2002081501);
+(*  Normally for 64-bit cpu's this here should be here,
+    and only pass_1 need to be overriden, but dunno how to 
+    do that!
+              location_reset(location,LOC_REGISTER,OS_64);
+
+              { load left operator in a register }
+              location_force_reg(exprasmlist,left.location,OS_64,false);
+              location_copy(location,left.location);
+
+              if (right.nodetype=ordconstn) then
+                begin
+                   cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
+                     joinreg64(location.registerlow,location.registerhigh));
+                end
+              else
+                begin
+                  { this should be handled in pass_1 }
+                  internalerror(2002081501);
+                               
+                   if right.location.loc<>LOC_REGISTER then
+                     begin
+                       if right.location.loc<>LOC_CREGISTER then
+                        location_release(exprasmlist,right.location);
+                       hcountreg:=cg.get_scratch_reg_int(exprasmlist);
+                       cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
+                       freescratch := true;
+                     end
+                   else
+                      hcountreg:=right.location.register;
+                   cg64.a_op64_reg_reg(exprasmlist,op,hcountreg,
+                     joinreg64(location.registerlow,location.registerhigh));
+                   if freescratch then
+                      cg.free_scratch_reg(exprasmlist,hcountreg);
+                end;*)
+           end
+         else
+           begin
+              { load left operators in a register }
+              location_copy(location,left.location);
+              location_force_reg(exprasmlist,location,OS_INT,false);
+
+              { shifting by a constant directly coded: }
+              if (right.nodetype=ordconstn) then
+                begin
+                   { l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
+                   if right.value<=31 then
+                   }
+                   cg.a_op_const_reg(exprasmlist,op,tordconstnode(right).value and 31,
+                     location.register);
+                   {
+                   else
+                     emit_reg_reg(A_XOR,S_L,hregister1,
+                       hregister1);
+                   }
+                end
+              else
+                begin
+                   { load right operators in a register - this  
+                     is done since most target cpu which will use this
+                     node do not support a shift count in a mem. location (cec)
+                   }
+                   if right.location.loc<>LOC_REGISTER then
+                     begin
+                       if right.location.loc<>LOC_CREGISTER then
+                        location_release(exprasmlist,right.location);
+                       hcountreg:=cg.get_scratch_reg_int(exprasmlist);
+                       freescratch := true;
+                       cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
+                     end
+                   else
+                     hcountreg:=right.location.register;
+                   cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
+                   if freescratch then
+                      cg.free_scratch_reg(exprasmlist,hcountreg);
+                end;
+           end;
+      end;
+
 
 
 begin
+   cmoddivnode:=tcgmoddivnode;
    cunaryminusnode:=tcgunaryminusnode;
+   cshlshrnode:=tcgshlshrnode;
 end.
 {
   $Log$
-  Revision 1.1  2002-08-14 19:26:55  carl
+  Revision 1.2  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.1  2002/08/14 19:26:55  carl
     + generic int_to_real type conversion
     + generic unaryminus node
 

compiler/ncgutil.pas

@@ -1277,7 +1277,7 @@ implementation
               not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
             begin
               include(rg.usedinproc,accumulator);
-              tg.gettempofsizereferencepersistant(list,24,procinfo^.exception_jmp_ref);
+              tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,procinfo^.exception_jmp_ref);
               tg.gettempofsizereferencepersistant(list,12,procinfo^.exception_env_ref);
               tg.gettempofsizereferencepersistant(list,sizeof(aword),procinfo^.exception_result_ref);
               new_exception(list,procinfo^.exception_jmp_ref,
@@ -1731,7 +1731,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.36  2002-08-14 19:25:09  carl
+  Revision 1.37  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.36  2002/08/14 19:25:09  carl
     * fix Florian's last commit for m68k compilation
 
   Revision 1.35  2002/08/13 21:40:56  florian

compiler/powerpc/cpuinfo.pas

@@ -55,13 +55,24 @@ Const
    mmreg_size = 16;
    { target cpu string (used by compiler options) }
    target_cpu_string = 'powerpc';
+   { size of the buffer used for setjump/longjmp  
+     the size of this buffer is deduced from the
+     jmp_buf structure in setjumph.inc file 
+   }
+{$warning setjmp buf_size unknown!}   
+   jmp_buf_size = 0;
 
 Implementation
 
 end.
 {
   $Log$
-  Revision 1.9  2002-08-12 15:08:44  carl
+  Revision 1.10  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.9  2002/08/12 15:08:44  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/powerpc/nppcmat.pas

@@ -36,6 +36,8 @@ interface
 
       tppcshlshrnode = class(tshlshrnode)
          procedure pass_2;override;
+         { everything will be handled in pass_2 }
+         function first_shlshr64bitint: tnode; override;
       end;
 
       tppcunaryminusnode = class(tunaryminusnode)
@@ -161,6 +163,11 @@ implementation
                              TPPCSHLRSHRNODE
 *****************************************************************************}
 
+    function tppcshlshrnode.first_shlshr64bitint: tnode; 
+      begin
+        result := nil;
+      end;
+
     procedure tppcshlshrnode.pass_2;
 
       var
@@ -495,7 +502,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.16  2002-08-10 17:15:31  jonas
+  Revision 1.17  2002-08-15 15:15:55  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.16  2002/08/10 17:15:31  jonas
     * various fixes and optimizations
 
   Revision 1.15  2002/07/26 10:48:34  jonas

compiler/utils/ppudump.pp

@@ -156,7 +156,7 @@ type
     str  : string[30];
   end;
 const
-  flagopts=15;
+  flagopts=16;
   flagopt : array[1..flagopts] of tflagopt=(
     (mask: $1    ;str:'init'),
     (mask: $2    ;str:'final'),
@@ -172,7 +172,8 @@ const
     (mask: $800  ;str:'has_resources'),
     (mask: $1000  ;str:'little_endian'),
     (mask: $2000  ;str:'release'),
-    (mask: $4000  ;str:'local_threadvars')
+    (mask: $4000  ;str:'local_threadvars'),
+    (mask: $8000  ;str:'fpu emulation on')
   );
 var
   i : longint;
@@ -1823,7 +1824,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.26  2002-08-11 13:24:20  peter
+  Revision 1.27  2002-08-15 15:15:56  carl
+    * jmpbuf size allocation for exceptions is now cpu specific (as it should)
+    * more generic nodes for maths
+    * several fixes for better m68k support
+
+  Revision 1.26  2002/08/11 13:24:20  peter
     * saving of asmsymbols in ppu supported
     * asmsymbollist global is removed and moved into a new class
       tasmlibrarydata that will hold the info of a .a file which