* Several bugfixes for m68k target (register alloc., opcode emission)

  + VIS target
  + Generic add more complete (still not verified)

compiler/compiler.pas

@@ -49,6 +49,15 @@ unit compiler;
    {$endif}
    {$endif}
 
+   {$ifdef vis}
+   {$ifndef CPUOK}
+   {$DEFINE CPUOK}
+   {$else}
+     {$fatal cannot define two CPU switches}
+   {$endif}
+   {$endif}
+
+
    {$ifdef powerpc}
    {$ifndef CPUOK}
    {$DEFINE CPUOK}
@@ -377,7 +386,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.35  2002-09-05 19:28:31  peter
+  Revision 1.36  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.35  2002/09/05 19:28:31  peter
     * removed repetitive pass counting
     * display heapsize also for extdebug
 

compiler/i386/cpubase.pas

@@ -519,6 +519,12 @@ uses
       mmregs = [R_MM0..R_MM7];
       usableregsmm = [R_MM0..R_MM7];
       c_countusableregsmm  = 8;
+      
+      maxaddrregs = 0;
+      addrregs    = [];
+      usableregsaddr = [];
+      c_countusableregsaddr = 0;
+      
 
       firstsaveintreg = R_EAX;
       lastsaveintreg  = R_EBX;
@@ -599,11 +605,11 @@ uses
   {the return_result_reg, is used inside the called function to store its return
   value when that is a scalar value otherwise a pointer to the address of the
   result is placed inside it}
-	return_result_reg		=	accumulator;
+  return_result_reg   = accumulator;
 
   {the function_result_reg contains the function result after a call to a scalar
   function othewise it contains a pointer to the returned result}
-	function_result_reg	=	accumulator;
+  function_result_reg = accumulator;
       {# Hi-Results are returned in this register (64-bit value high register) }
       accumulatorhigh = R_EDX;
       { WARNING: don't change to R_ST0!! See comments above implementation of }
@@ -714,7 +720,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.40  2003-01-13 18:37:44  daniel
+  Revision 1.41  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.40  2003/01/13 18:37:44  daniel
     * Work on register conversion
 
   Revision 1.39  2003/01/09 20:41:00  daniel

compiler/m68k/cgcpu.pas

@@ -69,6 +69,11 @@ unit cgcpu;
           procedure g_restore_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
           procedure g_save_all_registers(list : taasmoutput);override;
           procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
+          { for address register allocation }
+          function get_scratch_reg_address(list : taasmoutput) : tregister;override;
+          function get_scratch_reg_int(list : taasmoutput) : tregister; override;
+
+
      protected
          function fixref(list: taasmoutput; var ref: treference): boolean;
      private
@@ -167,6 +172,59 @@ Implementation
            end;
       end;
 
+    function tcg68k.get_scratch_reg_int(list : taasmoutput) : tregister;
+
+      var
+         r : tregister;
+         i : longint;
+
+      begin
+         if unusedscratchregisters=[] then
+           internalerror(68996);
+
+         if R_D0 in unusedscratchregisters then
+           begin
+              r.enum := R_D0;
+           end
+         else if R_D1 in unusedscratchregisters then
+           begin
+              r.enum := R_D1;
+           end
+         else
+           internalerror(10);
+
+         exclude(unusedscratchregisters,r.enum);
+         a_reg_alloc(list,r);
+         get_scratch_reg_int:=r;
+      end;
+
+
+     function tcg68k.get_scratch_reg_address(list : taasmoutput) : tregister;
+      var
+         r : tregister;
+         i : longint;
+
+      begin
+         if unusedscratchregisters=[] then
+           internalerror(68996);
+        
+         if R_A0 in unusedscratchregisters then
+           begin
+              r.enum := R_A0;
+           end
+         else if R_A1 in unusedscratchregisters then
+           begin
+              r.enum := R_A1;
+           end
+         else
+           internalerror(10);
+
+         exclude(unusedscratchregisters,r.enum);
+         a_reg_alloc(list,r);
+         get_scratch_reg_address:=r;
+      end;
+
+
 {****************************************************************************}
 {                               TCG68K                                       }
 {****************************************************************************}
@@ -242,7 +300,7 @@ Implementation
       begin
         if (rg.isaddressregister(register)) then
          begin
-           list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register))
+           list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
          end
         else
         if a = 0 then
@@ -250,9 +308,9 @@ Implementation
         else
          begin
            if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
-              list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,a,register))
+              list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
            else
-              list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register))
+              list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
          end;
       end;
 
@@ -318,6 +376,7 @@ Implementation
         { extended is not supported, since it is not available on Coldfire }
         if opsize = S_FX then
           internalerror(20020729);
+        href := ref;
         fixref(list,href);
         { in emulation mode, only 32-bit single is supported }
         if cs_fp_emulation in aktmoduleswitches then
@@ -683,8 +742,12 @@ Implementation
           OP_NEG,
           OP_NOT :
               Begin
+                { if there are two operands, move the register,
+                  since the operation will only be done on the result
+                  register.
+                }
                 if reg1.enum <> R_NO then
-                  internalerror(200112291);
+                  cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,reg1,reg2);
 
                 if (rg.isaddressregister(reg2)) then
                   begin
@@ -1124,14 +1187,10 @@ Implementation
          { zero extend }
          OS_8:
               begin
-                if (rg.isaddressregister(reg)) then
-                   internalerror(20020729);
                 list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
               end;
          OS_16:
               begin
-                if (rg.isaddressregister(reg)) then
-                   internalerror(20020729);
                 list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
               end;
         end; { otherwise the size is already correct }
@@ -1276,7 +1335,12 @@ end.
 
 {
   $Log$
-  Revision 1.15  2003-01-08 18:43:57  daniel
+  Revision 1.16  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.15  2003/01/08 18:43:57  daniel
    * Tregister changed into a record
 
   Revision 1.14  2003/01/05 13:36:53  florian

compiler/m68k/cpubase.pas

@@ -109,7 +109,8 @@ uses
          R_SPPUSH,R_SPPULL,
          { misc. }
          R_CCR,R_FP0,R_FP1,R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,
-         R_FP7,R_FPCR,R_SR,R_SSP,R_DFC,R_SFC,R_VBR,R_FPSR);
+         R_FP7,R_FPCR,R_SR,R_SSP,R_DFC,R_SFC,R_VBR,R_FPSR,
+         R_INTREGISTER,R_FLOATREGISTER);
 
       {# Set type definition for registers }
       tregisterset = set of Toldregister;
@@ -128,7 +129,22 @@ uses
       treg64 = tregister64;
 
 
-    Const
+    {New register coding:}
+
+    {Special registers:}
+    const
+      NR_NO = $0000;  {Invalid register}
+
+    {Normal registers:}
+
+    {General purpose registers:}
+      NR_D0 = $0100; NR_D1 = $0200; NR_D2 = $0300;
+      NR_D3 = $0400; NR_D4 = $0500; NR_D5 = $0600;
+      NR_D6 = $0700; NR_D7 = $0800; NR_A0 = $0900;
+      NR_A1 = $0A00; NR_A2 = $0B00; NR_A3 = $0C00;
+      NR_A4 = $0D00; NR_A5 = $0E00; NR_A6 = $0F00;
+      NR_A7 = $1000; 
+
       {# First register in the tregister enumeration }
       firstreg = low(Toldregister);
       {# Last register in the tregister enumeration }
@@ -442,8 +458,8 @@ uses
       {# Registers which are defined as scratch integer and no need to save across
          routine calls or in assembler blocks.
       }
-      max_scratch_regs = 2;
-      scratch_regs: Array[1..max_scratch_regs] of Toldregister = (R_D0,R_D1);
+      max_scratch_regs = 4;
+      scratch_regs: Array[1..max_scratch_regs] of Toldregister = (R_D0,R_D1,R_A0,R_A1);
 
 {*****************************************************************************
                           Default generic sizes
@@ -600,14 +616,39 @@ implementation
     procedure convert_register_to_enum(var r:Tregister);
 
     begin
-      {$warning Convert_register_to_enum implementation is missing!}
-      internalerror(200301082);
+      if r.enum = R_INTREGISTER then
+        case r.number of
+          NR_NO: r.enum:= R_NO;
+          NR_D0: r.enum:= R_D0;
+          NR_D1: r.enum:= R_D1;
+          NR_D2: r.enum:= R_D2;
+          NR_D3: r.enum:= R_D3;
+          NR_D4: r.enum:= R_D4;
+          NR_D5: r.enum:= R_D5;
+          NR_D6: r.enum:= R_D6;
+          NR_D7: r.enum:= R_D7;
+          NR_A0: r.enum:= R_A0;
+          NR_A1: r.enum:= R_A1;
+          NR_A2: r.enum:= R_A2;
+          NR_A3: r.enum:= R_A3;
+          NR_A4: r.enum:= R_A4;
+          NR_A5: r.enum:= R_A5;
+          NR_A6: r.enum:= R_A6;
+          NR_A7: r.enum:= R_SP;
+        else
+          internalerror(200301082);
+        end;
     end;
 
 end.
 {
   $Log$
-  Revision 1.16  2003-01-09 15:49:56  daniel
+  Revision 1.17  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.16  2003/01/09 15:49:56  daniel
     * Added register conversion
 
   Revision 1.15  2003/01/08 18:43:57  daniel

compiler/m68k/cpunode.pas

@@ -30,12 +30,12 @@ unit cpunode;
 
     uses
        { generic nodes }
-       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgmat,ncgadd
+       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgmat,ncgadd,
        { to be able to only parts of the generic code,
          the processor specific nodes must be included
          after the generic one (FK)
        }
-//       nm68kadd,
+         ncpuadd,
 //       nppccal,
 //       nppccon,
 //       nppcflw,
@@ -46,13 +46,19 @@ unit cpunode;
        { this not really a node }
 //       nppcobj,
 //       nppcmat,
-         ,n68kcnv
+         n68kmat,
+         n68kcnv
        ;
 
 end.
 {
   $Log$
-  Revision 1.3  2002-12-14 15:02:03  carl
+  Revision 1.4  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.3  2002/12/14 15:02:03  carl
     * maxoperands -> max_operands (for portability in rautils.pas)
     * fix some range-check errors with loadconst
     + add ncgadd unit to m68k

compiler/m68k/cpupara.pas

@@ -47,19 +47,51 @@ unit cpupara;
   implementation
 
     uses
-       verbose;
+       verbose,
+       globals,
+       globtype,
+       systems,
+       cpuinfo,cginfo,cgbase,
+       defutil;
 
     function tm68kparamanager.getintparaloc(nr : longint) : tparalocation;
       begin
          fillchar(result,sizeof(tparalocation),0);
+         if nr<1 then
+           internalerror(2002070801)
+         else
+           begin
+              { warning : THIS ONLY WORKS WITH INTERNAL ROUTINES,
+                WHICH MUST ALWAYS PASS 4-BYTE PARAMETERS!!
+              }
+              result.loc:=LOC_REFERENCE;
+              result.reference.index.enum:=frame_pointer_reg;
+              result.reference.offset:=target_info.first_parm_offset
+                  +nr*4;
+           end;
       end;
 
     procedure tm68kparamanager.create_param_loc_info(p : tabstractprocdef);
+      var
+        param_offset : integer;  
+        hp : tparaitem;
       begin
-         { set default para_alignment to target_info.stackalignment }
-         { if para_alignment=0 then
-           para_alignment:=aktalignment.paraalign;
-         }
+         { frame pointer for nested procedures? }
+         { inc(nextintreg);                     }
+         { constructor? }
+         { destructor? }
+         param_offset := target_info.first_parm_offset;    
+         hp:=tparaitem(p.para.last);
+         while assigned(hp) do
+           begin
+              hp.paraloc.loc:=LOC_REFERENCE;
+              hp.paraloc.sp_fixup:=0;
+              hp.paraloc.reference.index.enum:=frame_pointer_reg;
+              hp.paraloc.reference.offset:=param_offset;
+              inc(param_offset,aktalignment.paraalign);  
+              hp.paraloc.size := def_cgsize(hp.paratype.def);
+              hp:=tparaitem(hp.previous);
+           end;
       end;
 
     function tm68kparamanager.getselflocation(p : tabstractprocdef) : tparalocation;
@@ -75,7 +107,12 @@ end.
 
 {
   $Log$
-  Revision 1.3  2003-01-08 18:43:57  daniel
+  Revision 1.4  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.3  2003/01/08 18:43:57  daniel
    * Tregister changed into a record
 
   Revision 1.2  2002/12/14 15:02:03  carl

compiler/m68k/cputarg.pas

@@ -37,7 +37,7 @@ implementation
 **************************************}
 
     {$ifndef NOTARGETLINUX}
-      ,t_linux
+      ,t_linux,t_amiga
     {$endif}
 
 {**************************************
@@ -50,7 +50,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2002-08-13 18:01:52  carl
+  Revision 1.2  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.1  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/m68k/n68kmat.pas

@@ -27,7 +27,7 @@ unit n68kmat;
 interface
 
     uses
-      node,nmat;
+      node,nmat,ncgmat,cpubase,cginfo;
 
     type
 
@@ -36,16 +36,22 @@ interface
          procedure pass_2;override;
       end;
 
+      tm68kmoddivnode = class(tcgmoddivnode)
+         procedure emit_div_reg_reg(signed: boolean;denum,num : tregister);override;
+         procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);override;
+      end;  
+
+
 
 implementation
 
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
-      cginfo,cgbase,pass_1,pass_2,
+      symconst,symdef,aasmbase,aasmtai,aasmcpu,
+      cgbase,pass_1,pass_2,
       ncon,
-      cpubase,cpuinfo,paramgr,
+      cpuinfo,paramgr,defutil,
       tgobj,ncgutil,cgobj,rgobj,rgcpu,cgcpu,cg64f32;
 
 
@@ -114,21 +120,134 @@ implementation
            end
          else
           begin
-            secondpass(left);
-            location_copy(location,left.location);
-            location_force_reg(exprasmlist,location,opsize,false);
-            cg.a_op_reg_reg(exprasmlist,OP_NOT,opsize,location.register,location.register);
+             secondpass(left);
+             location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false);
+             location_copy(location,left.location);
+             if location.loc=LOC_CREGISTER then
+              location.register := rg.getregisterint(exprasmlist);
+             { perform the NOT operation }
+             cg.a_op_reg_reg(exprasmlist,OP_NOT,opsize,location.register,left.location.register);
           end;
       end;
 
 
+{*****************************************************************************
+                               TM68KMODDIVNODE
+*****************************************************************************}
+  procedure tm68kmoddivnode.emit_div_reg_reg(signed: boolean;denum,num : tregister);
+   var
+     continuelabel : tasmlabel;  
+     reg_d0,reg_d1 : tregister;
+   begin
+     { no RTL call, so inline a zero denominator verification }   
+     if aktoptprocessor <> MC68000 then
+       begin 
+         { verify if denominator is zero }
+         objectlibrary.getlabel(continuelabel);
+         { compare against zero, if not zero continue }
+         cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
+         cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(1));
+         cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
+         cg.a_label(exprasmlist, continuelabel);
+         if signed then 
+            exprasmlist.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num))
+         else
+            exprasmlist.concat(taicpu.op_reg_reg(A_DIVU,S_L,denum,num));
+         { result should be in denuminator }
+         cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,num,denum);   
+       end
+     else
+       begin
+         { On MC68000/68010 mw must pass through RTL routines }
+         reg_d0:=rg.getexplicitregisterint(exprasmlist,R_D0);
+         reg_d1:=rg.getexplicitregisterint(exprasmlist,R_D1);
+         { put numerator in d0 }
+         cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,num,reg_d0);   
+         { put denum in D1 }
+         cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,denum,reg_d1);   
+         if signed then 
+             cg.a_call_name(exprasmlist,'FPC_DIV_LONGINT')
+         else
+             cg.a_call_name(exprasmlist,'FPC_DIV_CARDINAL');
+        cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,reg_d0,denum);   
+        rg.ungetregisterint(exprasmlist,reg_d0);
+        rg.ungetregisterint(exprasmlist,reg_d1);
+       end;
+   end;
+     
+  procedure tm68kmoddivnode.emit_mod_reg_reg(signed: boolean;denum,num : tregister);
+      var tmpreg : tregister;
+          continuelabel : tasmlabel;  
+          signlabel : tasmlabel;
+          reg_d0,reg_d1 : tregister;
+    begin
+     { no RTL call, so inline a zero denominator verification }   
+     if aktoptprocessor <> MC68000 then
+       begin 
+         { verify if denominator is zero }
+         objectlibrary.getlabel(continuelabel);
+         { compare against zero, if not zero continue }
+         cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel);
+         cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(1));
+         cg.a_call_name(exprasmlist,'FPC_HANDLEERROR');
+         cg.a_label(exprasmlist, continuelabel);
+
+         tmpreg := cg.get_scratch_reg_int(exprasmlist);       
+
+         { we have to prepare the high register with the  }
+         { correct sign. i.e we clear it, check if the low dword reg }
+         { which will participate in the division is signed, if so we}
+         { we extend the sign to the high doword register by inverting }
+         { all the bits.                                             }
+         exprasmlist.concat(taicpu.op_reg(A_CLR,S_L,tmpreg));
+         objectlibrary.getlabel(signlabel);
+         exprasmlist.concat(taicpu.op_reg(A_TST,S_L,tmpreg));
+         cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_A,0,tmpreg,signlabel);
+         { its a negative value, therefore change sign }
+         cg.a_label(exprasmlist,signlabel);
+         { tmpreg:num / denum }
+
+         if signed then
+           exprasmlist.concat(taicpu.op_reg_reg_reg(A_DIVSL,S_L,denum,tmpreg,num))
+         else
+           exprasmlist.concat(taicpu.op_reg_reg_reg(A_DIVUL,S_L,denum,tmpreg,num));
+         { remainder in tmpreg }
+         cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,tmpreg,denum);
+         cg.free_scratch_reg(exprasmlist,tmpreg);   
+       end
+     else
+       begin
+         { On MC68000/68010 mw must pass through RTL routines }
+         Reg_d0:=rg.getexplicitregisterint(exprasmlist,R_D0);
+         Reg_d1:=rg.getexplicitregisterint(exprasmlist,R_D1);
+         { put numerator in d0 }
+         cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,num,Reg_D0);   
+         { put denum in D1 }
+         cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,denum,Reg_D1);   
+         if signed then 
+             cg.a_call_name(exprasmlist,'FPC_MOD_LONGINT')
+         else
+             cg.a_call_name(exprasmlist,'FPC_MOD_CARDINAL');
+        cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,Reg_D0,denum);   
+        rg.ungetregisterint(exprasmlist,Reg_D0);
+        rg.ungetregisterint(exprasmlist,Reg_D1);
+       end;
+    end;
+
+
 
 begin
    cnotnode:=tm68knotnode;
+   cmoddivnode:=tm68kmoddivnode;
 end.
 {
   $Log$
-  Revision 1.4  2002-09-07 15:25:13  peter
+  Revision 1.5  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.4  2002/09/07 15:25:13  peter
     * old logs removed and tabs fixed
 
   Revision 1.3  2002/08/15 15:15:55  carl

compiler/m68k/ncpuadd.pas

@@ -0,0 +1,440 @@
+{
+    $Id$
+    Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe
+
+    Code generation for add nodes on the Motorola 680x0 family
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit ncpuadd;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       node,nadd,ncgadd,cpubase,cginfo;
+
+
+    type
+       t68kaddnode = class(tcgaddnode)
+          procedure second_cmpordinal;override;
+          procedure second_cmpsmallset;override;
+          procedure second_cmp64bit;override;
+          procedure second_cmpboolean;override;
+       private
+          function getresflags(unsigned: boolean) : tresflags; 
+       end; 
+
+
+implementation
+
+    uses
+      globtype,systems,
+      cutils,verbose,globals,
+      symconst,symdef,paramgr,
+      aasmbase,aasmtai,aasmcpu,defutil,htypechk,
+      cgbase,cpuinfo,pass_1,pass_2,regvars,
+      cpupara,
+      ncon,nset,
+      ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+
+    function t68kaddnode.getresflags(unsigned : boolean) : tresflags;
+      begin
+         case nodetype of
+           equaln : getresflags:=F_E;
+           unequaln : getresflags:=F_NE;
+          else
+           if not(unsigned) then
+             begin
+                if nf_swaped in flags then
+                  case nodetype of
+                     ltn : getresflags:=F_G;
+                     lten : getresflags:=F_GE;
+                     gtn : getresflags:=F_L;
+                     gten : getresflags:=F_LE;
+                  end
+                else
+                  case nodetype of
+                     ltn : getresflags:=F_L;
+                     lten : getresflags:=F_LE;
+                     gtn : getresflags:=F_G;
+                     gten : getresflags:=F_GE;
+                  end;
+             end
+           else
+             begin
+                if nf_swaped in flags then
+                  case nodetype of
+                     ltn : getresflags:=F_A;
+                     lten : getresflags:=F_AE;
+                     gtn : getresflags:=F_B;
+                     gten : getresflags:=F_BE;
+                  end
+                else
+                  case nodetype of
+                     ltn : getresflags:=F_B;
+                     lten : getresflags:=F_BE;
+                     gtn : getresflags:=F_A;
+                     gten : getresflags:=F_AE;
+                  end;
+             end;
+         end;
+      end;
+
+{*****************************************************************************
+                                Smallsets
+*****************************************************************************}
+
+    procedure t68kaddnode.second_cmpsmallset;
+     var
+      tmpreg : tregister;
+     begin
+       location_reset(location,LOC_FLAGS,OS_NO);
+          
+       case nodetype of
+          equaln,
+          unequaln :
+            begin
+              {emit_compare(true);}
+            end;
+          lten,gten:
+            begin
+              If (not(nf_swaped in flags) and
+                  (nodetype = lten)) or
+                 ((nf_swaped in flags) and
+                  (nodetype = gten)) then
+                swapleftright;
+              // now we have to check whether left >= right
+              tmpreg := cg.get_scratch_reg_int(exprasmlist);
+              if left.location.loc = LOC_CONSTANT then
+                begin
+                  cg.a_op_const_reg_reg(exprasmlist,OP_AND,OS_INT,
+                    not(left.location.value),right.location.register,tmpreg);
+                  exprasmlist.concat(taicpu.op_reg(A_TST,S_L,tmpreg));
+                  // the two instructions above should be folded together by
+                  // the peepholeoptimizer
+                end
+              else
+                begin
+                  if right.location.loc = LOC_CONSTANT then
+                    begin
+                      cg.a_load_const_reg(exprasmlist,OS_INT,
+                        aword(right.location.value),tmpreg);
+                      exprasmlist.concat(taicpu.op_reg_reg(A_AND,S_L,
+                        tmpreg,left.location.register));
+                    end
+                  else
+                    exprasmlist.concat(taicpu.op_reg_reg(A_AND,S_L,
+                      right.location.register,left.location.register));
+                end;
+              cg.free_scratch_reg(exprasmlist,tmpreg);
+              location.resflags := getresflags(true);
+            end;
+          else
+            internalerror(2002072701);
+        end;
+          
+          
+     end;
+
+
+{*****************************************************************************
+                                Ordinals
+*****************************************************************************}
+
+    procedure t68kaddnode.second_cmpordinal;
+     var
+      unsigned : boolean;
+      useconst : boolean;
+      tmpreg : tregister;
+      op : tasmop;
+     begin
+       { set result location }
+       location_reset(location,LOC_JUMP,OS_NO);
+
+       { load values into registers (except constants) }
+       load_left_right(true, false);
+
+       { determine if the comparison will be unsigned }
+       unsigned:=not(is_signed(left.resulttype.def)) or
+                   not(is_signed(right.resulttype.def));
+
+        // get the constant on the right if there is one
+        if (left.location.loc = LOC_CONSTANT) then
+          swapleftright;
+        // can we use an immediate, or do we have to load the
+        // constant in a register first?
+        if (right.location.loc = LOC_CONSTANT) then
+          begin
+{$ifdef extdebug}
+            if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.valueqword)<>0) and ((hi(right.location.valueqword)<>-1) or unsigned) then
+              internalerror(2002080301);
+{$endif extdebug}
+            if (nodetype in [equaln,unequaln]) then
+              if (unsigned and
+                  (right.location.value > high(word))) or
+                 (not unsigned and
+                  (longint(right.location.value) < low(smallint)) or
+                   (longint(right.location.value) > high(smallint))) then
+                { we can then maybe use a constant in the 'othersigned' case
+                 (the sign doesn't matter for // equal/unequal)}
+                unsigned := not unsigned;
+
+            if (unsigned and
+                ((right.location.value) <= high(word))) or
+               (not(unsigned) and
+                (longint(right.location.value) >= low(smallint)) and
+                (longint(right.location.value) <= high(smallint))) then
+               useconst := true
+            else
+              begin
+                useconst := false;
+                tmpreg := cg.get_scratch_reg_int(exprasmlist);
+                cg.a_load_const_reg(exprasmlist,OS_INT,
+                  aword(right.location.value),tmpreg);
+               end
+          end
+        else
+          useconst := false;
+        location.loc := LOC_FLAGS;
+        location.resflags := getresflags(unsigned);
+        op := A_CMP;
+        if (right.location.loc = LOC_CONSTANT) then
+          if useconst then
+            exprasmlist.concat(taicpu.op_reg_const(op,S_L,
+              left.location.register,longint(right.location.value)))
+          else
+            begin
+              exprasmlist.concat(taicpu.op_reg_reg(op,S_L,
+                left.location.register,tmpreg));
+              cg.free_scratch_reg(exprasmlist,tmpreg);
+            end
+        else
+          exprasmlist.concat(taicpu.op_reg_reg(op,S_L,
+            left.location.register,right.location.register));
+     end;
+
+{*****************************************************************************
+                                Boolean
+*****************************************************************************}
+
+    procedure t68kaddnode.second_cmpboolean;
+      var
+        cgop      : TOpCg;
+        cgsize  : TCgSize;
+        isjump  : boolean;
+        otl,ofl : tasmlabel;
+        pushedregs : tmaybesave;
+       begin
+        if (torddef(left.resulttype.def).typ=bool8bit) or
+           (torddef(right.resulttype.def).typ=bool8bit) then
+         cgsize:=OS_8
+        else
+          if (torddef(left.resulttype.def).typ=bool16bit) or
+             (torddef(right.resulttype.def).typ=bool16bit) then
+           cgsize:=OS_16
+        else
+           cgsize:=OS_32;
+
+        if (cs_full_boolean_eval in aktlocalswitches) or
+           (nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then
+          begin
+            if left.nodetype in [ordconstn,realconstn] then
+             swapleftright;
+
+            isjump:=(left.location.loc=LOC_JUMP);
+            if isjump then
+              begin
+                 otl:=truelabel;
+                 objectlibrary.getlabel(truelabel);
+                 ofl:=falselabel;
+                 objectlibrary.getlabel(falselabel);
+              end;
+            secondpass(left);
+            if left.location.loc in [LOC_FLAGS,LOC_JUMP] then
+             location_force_reg(exprasmlist,left.location,cgsize,false);
+            if isjump then
+             begin
+               truelabel:=otl;
+               falselabel:=ofl;
+             end;
+
+            maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
+            isjump:=(right.location.loc=LOC_JUMP);
+            if isjump then
+              begin
+                 otl:=truelabel;
+                 objectlibrary.getlabel(truelabel);
+                 ofl:=falselabel;
+                 objectlibrary.getlabel(falselabel);
+              end;
+            secondpass(right);
+            maybe_restore(exprasmlist,left.location,pushedregs);
+            if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
+             location_force_reg(exprasmlist,right.location,cgsize,false);
+            if isjump then
+             begin
+               truelabel:=otl;
+               falselabel:=ofl;
+             end;
+
+         location_reset(location,LOC_FLAGS,OS_NO);
+
+         load_left_right(true,false);
+
+            if (left.location.loc = LOC_CONSTANT) then
+              swapleftright;
+        
+         if (right.location.loc <> LOC_CONSTANT) then
+                exprasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,
+                   left.location.register,right.location.register))
+         else
+                exprasmlist.concat(taicpu.op_const_reg(A_CMP,S_L,
+                   longint(right.location.value),left.location.register));
+         location.resflags := getresflags(true);
+        
+        end;
+
+        clear_left_right(true);
+
+       end; 
+
+
+
+{*****************************************************************************
+                                64-bit
+*****************************************************************************}
+
+    procedure t68kaddnode.second_cmp64bit;
+     begin
+(*        load_left_right(true,false);
+
+        case nodetype of  
+          ltn,lten,
+          gtn,gten:
+           begin
+             emit_cmp64_hi;
+             firstjmp64bitcmp;
+             emit_cmp64_lo;
+             secondjmp64bitcmp;
+           end;
+          equaln,unequaln:
+           begin
+             // instead of doing a complicated compare, do
+             // (left.hi xor right.hi) or (left.lo xor right.lo)
+             // (somewhate optimized so that no superfluous 'mr's are
+             //  generated)
+                  if (left.location.loc = LOC_CONSTANT) then
+                    swapleftright;
+                  if (right.location.loc = LOC_CONSTANT) then
+                    begin
+                      if left.location.loc = LOC_REGISTER then
+                        begin
+                          tempreg64.reglo := left.location.registerlow;
+                          tempreg64.reghi := left.location.registerhigh;
+                        end
+                      else
+                        begin
+                          if (aword(right.location.valueqword) <> 0) then
+                            tempreg64.reglo := cg.get_scratch_reg_int(exprasmlist)
+                          else
+                            tempreg64.reglo := left.location.registerlow;
+                          if ((right.location.valueqword shr 32) <> 0) then
+                            tempreg64.reghi := cg.get_scratch_reg_int(exprasmlist)
+                          else
+                            tempreg64.reghi := left.location.registerhigh;
+                        end;
+
+                      if (aword(right.location.valueqword) <> 0) then
+                        { negative values can be handled using SUB, }
+                        { positive values < 65535 using XOR.        }
+                        if (longint(right.location.valueqword) >= -32767) and
+                           (longint(right.location.valueqword) < 0) then
+                          cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
+                            aword(right.location.valueqword),
+                            left.location.registerlow,tempreg64.reglo)
+                        else
+                          cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
+                            aword(right.location.valueqword),
+                            left.location.registerlow,tempreg64.reglo);
+
+                      if ((right.location.valueqword shr 32) <> 0) then
+                        if (longint(right.location.valueqword shr 32) >= -32767) and
+                           (longint(right.location.valueqword shr 32) < 0) then
+                          cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
+                            aword(right.location.valueqword shr 32),
+                            left.location.registerhigh,tempreg64.reghi)
+                        else
+                          cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
+                            aword(right.location.valueqword shr 32),
+                            left.location.registerhigh,tempreg64.reghi);
+                    end
+                  else
+                    begin
+                       tempreg64.reglo := cg.get_scratch_reg_int(exprasmlist);
+                       tempreg64.reghi := cg.get_scratch_reg_int(exprasmlist);
+                       cg64.a_op64_reg_reg_reg(exprasmlist,OP_XOR,
+                         left.location.register64,right.location.register64,
+                         tempreg64);
+                    end;
+
+                  cg.a_reg_alloc(exprasmlist,R_0);
+                  exprasmlist.concat(taicpu.op_reg_reg_reg(A_OR_,R_0,
+                    tempreg64.reglo,tempreg64.reghi));
+                  cg.a_reg_dealloc(exprasmlist,R_0);
+                  if (tempreg64.reglo <> left.location.registerlow) then
+                    cg.free_scratch_reg(exprasmlist,tempreg64.reglo);
+                  if (tempreg64.reghi <> left.location.registerhigh) then
+                    cg.free_scratch_reg(exprasmlist,tempreg64.reghi);
+
+                  location_reset(location,LOC_FLAGS,OS_NO);
+                  location.resflags := getresflags;
+                end;
+              else
+                internalerror(2002072803);
+            end;
+
+
+        { set result location }
+        { (emit_compare sets it to LOC_FLAGS for compares, so set the }
+        {  real location only now) (JM)                               }
+        if cmpop and
+           not(nodetype in [equaln,unequaln]) then
+          location_reset(location,LOC_JUMP,OS_NO);
+*)
+       location_reset(location,LOC_JUMP,OS_NO);
+     end;
+
+
+begin
+   caddnode:=t68kaddnode;
+end.
+
+{
+  $Log$
+  Revision 1.1  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+}

compiler/m68k/rgcpu.pas

@@ -38,6 +38,10 @@ unit rgcpu;
           unusedregsaddr,usableregsaddr : tregisterset;
           countunusedregsaddr,
           countusableregsaddr : byte;
+          procedure saveStateForInline(var state: pointer);override;
+          procedure restoreStateAfterInline(var state: pointer);override;
+          procedure saveUnusedState(var state: pointer);override;
+          procedure restoreUnusedState(var state: pointer);override;
           function isaddressregister(reg: tregister): boolean; override;
           function getaddressregister(list: taasmoutput): tregister; override;
           procedure ungetaddressregister(list: taasmoutput; r: tregister); override;
@@ -46,6 +50,7 @@ unit rgcpu;
              const saved : tpushedsaved);override;
           procedure saveusedregisters(list: taasmoutput;
         var saved : tpushedsaved; const s: tregisterset);override;
+          procedure cleartempgen;override;
 
        end;
 
@@ -107,8 +112,8 @@ unit rgcpu;
                     may not be real (JM) }
                 else
                   begin
-                    dec(countunusedregsint);
-                    exclude(unusedregsint,r.enum);
+                    dec(countunusedregsaddr);
+                    exclude(unusedregsaddr,r.enum);
                   end;
                 tg.ungettemp(list,hr);
               end;
@@ -138,21 +143,69 @@ unit rgcpu;
                 saved[r.enum].ofs:=hr.offset;
                 cg.a_load_reg_ref(list,OS_ADDR,r,hr);
                 cg.a_reg_dealloc(list,r);
-                include(unusedregsint,r.enum);
-                inc(countunusedregsint);
+                include(unusedregsaddr,r.enum);
+                inc(countunusedregsaddr);
               end;
           end;
 
       end;
 
 
+
+    procedure trgcpu.saveStateForInline(var state: pointer);
+      begin
+        inherited savestateforinline(state);
+        psavedstate(state)^.unusedregsaddr := unusedregsaddr;
+        psavedstate(state)^.usableregsaddr := usableregsaddr;
+        psavedstate(state)^.countunusedregsaddr := countunusedregsaddr;
+      end;
+
+
+    procedure trgcpu.restoreStateAfterInline(var state: pointer);
+      begin
+        unusedregsaddr := psavedstate(state)^.unusedregsaddr;
+        usableregsaddr := psavedstate(state)^.usableregsaddr;
+        countunusedregsaddr := psavedstate(state)^.countunusedregsaddr;
+        inherited restoreStateAfterInline(state);
+      end;
+
+
+    procedure trgcpu.saveUnusedState(var state: pointer);
+      begin
+        inherited saveUnusedState(state);
+        punusedstate(state)^.unusedregsaddr := unusedregsaddr;
+        punusedstate(state)^.countunusedregsaddr := countunusedregsaddr;
+      end;
+
+
+    procedure trgcpu.restoreUnusedState(var state: pointer);
+      begin
+        unusedregsaddr := punusedstate(state)^.unusedregsaddr;
+        countunusedregsaddr := punusedstate(state)^.countunusedregsaddr;
+        inherited restoreUnusedState(state);
+      end;
+
+    procedure trgcpu.cleartempgen;
+
+      begin
+         inherited cleartempgen;
+         countunusedregsaddr:=countusableregsaddr;
+         unusedregsaddr:=usableregsaddr;
+      end;
+
+
 initialization
   rg := trgcpu.create;
 end.
 
 {
   $Log$
-  Revision 1.5  2003-01-08 18:43:57  daniel
+  Revision 1.6  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.5  2003/01/08 18:43:57  daniel
    * Tregister changed into a record
 
   Revision 1.4  2002/09/07 15:25:14  peter

compiler/ncgadd.pas

@@ -33,7 +33,7 @@ interface
        tcgaddnode = class(taddnode)
 {          function pass_1: tnode; override;}
           procedure pass_2;override;
-         private
+         protected
           procedure pass_left_and_right;
           { load left and right nodes into registers }
           procedure load_left_right(cmpop, load_constants: boolean);
@@ -51,12 +51,10 @@ interface
           procedure second_add64bit;virtual;
           procedure second_addordinal;virtual;
 {          procedure second_cmpfloat;virtual;}
-          procedure second_cmpboolean;virtual;
-          procedure second_cmpsmallset;virtual;
-          procedure second_cmp64bit;virtual;
-          procedure second_cmpordinal;virtual;
-       
-
+          procedure second_cmpboolean;virtual;abstract;
+          procedure second_cmpsmallset;virtual;abstract;
+          procedure second_cmp64bit;virtual;abstract;
+          procedure second_cmpordinal;virtual;abstract;
        end;
 
   implementation
@@ -75,50 +73,6 @@ interface
 {*****************************************************************************
                                   Helpers
 *****************************************************************************}
-(*
-    function tcgaddnode.getresflags(unsigned : boolean) : tresflags;
-      begin
-         case nodetype of
-           equaln : getresflags:=F_E;
-           unequaln : getresflags:=F_NE;
-          else
-           if not(unsigned) then
-             begin
-                if nf_swaped in flags then
-                  case nodetype of
-                     ltn : getresflags:=F_G;
-                     lten : getresflags:=F_GE;
-                     gtn : getresflags:=F_L;
-                     gten : getresflags:=F_LE;
-                  end
-                else
-                  case nodetype of
-                     ltn : getresflags:=F_L;
-                     lten : getresflags:=F_LE;
-                     gtn : getresflags:=F_G;
-                     gten : getresflags:=F_GE;
-                  end;
-             end
-           else
-             begin
-                if nf_swaped in flags then
-                  case nodetype of
-                     ltn : getresflags:=F_A;
-                     lten : getresflags:=F_AE;
-                     gtn : getresflags:=F_B;
-                     gten : getresflags:=F_BE;
-                  end
-                else
-                  case nodetype of
-                     ltn : getresflags:=F_B;
-                     lten : getresflags:=F_BE;
-                     gtn : getresflags:=F_A;
-                     gten : getresflags:=F_AE;
-                  end;
-             end;
-         end;
-      end;
-*)
 
     procedure tcgaddnode.pass_left_and_right;
       var
@@ -249,58 +203,6 @@ interface
       end;
       
       
-    procedure tcgaddnode.second_cmpsmallset;
-     begin
-       location_reset(location,LOC_FLAGS,OS_NO);
-          
-       case nodetype of
-          equaln,
-          unequaln :
-            begin
-              {emit_compare(true);}
-            end;
-          lten,gten:
-            begin
-(*
-              If (not(nf_swaped in flags) and
-                  (nodetype = lten)) or
-                 ((nf_swaped in flags) and
-                  (nodetype = gten)) then
-                swapleftright;
-              // now we have to check whether left >= right
-              tmpreg := cg.get_scratch_reg_int(exprasmlist);
-              if left.location.loc = LOC_CONSTANT then
-                begin
-                  cg.a_op_const_reg_reg(exprasmlist,OP_AND,OS_INT,
-                    not(left.location.value),right.location.register,tmpreg);
-                  exprasmlist.concat(taicpu.op_reg_const(A_CMPWI,tmpreg,0));
-                  // the two instructions above should be folded together by
-                  // the peepholeoptimizer
-                end
-              else
-                begin
-                  if right.location.loc = LOC_CONSTANT then
-                    begin
-                      cg.a_load_const_reg(exprasmlist,OS_INT,
-                        aword(right.location.value),tmpreg);
-                      exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_,tmpreg,
-                        tmpreg,left.location.register));
-                    end
-                  else
-                    exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_,tmpreg,
-                      right.location.register,left.location.register));
-                end;
-              cg.free_scratch_reg(exprasmlist,tmpreg);
-              location.resflags.cr := R_CR0;
-              location.resflags.flag := F_EQ;
-              opdone := true;*)
-            end;
-          else
-            internalerror(2002072701);
-        end;
-          
-          
-     end;
      
 
     procedure tcgaddnode.second_addsmallset;
@@ -425,6 +327,8 @@ interface
         { calculate the operator which is more difficult }
         firstcomplex(self);
 
+        cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
+
         if cmpop then
             second_cmpboolean
         else
@@ -433,21 +337,15 @@ interface
 
       end;
 
-    procedure tcgaddnode.second_cmpboolean;
-      begin
-      end;
-    
     procedure tcgaddnode.second_addboolean;
       var
         cgop      : TOpCg;
         cgsize  : TCgSize;
-        cmpop,
         isjump  : boolean;
         otl,ofl : tasmlabel;
         pushedregs : tmaybesave;
       begin
 
-        cmpop:=false;
         if (torddef(left.resulttype.def).typ=bool8bit) or
            (torddef(right.resulttype.def).typ=bool8bit) then
          cgsize:=OS_8
@@ -457,7 +355,7 @@ interface
            cgsize:=OS_16
         else
            cgsize:=OS_32;
-(*
+
         if (cs_full_boolean_eval in aktlocalswitches) or
            (nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then
           begin
@@ -500,60 +398,37 @@ interface
                falselabel:=ofl;
              end;
 
-            cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln];
 
             { set result location }
-            if not cmpop then
-              location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def))
-             else
-              location_reset(location,LOC_FLAGS,OS_NO);
+            location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
 
-            load_left_right(cmpop,false);
+            load_left_right(false,false);
 
             if (left.location.loc = LOC_CONSTANT) then
               swapleftright;
 
-            { compare the }
             case nodetype of
-              ltn,lten,gtn,gten,
-              equaln,unequaln :
-                begin
-                  if (right.location.loc <> LOC_CONSTANT) then
-                    exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW,
-                      left.location.register,right.location.register))
-                  else
-                    exprasmlist.concat(taicpu.op_reg_const(A_CMPLWI,
-                      left.location.register,longint(right.location.value)));
-                  location.resflags := getresflags;
-                end;
+              xorn :
+                cgop:=OP_XOR;
+              orn :
+                cgop:=OP_OR;
+              andn :
+                cgop:=OP_AND;
               else
-                begin
-                  case nodetype of
-                    xorn :
-                      cgop:=OP_XOR;
-                    orn :
-                      cgop:=OP_OR;
-                    andn :
-                      cgop:=OP_AND;
-                    else
-                      internalerror(200203247);
-                  end;
+                 internalerror(200203247);
+              end;
 
-                  if right.location.loc <> LOC_CONSTANT then
-                    cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT,
-                      left.location.register,right.location.register,
-                      location.register)
-                  else
-                    cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT,
-                      aword(right.location.value),left.location.register,
-                      location.register);
-                end;
-            end;
+              if right.location.loc <> LOC_CONSTANT then
+                cg.a_op_reg_reg_reg(exprasmlist,cgop,OS_INT,
+                   left.location.register,right.location.register,
+                   location.register)
+              else
+                 cg.a_op_const_reg_reg(exprasmlist,cgop,OS_INT,
+                    aword(right.location.value),left.location.register,
+                    location.register);
          end
         else
          begin
-           // just to make sure we free the right registers
-           cmpop := true;
            case nodetype of
              andn,
              orn :
@@ -585,9 +460,9 @@ interface
                  maketojumpbool(exprasmlist,right,lr_load_regvars);
                end;
            end;
-         end;*)
+         end;
         { free used register (except the result register) }
-        clear_left_right(cmpop);
+        clear_left_right(true);
       end;
 
 
@@ -616,104 +491,6 @@ interface
         clear_left_right(cmpop);
      end;
 
-    procedure tcgaddnode.second_cmp64bit;
-     begin
-(*        load_left_right(true,false);
-
-        case nodetype of  
-          ltn,lten,
-          gtn,gten:
-           begin
-             emit_cmp64_hi;
-             firstjmp64bitcmp;
-             emit_cmp64_lo;
-             secondjmp64bitcmp;
-           end;
-          equaln,unequaln:
-           begin
-             // instead of doing a complicated compare, do
-             // (left.hi xor right.hi) or (left.lo xor right.lo)
-             // (somewhate optimized so that no superfluous 'mr's are
-             //  generated)
-                  if (left.location.loc = LOC_CONSTANT) then
-                    swapleftright;
-                  if (right.location.loc = LOC_CONSTANT) then
-                    begin
-                      if left.location.loc = LOC_REGISTER then
-                        begin
-                          tempreg64.reglo := left.location.registerlow;
-                          tempreg64.reghi := left.location.registerhigh;
-                        end
-                      else
-                        begin
-                          if (aword(right.location.valueqword) <> 0) then
-                            tempreg64.reglo := cg.get_scratch_reg_int(exprasmlist)
-                          else
-                            tempreg64.reglo := left.location.registerlow;
-                          if ((right.location.valueqword shr 32) <> 0) then
-                            tempreg64.reghi := cg.get_scratch_reg_int(exprasmlist)
-                          else
-                            tempreg64.reghi := left.location.registerhigh;
-                        end;
-
-                      if (aword(right.location.valueqword) <> 0) then
-                        { negative values can be handled using SUB, }
-                        { positive values < 65535 using XOR.        }
-                        if (longint(right.location.valueqword) >= -32767) and
-                           (longint(right.location.valueqword) < 0) then
-                          cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
-                            aword(right.location.valueqword),
-                            left.location.registerlow,tempreg64.reglo)
-                        else
-                          cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
-                            aword(right.location.valueqword),
-                            left.location.registerlow,tempreg64.reglo);
-
-                      if ((right.location.valueqword shr 32) <> 0) then
-                        if (longint(right.location.valueqword shr 32) >= -32767) and
-                           (longint(right.location.valueqword shr 32) < 0) then
-                          cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_INT,
-                            aword(right.location.valueqword shr 32),
-                            left.location.registerhigh,tempreg64.reghi)
-                        else
-                          cg.a_op_const_reg_reg(exprasmlist,OP_XOR,OS_INT,
-                            aword(right.location.valueqword shr 32),
-                            left.location.registerhigh,tempreg64.reghi);
-                    end
-                  else
-                    begin
-                       tempreg64.reglo := cg.get_scratch_reg_int(exprasmlist);
-                       tempreg64.reghi := cg.get_scratch_reg_int(exprasmlist);
-                       cg64.a_op64_reg_reg_reg(exprasmlist,OP_XOR,
-                         left.location.register64,right.location.register64,
-                         tempreg64);
-                    end;
-
-                  cg.a_reg_alloc(exprasmlist,R_0);
-                  exprasmlist.concat(taicpu.op_reg_reg_reg(A_OR_,R_0,
-                    tempreg64.reglo,tempreg64.reghi));
-                  cg.a_reg_dealloc(exprasmlist,R_0);
-                  if (tempreg64.reglo <> left.location.registerlow) then
-                    cg.free_scratch_reg(exprasmlist,tempreg64.reglo);
-                  if (tempreg64.reghi <> left.location.registerhigh) then
-                    cg.free_scratch_reg(exprasmlist,tempreg64.reghi);
-
-                  location_reset(location,LOC_FLAGS,OS_NO);
-                  location.resflags := getresflags;
-                end;
-              else
-                internalerror(2002072803);
-            end;
-
-
-        { set result location }
-        { (emit_compare sets it to LOC_FLAGS for compares, so set the }
-        {  real location only now) (JM)                               }
-        if cmpop and
-           not(nodetype in [equaln,unequaln]) then
-          location_reset(location,LOC_JUMP,OS_NO);
-*)
-     end;
 
 
     procedure tcgaddnode.second_add64bit;
@@ -841,22 +618,6 @@ interface
 {*****************************************************************************
                                 Ordinals
 *****************************************************************************}
-    procedure tcgaddnode.second_cmpordinal;
-     var
-      unsigned : boolean;
-     begin
-       { set result location }
-       location_reset(location,LOC_FLAGS,OS_NO);
-
-       { load values into registers (except constants) }
-       load_left_right(true, false);
-
-       { determine if the comparison will be unsigned }
-       unsigned:=not(is_signed(left.resulttype.def)) or
-                   not(is_signed(right.resulttype.def));
-
-     end;
-
 
     procedure tcgaddnode.second_addordinal;
      var
@@ -1049,10 +810,17 @@ interface
         clear_left_right(cmpop);
       end;
 
+begin
+   caddnode:=tcgaddnode;
 end.
 {
   $Log$
-  Revision 1.4  2003-01-08 18:43:56  daniel
+  Revision 1.5  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.4  2003/01/08 18:43:56  daniel
    * Tregister changed into a record
 
   Revision 1.3  2002/12/14 15:02:03  carl

compiler/paramgr.pas

@@ -64,13 +64,18 @@ unit paramgr;
             is required for cdecl procedures
           }
           function copy_value_on_stack(def : tdef;calloption : tproccalloption) : boolean;
-          { Returns a structure giving the information on
+          {# Returns a structure giving the information on
             the storage of the parameter (which must be
-            an integer parameter)
+            an integer parameter). This is only used when calling
+            internal routines directly, where all parameters must
+            be 4-byte values.
 
             @param(nr Parameter number of routine, starting from 1)
           }
           function getintparaloc(nr : longint) : tparalocation;virtual;abstract;
+          {# This is used to populate the location information on all parameters
+             for the routine. This is used for normal call resolution.
+          }
           procedure create_param_loc_info(p : tabstractprocdef);virtual;abstract;
 
           {
@@ -400,7 +405,12 @@ end.
 
 {
    $Log$
-   Revision 1.30  2003-01-08 18:43:56  daniel
+   Revision 1.31  2003-02-02 19:25:54  carl
+     * Several bugfixes for m68k target (register alloc., opcode emission)
+     + VIS target
+     + Generic add more complete (still not verified)
+
+   Revision 1.30  2003/01/08 18:43:56  daniel
     * Tregister changed into a record
 
    Revision 1.29  2002/12/23 20:58:03  peter

compiler/powerpc/cpubase.pas

@@ -512,6 +512,13 @@ uses
       usableregsmm  = [R_M14..R_M31];
       c_countusableregsmm  = 31-14+1;
 
+      { no distinction on this platform }      
+      maxaddrregs = 0;
+      addrregs    = [];
+      usableregsaddr = [];
+      c_countusableregsaddr = 0;
+      
+
       firstsaveintreg = R_13;
       lastsaveintreg  = R_27;
       firstsavefpureg = R_F14;
@@ -821,7 +828,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.42  2003-01-16 11:31:28  olle
+  Revision 1.43  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.42  2003/01/16 11:31:28  olle
     + added new register constants
     + implemented register convertion proc
 

compiler/pp.pas

@@ -31,6 +31,7 @@ program pp;
   M68K                generate a compiler for the M68000
   SPARC               generate a compiler for SPARC
   POWERPC             generate a compiler for the PowerPC
+  VIS                 generate a compile for the VIS  
   USEOVERLAY          compiles a TP version which uses overlays
   DEBUG               version with debug code is generated
   EXTDEBUG            some extra debug code is executed
@@ -77,6 +78,12 @@ program pp;
      {$endif CPUDEFINED}
      {$define CPUDEFINED}
    {$endif M68K}
+   {$ifdef vis}
+     {$ifdef CPUDEFINED}
+        {$fatal ONLY one of the switches for the CPU type must be defined}
+     {$endif CPUDEFINED}
+     {$define CPUDEFINED}
+   {$endif}
    {$ifdef iA64}
      {$ifdef CPUDEFINED}
         {$fatal ONLY one of the switches for the CPU type must be defined}
@@ -179,7 +186,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2002-11-15 01:58:53  peter
+  Revision 1.20  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.19  2002/11/15 01:58:53  peter
     * merged changes from 1.0.7 up to 04-11
       - -V option for generating bug report tracing
       - more tracing for option parsing

compiler/rgobj.pas

@@ -43,6 +43,8 @@ unit rgobj;
       ;
 
     type
+
+
        regvar_longintarray = array[firstreg..lastreg] of longint;
        regvar_booleanarray = array[firstreg..lastreg] of boolean;
        regvar_ptreearray = array[firstreg..lastreg] of tnode;
@@ -55,6 +57,48 @@ unit rgobj;
 
        tpushedsaved = array[firstreg..lastreg] of tpushedsavedloc;
 
+      (******************************* private struct **********************)
+      psavedstate = ^tsavedstate;
+      tsavedstate = record
+        unusedregsint,usableregsint : tregisterset;
+        unusedregsfpu,usableregsfpu : tregisterset;
+        unusedregsmm,usableregsmm : tregisterset;
+        unusedregsaddr,usableregsaddr : tregisterset;
+        countunusedregsaddr,
+        countunusedregsint,
+        countunusedregsfpu,
+        countunusedregsmm : byte;
+        countusableregsaddr,
+        countusableregsint,
+        countusableregsfpu,
+        countusableregsmm : byte;
+        { contains the registers which are really used by the proc itself }
+        usedbyproc,
+        usedinproc : tregisterset;
+        reg_pushes : regvar_longintarray;
+        is_reg_var : regvar_booleanarray;
+        regvar_loaded: regvar_booleanarray;
+{$ifdef TEMPREGDEBUG}
+         reg_user   : regvar_ptreearray;
+         reg_releaser : regvar_ptreearray;
+{$endif TEMPREGDEBUG}
+      end;
+
+      (******************************* private struct **********************)
+      punusedstate = ^tunusedstate;
+      tunusedstate = record
+        unusedregsint : tregisterset;
+        unusedregsfpu : tregisterset;
+        unusedregsmm : tregisterset;
+        unusedregsaddr : tregisterset; 
+        countunusedregsaddr,
+        countunusedregsint,
+        countunusedregsfpu,
+        countunusedregsmm : byte;
+      end;
+
+
+
        {#
           This class implements the abstract register allocator
           It is used by the code generator to allocate and free
@@ -213,11 +257,11 @@ unit rgobj;
 
           procedure makeregvar(reg: tregister);
 
-          procedure saveStateForInline(var state: pointer);
-          procedure restoreStateAfterInline(var state: pointer);
+          procedure saveStateForInline(var state: pointer);virtual;
+          procedure restoreStateAfterInline(var state: pointer);virtual;
 
-          procedure saveUnusedState(var state: pointer);
-          procedure restoreUnusedState(var state: pointer);
+          procedure saveUnusedState(var state: pointer);virtual;
+          procedure restoreUnusedState(var state: pointer);virtual;
        protected
           { the following two contain the common (generic) code for all }
           { get- and ungetregisterxxx functions/procedures              }
@@ -275,40 +319,8 @@ unit rgobj;
        globals,verbose,
        cgobj,tgobj,regvars;
 
-    type
-      psavedstate = ^tsavedstate;
-      tsavedstate = record
-        unusedregsint,usableregsint : tregisterset;
-        unusedregsfpu,usableregsfpu : tregisterset;
-        unusedregsmm,usableregsmm : tregisterset;
-        countunusedregsint,
-        countunusedregsfpu,
-        countunusedregsmm : byte;
-        countusableregsint,
-        countusableregsfpu,
-        countusableregsmm : byte;
-        { contains the registers which are really used by the proc itself }
-        usedbyproc,
-        usedinproc : tregisterset;
-        reg_pushes : regvar_longintarray;
-        is_reg_var : regvar_booleanarray;
-        regvar_loaded: regvar_booleanarray;
-{$ifdef TEMPREGDEBUG}
-         reg_user   : regvar_ptreearray;
-         reg_releaser : regvar_ptreearray;
-{$endif TEMPREGDEBUG}
-      end;
 
 
-      punusedstate = ^tunusedstate;
-      tunusedstate = record
-        unusedregsint : tregisterset;
-        unusedregsfpu : tregisterset;
-        unusedregsmm : tregisterset;
-        countunusedregsint,
-        countunusedregsfpu,
-        countunusedregsmm : byte;
-      end;
 
 
     constructor trgobj.create;
@@ -532,6 +544,8 @@ unit rgobj;
            ungetregisterfpu(list,r)
          else if r.enum in mmregs then
            ungetregistermm(list,r)
+         else if r.enum in addrregs then
+           ungetaddressregister(list,r)
          else internalerror(2002070602);
       end;
 
@@ -1016,7 +1030,12 @@ end.
 
 {
   $Log$
-  Revision 1.21  2003-01-08 18:43:57  daniel
+  Revision 1.22  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.21  2003/01/08 18:43:57  daniel
    * Tregister changed into a record
 
   Revision 1.20  2002/10/05 12:43:28  carl

compiler/sparc/cpubase.pas

@@ -121,12 +121,12 @@ const
   IF_SSE    = $00010000;  { it's a SSE (KNI, MMX2) instruction  }
   IF_PMASK  = LongInt($FF000000);  { the mask for processor types  }
   IF_PFMASK = LongInt($F001FF00);  { the mask for disassembly "prefer"  }
-  IF_V7			= $00000000;  { SPARC V7 instruction only (not supported)}
-  IF_V8			= $01000000;  { SPARC V8 instruction (the default)}
-  IF_V9			= $02000000;  { SPARC V9 instruction (not yet	supported)}
+  IF_V7     = $00000000;  { SPARC V7 instruction only (not supported)}
+  IF_V8     = $01000000;  { SPARC V8 instruction (the default)}
+  IF_V9     = $02000000;  { SPARC V9 instruction (not yet supported)}
   { added flags }
   IF_PRE    = $40000000;  { it's a prefix instruction }
-  IF_PASS2 	=	LongInt($80000000);{instruction can change in a second pass?}
+  IF_PASS2  = LongInt($80000000);{instruction can change in a second pass?}
 TYPE
 {$WARNING CPU32 opcodes do not fully include the Ultra SPRAC instruction set.}
   { don't change the order of these opcodes! }
@@ -378,6 +378,12 @@ const
   mmregs=[];
   usableregsmm=[];
   c_countusableregsmm=0;
+  { no distinction on this platform }      
+  maxaddrregs = 0;
+  addrregs    = [];
+  usableregsaddr = [];
+  c_countusableregsaddr = 0;
+  
   
   firstsaveintreg = R_O0;
   lastsaveintreg = R_I7;
@@ -400,15 +406,15 @@ const
   Taken from rs6000.h (DBX_REGISTER_NUMBER) from GCC 3.x source code.}
   stab_regindex:ARRAY[firstreg..lastreg]OF ShortInt=({$INCLUDE stabregi.inc});
 {*************************** generic register names **************************}
-	stack_pointer_reg		=	R_O6;
-  frame_pointer_reg		=	R_I6;
+  stack_pointer_reg   = R_O6;
+  frame_pointer_reg   = R_I6;
   {the return_result_reg, is used inside the called function to store its return
   value when that is a scalar value otherwise a pointer to the address of the
   result is placed inside it}
-	return_result_reg		=	R_I0;
+  return_result_reg   = R_I0;
   {the function_result_reg contains the function result after a call to a scalar
   function othewise it contains a pointer to the returned result}
-	function_result_reg	=	R_O0;
+  function_result_reg = R_O0;
   self_pointer_reg  =R_G5;
   {There is no accumulator in the SPARC architecture. There are just families
   of registers. All registers belonging to the same family are identical except
@@ -493,6 +499,8 @@ const
   max_operands = 3;
   maxintregs = maxvarregs;
   maxfpuregs = maxfpuvarregs;
+  
+  
 
 FUNCTION is_calljmp(o:tasmop):boolean;
 FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond;
@@ -603,7 +611,12 @@ END.
 
 {
   $Log$
-  Revision 1.21  2003-01-20 22:21:36  mazen
+  Revision 1.22  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.21  2003/01/20 22:21:36  mazen
   * many stuff related to RTL fixed
 
   Revision 1.20  2003/01/09 20:41:00  daniel

compiler/symdef.pas

@@ -715,6 +715,9 @@ interface
 {$ifdef SPARC}
        pbestrealtype : ^ttype = @s64floattype;
 {$endif SPARC}
+{$ifdef vis}
+       pbestrealtype : ^ttype = @s64floattype;
+{$endif vis}
 
     function mangledname_prefix(typeprefix:string;st:tsymtable):string;
 
@@ -5648,7 +5651,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.127  2003-01-21 14:36:44  pierre
+  Revision 1.128  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.127  2003/01/21 14:36:44  pierre
    * set sizes needs to be passes in bits not bytes to stabs info
 
   Revision 1.126  2003/01/16 22:11:33  peter

compiler/systems/i_amiga.pas

@@ -30,31 +30,34 @@ unit i_amiga;
     const
        system_m68k_amiga_info : tsysteminfo =
           (
-            system       : target_m68k_Amiga;
+            system       : system_m68k_Amiga;
             name         : 'Commodore Amiga';
             shortname    : 'amiga';
             flags        : [];
             cpu          : cpu_m68k;
-            short_name   : 'AMIGA';
             unit_env     : '';
             extradefines : '';
-            sharedlibext : '.library';
-            staticlibext : '.a';
             sourceext    : '.pp';
             pasext       : '.pas';
             exeext       : '';
-            defext       : '';
-            scriptext    : '';
+            defext       : '.def';
+            scriptext    : '.sh';
             smartext     : '.sl';
-            unitext      : '.ppa';
+            unitext      : '.ppu';
             unitlibext   : '.ppl';
             asmext       : '.asm';
             objext       : '.o';
             resext       : '.res';
             resobjext    : '.or';
-            staticlibprefix : '';
+            sharedlibext : '.library';
+            staticlibext : '.a';
+            staticlibprefix : 'lib';
             sharedlibprefix : '';
-            Cprefix      : '_';
+            sharedClibext : '.library';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : '';
+            Cprefix      : '';
             newline      : #10;
             dirsep       : '/';
             files_case_relevent : true;
@@ -62,16 +65,31 @@ unit i_amiga;
             assemextern  : as_gas;
             link         : nil;
             linkextern   : nil;
-            ar           : ar_m68k_ar;
+            ar           : ar_gnu_ar;
             res          : res_none;
             script       : script_amiga;
             endian       : endian_big;
-            stackalignment : 2;
-            maxCrecordalignment : 4;
-            heapsize     : 128*1024;
-            stacksize    : 8192;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 4;
+                varalignmin     : 0;
+                varalignmax     : 4;
+                localalignmin   : 0;
+                localalignmax   : 4;
+                paraalign       : 4;
+                recordalignmin  : 0;
+                recordalignmax  : 2;
+                maxCrecordalign : 4
+              );
+            first_parm_offset : 8;
+            heapsize     : 256*1024;
+            stacksize    : 262144;
             DllScanSupported:false;
-            use_function_relative_addresses : false
+            use_function_relative_addresses : true
           );
 
   implementation
@@ -79,13 +97,18 @@ unit i_amiga;
 initialization
 {$ifdef cpu68}
   {$ifdef AMIGA}
-    set_source_info(system_m68k_Amiga);
+    set_source_info(system_m68k_Amiga_info);
   {$endif amiga}
 {$endif cpu68}
 end.
 {
   $Log$
-  Revision 1.1  2002-09-06 15:03:51  carl
+  Revision 1.2  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.1  2002/09/06 15:03:51  carl
     * moved files to systems directory
 
   Revision 1.3  2002/08/13 18:01:51  carl

compiler/vis/aasmcpu.pas

@@ -0,0 +1,259 @@
+{
+    $Id$
+    Copyright (c) 1998-2001 by Florian Klaempfl and Pierre Muller
+
+    virtual instruction set family assembler instructions
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit aasmcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  cclasses,aasmtai,
+  aasmbase,globals,verbose,
+  cpubase,cpuinfo;
+
+
+type
+
+  taicpu = class(taicpu_abstract)
+     opsize : topsize;
+     constructor op_none(op : tasmop;_size : topsize);
+
+     constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister);
+     constructor op_const(op : tasmop;_size : topsize;_op1 : longint);
+     constructor op_ref(op : tasmop;_size : topsize;_op1 : treference);
+
+     constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
+     constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : treference);
+     constructor op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister);
+
+     constructor op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister);
+     constructor op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference);
+
+
+     { this is for Jmp instructions }
+     constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
+
+     constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
+     { for DBxx opcodes }
+     constructor op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol);
+     constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+
+     constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
+     constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
+
+  private
+     procedure init(_size : topsize); { this need to be called by all constructor }
+  end;
+
+
+  tai_align = class(tai_align_abstract)
+        { nothing to add }
+  end;
+
+  procedure InitAsm;
+  procedure DoneAsm;
+
+
+implementation
+
+
+{*****************************************************************************
+                                 Taicpu Constructors
+*****************************************************************************}
+
+
+
+
+    procedure taicpu.init(_size : topsize);
+      begin
+         typ:=ait_instruction;
+         is_jmp:=false;
+         opsize:=_size;
+         ops:=0;
+      end;
+
+
+    constructor taicpu.op_none(op : tasmop;_size : topsize);
+      begin
+         inherited create(op);;
+         init(_size);
+      end;
+
+
+    constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=1;
+         loadreg(0,_op1);
+      end;
+
+
+    constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : longint);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=1;
+         loadconst(0,aword(_op1));
+      end;
+
+
+    constructor taicpu.op_ref(op : tasmop;_size : topsize;_op1 : treference);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=1;
+         loadref(0,_op1);
+      end;
+
+
+    constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+
+    constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : treference);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=2;
+         loadconst(0,aword(_op1));
+         loadreg(1,_op2);
+      end;
+
+
+
+    constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=2;
+         loadconst(0,aword(_op1));
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=2;
+         loadref(0,_op1);
+         loadreg(1,_op2);
+      end;
+
+
+    constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+     constructor taicpu.op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadreg(0,_op1);
+         loadsymbol(1,_op2,0);
+      end;
+
+
+    constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=2;
+         loadsymbol(0,_op1,_op1ofs);
+         loadref(1,_op2);
+      end;
+
+
+    constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
+      begin
+         inherited create(op);
+         init(_size);
+         ops:=1;
+         loadsymbol(0,_op1,_op1ofs);
+      end;
+
+    constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+      begin
+         inherited create(op);;
+         init(_size);
+         ops:=2;
+         loadreg(0,_op2);
+         loadsymbol(1,_op1,_op1ofs);
+      end;
+
+
+    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
+      begin
+         inherited create(op);
+         init(_size);
+         condition:=cond;
+         ops:=1;
+         loadsymbol(0,_op1,0);
+      end;
+
+
+
+    procedure InitAsm;
+      begin
+      end;
+
+
+    procedure DoneAsm;
+      begin
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+
+
+}

compiler/vis/cpubase.pas

@@ -66,18 +66,24 @@ uses
 *****************************************************************************}
 
     type
-      tregister = (R_NO,R_R0,R_R1,R_R2,R_R3,
+      toldregister = (R_NO,R_R0,R_R1,R_R2,R_R3,
                    R_R4,R_R5,R_R6,R_R7,
                    R_R8,R_R9,R_R10,R_R11,
                    R_CCR,R_SP,R_FP,R_PC,
                    R_FP0,R_FP1,R_FP2,R_FP3,
                    R_FP4,R_FP5,R_FP6,R_FP7,
                    R_FP8,R_FP9,R_FP10,R_FP11,
-                   R_FP12,R_FP13,R_FP14,R_FP15
+                   R_FP12,R_FP13,R_FP14,R_FP15,
+                   R_INTREGISTER,R_FPUREGISTER
       );
 
       {# Set type definition for registers }
-      tregisterset = set of tregister;
+      tregisterset = set of Toldregister;
+      
+      tregister=record
+        enum:toldregister;
+        number:word;
+      end;
 
       { A type to store register locations for 64 Bit values. }
       tregister64 = packed record
@@ -88,19 +94,31 @@ uses
       treg64 = tregister64;
 
       {# Type definition for the array of string of register nnames }
-      treg2strtable = array[tregister] of string[5];
+      treg2strtable = array[toldregister] of string[5];
 
     Const
+
+    {Special registers:}
+      NR_NO = $0000;  {Invalid register}
+
+    {Normal registers:}
+
+    {General purpose registers:}
+      NR_R0 = $0100; NR_R1 = $0200; NR_R2 = $0300;
+      NR_R3 = $0400; NR_R4 = $0500; NR_R5 = $0600;
+      NR_R6 = $0700; NR_R7 = $0800; NR_R8 = $0900;
+      NR_R9 = $0A00; NR_R10 = $0B00; NR_R11 = $0C00;
+
       {# First register in the tregister enumeration }
-      firstreg = low(tregister);
+      firstreg = low(toldregister);
       {# Last register in the tregister enumeration }
-      lastreg  = high(tregister);
+      lastreg  = high(toldregister);
 
 
       std_reg2str : treg2strtable = ('',
         'r0','r1','r2','r3','r4','r5','r6','r7','r8','r9','r10','r11','ccr',
         'sp','fp','pc','fp0','fp1','fp2','fp3','fp4','fp5','fp6','fp7', 
-        'fp8','fp9','fp10','fp11','fp12','fp13','fp14','fp15'
+        'fp8','fp9','fp10','fp11','fp12','fp13','fp14','fp15','',''
       );
 
 
@@ -199,6 +217,16 @@ uses
 {*****************************************************************************
                                 Operand Sizes
 *****************************************************************************}
+       { S_NO = No Size of operand   }
+       { S_B  = 8-bit size operand   }
+       { S_W  = 16-bit size operand  }
+       { S_L  = 32-bit size operand  }
+       { Floating point types        }
+       { S_FS  = single type (32 bit) }
+       { S_FD  = double/64bit integer }
+       { S_FX  = Extended type      }
+       topsize = (S_NO,S_B,S_W,S_L,S_FS,S_FD,S_FX,S_IQ);
+
 
 {*****************************************************************************
                                Generic Location
@@ -350,6 +378,12 @@ uses
       mmregs     = [];
       usableregsmm  = [];
       c_countusableregsmm  = 0;
+      
+      { no distinction on this platform }      
+      maxaddrregs = 0;
+      addrregs    = [];
+      usableregsaddr = [];
+      c_countusableregsaddr = 0;
 
       firstsaveintreg = R_R2;
       lastsaveintreg  = R_R11;
@@ -359,11 +393,11 @@ uses
       lastsavemmreg   = R_NO;
 
       maxvarregs = 10;
-      varregs : Array [1..maxvarregs] of Tregister =
+      varregs : Array [1..maxvarregs] of toldregister =
                 (R_R2,R_R3,R_R4,R_R5,R_R6,R_R7,R_R8,R_R9,R_R10,R_R11);
 
       maxfpuvarregs = 15;
-      fpuvarregs : Array [1..maxfpuvarregs] of Tregister =
+      fpuvarregs : Array [1..maxfpuvarregs] of toldregister =
                 (R_FP1,R_FP2,R_FP3,
                  R_FP4,R_FP5,R_FP6,
                  R_FP7,R_FP8,R_FP9,
@@ -381,7 +415,7 @@ uses
          routine calls or in assembler blocks.
       }
       max_scratch_regs = 2;
-      scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_R0,R_R1);
+      scratch_regs: Array[1..max_scratch_regs] of toldregister = (R_R0,R_R1);
 
 {*****************************************************************************
                           Default generic sizes
@@ -406,7 +440,7 @@ uses
          Currently unsupported by abstract machine
       }
 
-          stab_regindex : array[tregister] of shortint =
+          stab_regindex : array[toldregister] of shortint =
           (-1,
            { r0..r11 }
            -1,-1,-1,-1,-1,-1,
@@ -416,7 +450,9 @@ uses
            { FP0..FP7 }
            -1,-1,-1,-1,-1,-1,-1,-1,
            { FP8..FP15 }
-           -1,-1,-1,-1,-1,-1,-1,-1
+           -1,-1,-1,-1,-1,-1,-1,-1,
+           { invalid }
+           -1,-1
         );
 
 
@@ -440,11 +476,11 @@ uses
   {the return_result_reg, is used inside the called function to store its return
   value when that is a scalar value otherwise a pointer to the address of the
   result is placed inside it}
-	return_result_reg		=	accumulator;
+    return_result_reg       =   accumulator;
 
   {the function_result_reg contains the function result after a call to a scalar
   function othewise it contains a pointer to the returned result}
-	function_result_reg	=	accumulator;
+    function_result_reg =   accumulator;
       {# Hi-Results are returned in this register (64-bit value high register) }
       accumulatorhigh = R_R1;
       fpu_result_reg = R_FP0;
@@ -480,6 +516,7 @@ uses
 
     procedure inverse_flags(var r : TResFlags);
     function  flags_to_cond(const f: TResFlags) : TAsmCond;
+    procedure convert_register_to_enum(var r:Tregister);
 
 
 implementation
@@ -531,10 +568,40 @@ implementation
         flags_to_cond := flags2cond[f];
       end;
 
+
+    procedure convert_register_to_enum(var r:Tregister);
+
+    begin
+      if r.enum = R_INTREGISTER then
+        case r.number of
+          NR_NO: r.enum:= R_NO;
+          NR_R0: r.enum:= R_R0;
+          NR_R1: r.enum:= R_R1;
+          NR_R2: r.enum:= R_R2;
+          NR_R3: r.enum:= R_R3;
+          NR_R4: r.enum:= R_R4;
+          NR_R5: r.enum:= R_R5;
+          NR_R6: r.enum:= R_R6;
+          NR_R7: r.enum:= R_R7;
+          NR_R8: r.enum:= R_R8;
+          NR_R9: r.enum:= R_R9;
+          NR_R10: r.enum:= R_R10;
+          NR_R11: r.enum:= R_R11;
+        else
+          internalerror(200301082);
+        end;
+    end;
+
+
 end.
 {
   $Log$
-  Revision 1.3  2002-11-17 18:26:16  mazen
+  Revision 1.4  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.3  2002/11/17 18:26:16  mazen
   * fixed a compilation bug accmulator-->accumulator, in definition of return_result_reg
 
   Revision 1.2  2002/11/17 17:49:09  mazen

compiler/vis/cpupara.pas

@@ -0,0 +1,84 @@
+{
+    $Id$
+    Copyright (c) 2002 by Florian Klaempfl
+
+    Generates the argument location information for the
+    virtual instruction set machine
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published bymethodpointer
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{ Generates the argument location information for 680x0.
+}
+unit cpupara;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       cpubase,
+       symdef,paramgr;
+
+    type
+       { Returns the location for the nr-st 32 Bit int parameter
+         if every parameter before is an 32 Bit int parameter as well
+         and if the calling conventions for the helper routines of the
+         rtl are used.
+       }
+       tcpuparamanager = class(tparamanager)
+          function getintparaloc(nr : longint) : tparalocation;override;
+          procedure create_param_loc_info(p : tabstractprocdef);override;
+          function getselflocation(p : tabstractprocdef) : tparalocation;override;
+       end;
+
+  implementation
+
+    uses
+       verbose,
+       globals,
+       globtype,
+       systems,
+       cpuinfo,cginfo,cgbase,
+       defutil;
+
+    function tcpuparamanager.getintparaloc(nr : longint) : tparalocation;
+      begin
+      end;
+
+    procedure tcpuparamanager.create_param_loc_info(p : tabstractprocdef);
+      var
+        param_offset : integer;  
+        hp : tparaitem;
+      begin
+      end;
+
+    function tcpuparamanager.getselflocation(p : tabstractprocdef) : tparalocation;
+      begin
+      end;
+
+begin
+   paramanager:=tcpuparamanager.create;
+end.
+
+{
+  $Log$
+  Revision 1.1  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+}

compiler/x86_64/cpubase.pas

@@ -371,6 +371,13 @@ const
        mmregs = [R_MM0..R_MM7];
        usableregsmm = [R_XMM0..R_XMM15];
        c_countusableregsmm  = 8;
+       
+      { no distinction on this platform }      
+       maxaddrregs = 0;
+       addrregs    = [];
+       usableregsaddr = [];
+       c_countusableregsaddr = 0;
+       
 
        firstsaveintreg = R_EAX;
        lastsaveintreg  = R_R15;
@@ -417,11 +424,11 @@ const
   {the return_result_reg, is used inside the called function to store its return
   value when that is a scalar value otherwise a pointer to the address of the
   result is placed inside it}
-	return_result_reg		=	accumulator;
+  return_result_reg   = accumulator;
 
   {the function_result_reg contains the function result after a call to a scalar
   function othewise it contains a pointer to the returned result}
-	function_result_reg	=	accumulator;
+  function_result_reg = accumulator;
        accumulatorhigh = R_RDX;
        { the register where the vmt offset is passed to the destructor }
        { helper routine                                                }
@@ -500,7 +507,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2003-01-05 13:36:54  florian
+  Revision 1.6  2003-02-02 19:25:54  carl
+    * Several bugfixes for m68k target (register alloc., opcode emission)
+    + VIS target
+    + Generic add more complete (still not verified)
+
+  Revision 1.5  2003/01/05 13:36:54  florian
     * x86-64 compiles
     + very basic support for float128 type (x86-64 only)