totally messy m68k changes. cleanup in progress

git-svn-id: trunk@2352 -

.gitattributes

@@ -179,10 +179,10 @@ compiler/m68k/cpupi.pas svneol=native#text/plain
 compiler/m68k/cpuswtch.pas svneol=native#text/plain
 compiler/m68k/cputarg.pas svneol=native#text/plain
 compiler/m68k/itcpugas.pas svneol=native#text/plain
+compiler/m68k/n68kadd.pas svneol=native#text/plain
 compiler/m68k/n68kcal.pas svneol=native#text/plain
 compiler/m68k/n68kcnv.pas svneol=native#text/plain
 compiler/m68k/n68kmat.pas svneol=native#text/plain
-compiler/m68k/ncpuadd.pas svneol=native#text/plain
 compiler/m68k/r68kcon.inc svneol=native#text/plain
 compiler/m68k/r68kgas.inc svneol=native#text/plain
 compiler/m68k/r68kgri.inc svneol=native#text/plain

compiler/m68k/cgcpu.pas

@@ -311,11 +311,15 @@ unit cgcpu;
     procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
      var
        href : treference;
+//       p: pointer;
       begin
-        if getregtype(r)=R_ADDRESSREGISTER then
+         {$WARNING FIX ME!!! take a look on this mess again...}
-          begin
+//        if getregtype(r)=R_ADDRESSREGISTER then
-            internalerror(2002072901);
+//          begin
-          end;
+//            writeln('address reg?!?');
+//            p:=nil; dword(p^):=0; {DEBUG CODE... :D )
+//            internalerror(2002072901);
+//          end;
         href:=ref;
         fixref(list, href);
         list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));

compiler/m68k/cpubase.pas

@@ -400,16 +400,31 @@ implementation
       end;
 
     function cgsize2subreg(s:Tcgsize):Tsubregister;
+      var p: pointer;
       begin
         case s of
+          OS_NO: begin
+{$WARNING FIX ME!!! results in bad code generation}
+            cgsize2subreg:=R_SUBWHOLE;
+            end;
+            
           OS_8,OS_S8:
             cgsize2subreg:=R_SUBWHOLE;
           OS_16,OS_S16:
             cgsize2subreg:=R_SUBWHOLE;
           OS_32,OS_S32:
             cgsize2subreg:=R_SUBWHOLE;
-          else
+          OS_64,OS_S64:
-            internalerror(200301231);
+            begin
+             writeln('64bit regsize?');
+             cgsize2subreg:=R_SUBWHOLE;
+            end;    
+          else begin
+            writeln('miafasz?');
+    //        p:=nil; dword(p^):=0;
+    //        internalerror(200301231);
+            cgsize2subreg:=R_SUBWHOLE;
+          end;    
         end;
       end;
 

compiler/m68k/cpunode.pas

@@ -34,7 +34,7 @@ unit cpunode;
          the processor specific nodes must be included
          after the generic one (FK)
        }
-         ncpuadd,
+         n68kadd,
          n68kcal,
 //       nppccon,
 //       nppcflw,

compiler/m68k/n68kadd.pas

@@ -19,7 +19,7 @@
 
  ****************************************************************************
 }
-unit ncpuadd;
+unit n68kadd;
 
 {$i fpcdefs.inc}
 
@@ -31,12 +31,13 @@ interface
 
     type
        t68kaddnode = class(tcgaddnode)
+       private
+          function getresflags(unsigned: boolean) : tresflags;
+       protected
           procedure second_cmpordinal;override;
           procedure second_cmpsmallset;override;
           procedure second_cmp64bit;override;
-          procedure second_cmpboolean;override;
+          procedure second_cmpboolean;override;             
-       private
-          function getresflags(unsigned: boolean) : tresflags;
        end;
 
 
@@ -146,7 +147,7 @@ implementation
                     exprasmlist.concat(taicpu.op_reg_reg(A_AND,S_L,
                       right.location.register,left.location.register));
                 end;
-              cg.ungetcpuregister(exprasmlist,tmpreg);
+//              cg.ungetcpuregister(exprasmlist,tmpreg);
               location.resflags := getresflags(true);
             end;
           else
@@ -168,7 +169,8 @@ implementation
       tmpreg : tregister;
       op : tasmop;
      begin
-       writeln('second_cmpordinal');
+//       writeln('second_cmpordinal');
+       pass_left_right;
        { set result location }
        location_reset(location,LOC_JUMP,OS_NO);
 
@@ -227,7 +229,7 @@ implementation
             begin
               exprasmlist.concat(taicpu.op_reg_reg(op,S_L,
                 left.location.register,tmpreg));
-              cg.ungetcpuregister(exprasmlist,tmpreg);
+//              cg.ungetcpuregister(exprasmlist,tmpreg);
             end
         else
           exprasmlist.concat(taicpu.op_reg_reg(op,S_L,
@@ -245,6 +247,7 @@ implementation
         isjump  : boolean;
         otl,ofl : tasmlabel;
       begin
+//        writeln('second_cmpboolean');
         if (torddef(left.resulttype.def).typ=bool8bit) or
            (torddef(right.resulttype.def).typ=bool8bit) then
          cgsize:=OS_8
@@ -270,8 +273,11 @@ implementation
                  objectlibrary.getjumplabel(falselabel);
               end;
             secondpass(left);
-            if left.location.loc in [LOC_FLAGS,LOC_JUMP] then
+            if left.location.loc in [LOC_FLAGS,LOC_JUMP] then begin
+//             writeln('ajjaj');
              location_force_reg(exprasmlist,left.location,cgsize,false);
+//             writeln('reccs?');
+            end; 
             if isjump then
              begin
                truelabel:=otl;

compiler/m68k/n68kcnv.pas

@@ -160,6 +160,7 @@ implementation
         resflags : tresflags;
         opsize   : tcgsize;
       begin
+         secondpass(left);
          { byte(boolean) or word(wordbool) or longint(longbool) must }
          { be accepted for var parameters                            }
          if (nf_explicit in flags) and
@@ -186,7 +187,7 @@ implementation
                      cg.a_load_ref_reg(exprasmlist,opsize,opsize,
                         left.location.reference,hreg2);
                      exprasmlist.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2));
-                     cg.ungetcpuregister(exprasmlist,hreg2);
+//                     cg.ungetcpuregister(exprasmlist,hreg2);
                   end;
 //                reference_release(exprasmlist,left.location.reference);
                 resflags:=F_NE;
@@ -196,7 +197,7 @@ implementation
               begin
                 hreg2:=left.location.register;
                 exprasmlist.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2));
-                cg.ungetcpuregister(exprasmlist,hreg2);
+//                cg.ungetcpuregister(exprasmlist,hreg2);
                 hreg1:=cg.getintregister(exprasmlist,opsize);
                 resflags:=F_NE;
               end;
@@ -206,7 +207,7 @@ implementation
                 resflags:=left.location.resflags;
               end;
             else
-              internalerror(10062);
+             internalerror(200512182);
          end;
          cg.g_flags2reg(exprasmlist,location.size,resflags,hreg1);
          location.register := hreg1;

compiler/m68k/n68kmat.pas

@@ -40,6 +40,11 @@ interface
          procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);override;
       end;
 
+      tm68kshlshrnode = class(tshlshrnode)
+         procedure pass_2;override;
+         { everything will be handled in pass_2 }
+         function first_shlshr64bitint: tnode; override;
+      end;
 
 
 implementation
@@ -179,12 +184,14 @@ implementation
        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
+//     writeln('emit mod reg reg');
      { no RTL call, so inline a zero denominator verification }
      if aktoptprocessor <> MC68000 then
        begin
@@ -217,7 +224,7 @@ implementation
            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.ungetcpuregister(exprasmlist,tmpreg);
+//         cg.ungetcpuregister(exprasmlist,tmpreg);
        end
      else
        begin
@@ -238,11 +245,116 @@ implementation
         cg.ungetcpuregister(exprasmlist,Reg_D0);
         cg.ungetcpuregister(exprasmlist,Reg_D1);
        end;
+//      writeln('exits'); 
     end;
 
 
+{*****************************************************************************
+                             TM68KSHLRSHRNODE
+*****************************************************************************}
+
+    function tm68kShlShrNode.first_shlshr64bitint:TNode;
+      begin
+        { 2nd pass is our friend }
+        result := nil;
+      end;
+
+
+{$WARNING FIX ME!!! shlshrnode needs review}
+    procedure tm68kshlshrnode.pass_2;
+      var
+        hregister,resultreg,hregister1,
+        hreg64hi,hreg64lo : tregister;
+        op : topcg;
+        shiftval: aword;
+      begin
+        secondpass(left);
+        secondpass(right);
+        if is_64bit(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);
+            hreg64hi:=left.location.register64.reghi;
+            hreg64lo:=left.location.register64.reglo;
+
+            shiftval := tordconstnode(right).value and 63;
+            if shiftval > 31 then
+              begin
+                if nodetype = shln then
+                  begin
+                    cg.a_load_const_reg(exprasmlist,OS_32,0,hreg64hi);
+                    if (shiftval and 31) <> 0 then
+                      cg.a_op_const_reg_reg(exprasmlist,OP_SHL,OS_32,shiftval and 31,hreg64lo,hreg64lo);
+                  end
+                else
+                  begin
+                    cg.a_load_const_reg(exprasmlist,OS_32,0,hreg64lo);
+                    if (shiftval and 31) <> 0 then
+                      cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_32,shiftval and 31,hreg64hi,hreg64hi);
+                  end;
+                location.register64.reglo:=hreg64hi;
+                location.register64.reghi:=hreg64lo;
+              end
+            else
+              begin
+                hregister:=cg.getintregister(exprasmlist,OS_32);
+                if nodetype = shln then
+                  begin
+                    cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_32,32-shiftval,hreg64lo,hregister);
+                    cg.a_op_const_reg_reg(exprasmlist,OP_SHL,OS_32,shiftval,hreg64hi,hreg64hi);
+                    cg.a_op_reg_reg_reg(exprasmlist,OP_OR,OS_32,hregister,hreg64hi,hreg64hi);
+                    cg.a_op_const_reg_reg(exprasmlist,OP_SHL,OS_32,shiftval,hreg64lo,hreg64lo);
+                  end
+                else
+                  begin
+                    cg.a_op_const_reg_reg(exprasmlist,OP_SHL,OS_32,32-shiftval,hreg64hi,hregister);
+                    cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_32,shiftval,hreg64lo,hreg64lo);
+                    cg.a_op_reg_reg_reg(exprasmlist,OP_OR,OS_32,hregister,hreg64lo,hreg64lo);
+                    cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_32,shiftval,hreg64hi,hreg64hi);
+                  end;
+                location.register64.reghi:=hreg64hi;
+                location.register64.reglo:=hreg64lo;
+              end;
+          end
+        else
+          begin
+            { load left operators in a register }
+            location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),true);
+            location_copy(location,left.location);
+            resultreg := location.register;
+            hregister1 := location.register;
+            if (location.loc = LOC_CREGISTER) then
+              begin
+                location.loc := LOC_REGISTER;
+                resultreg := cg.GetIntRegister(exprasmlist,OS_INT);
+                location.register := resultreg;
+              end;
+            { determine operator }
+            if nodetype=shln then
+              op:=OP_SHL
+            else
+              op:=OP_SHR;
+            { shifting by a constant directly coded: }
+            if (right.nodetype=ordconstn) then
+              begin
+                if tordconstnode(right).value and 31<>0 then
+                  cg.a_op_const_reg_reg(exprasmlist,op,OS_32,tordconstnode(right).value and 31,hregister1,resultreg)
+              end
+            else
+              begin
+                { load shift count in a register if necessary }
+                location_force_reg(exprasmlist,right.location,def_cgsize(right.resulttype.def),true);
+                cg.a_op_reg_reg_reg(exprasmlist,op,OS_32,right.location.register,hregister1,resultreg);
+              end;
+          end;
+      end;
+
+
 
 begin
    cnotnode:=tm68knotnode;
    cmoddivnode:=tm68kmoddivnode;
+   cshlshrnode:=tm68kshlshrnode;
 end.

compiler/m68k/ra68k.pas

@@ -35,7 +35,7 @@ unit ra68k;
 
       Tm68kInstruction=class(TInstruction)
         opsize : topsize;
-        function ConcatInstruction(p : taasmoutput):tai;override;
+//        function ConcatInstruction(p : taasmoutput):tai;override;
         function ConcatLabeledInstr(p : taasmoutput):tai;
       end;
 
@@ -48,10 +48,12 @@ unit ra68k;
                                 TM68kInstruction
 *****************************************************************************}
 
+{
  function TM68kInstruction.ConcatInstruction(p : taasmoutput):tai;
   var
     fits : boolean;
   begin
+     writeln('jaj mami');
      result:=nil;
      fits := FALSE;
     { setup specific opcodetions for first pass }
@@ -317,7 +319,7 @@ unit ra68k;
    if assigned(result) then
      p.concat(result);
  end;
-
+}
 
     function TM68kInstruction.ConcatLabeledInstr(p : taasmoutput):tai;
       begin

compiler/m68k/ra68kmot.pas

@@ -524,10 +524,14 @@ const
   {---------------------------------------------------------------------}
 
     function tm68kmotreader.consume(t : tasmtoken):boolean;
+      var
+        p: pointer;
       begin
         Consume:=true;
         if t<>actasmtoken then
          begin
+           p:=nil;
+           dword(p^):=0;
            Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
            Consume:=false;
          end;
@@ -1274,6 +1278,7 @@ const
   {       AS_COMMA or AS_SEPARATOR token.                               }
   {*********************************************************************}
   var
+    expr: string;
     tempstr: string;
     lab: tasmlabel;
     l : longint;
@@ -1282,6 +1287,7 @@ const
     hl: tasmlabel;
     reg_one, reg_two: tregister;
     regset: tcpuregisterset;
+    p: pointer;
   begin
    regset := [];
    tempstr := '';
@@ -1344,7 +1350,7 @@ const
                   end;
                 Consume(AS_ID);
                 if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
-                 Message(asmr_e_syntax_error);
+                  Message(asmr_e_syntax_error);
               end
               { probably a variable or normal expression }
               { or a procedure (such as in CALL ID)      }
@@ -1358,7 +1364,7 @@ const
                      BuildReference(oper);
                    end
                  else { is it a label variable ? }
-                   begin
+                 
                      { // ID[ , ID.Field.Field or simple ID // }
                      { check if this is a label, if so then }
                      { emit it as a label.                  }
@@ -1371,22 +1377,62 @@ const
                          Consume(AS_ID);
                          if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then
                           Message(asmr_e_syntax_error);
+                          
                        end
-                      else
+                      else begin     
-                       Message1(sym_e_unknown_id,actasmpattern);
+                       expr:=actasmpattern;
+                       Consume(AS_ID);
+                       { typecasting? }
+                       if SearchType(expr,l) then
+                        begin
+                          oper.hastype:=true;
+                          oper.typesize:=l;
+                          case actasmtoken of
+                            AS_LPAREN :
+                              begin
+                                { Support Type([Reference]) }
+                                Consume(AS_LPAREN);
+                                BuildOperand(oper{,true});
+                                Consume(AS_RPAREN);
+                              end;
+                            AS_LBRACKET :
+                              begin
+                                { Support Var.Type[Index] }
+                                { Convert @label.Byte[1] to reference }
+                                if oper.opr.typ=OPR_SYMBOL then
+                                  oper.initref;
+                              end;
+                          end;
+                        end
+                       else
+                        begin
+                          if not oper.SetupVar(expr,false) then
+                            begin
+                              { not a variable, check special variables.. }
+                              if expr = 'SELF' then
+                                oper.SetupSelf
+                              else begin
+                                writeln('unknown id: ',expr);
+                                Message1(sym_e_unknown_id,expr);
+                              end;    
+                              expr:='';
+                            end;
+                         end;
+//                       Message1(sym_e_unknown_id,actasmpattern);
+                      end;        
 
-                     Consume(AS_ID);
                        case actasmtoken of
                          AS_LPAREN: { indexing }
                            BuildReference(oper);
-                         AS_SEPARATOR,AS_COMMA: ;
+                         AS_SEPARATOR,AS_COMMA: begin
-                       else
+                         end;
-                          Message(asmr_e_syntax_error);
+                       else 
+                         Message(asmr_e_syntax_error);
                        end;
 
                    end;
                end;
-             end;
+            
    { // Pre-decrement mode reference or constant mem offset.   // }
      AS_MINUS:    begin
                    Consume(AS_MINUS);
@@ -1546,6 +1592,7 @@ const
      AS_SEPARATOR, AS_COMMA: ;
     else
      begin
+      writeln('looofasz');
       Message(asmr_e_invalid_opcode_and_operand);
       Consume(actasmtoken);
      end;
@@ -1729,8 +1776,9 @@ const
 {                    instr.CheckOperandSizes;}
                   if instr.labeled then
                      instr.ConcatLabeledInstr(curlist)
-                  else
+                  else begin
                     instr.ConcatInstruction(curlist);
+                  end;    
                   instr.Free;
 {
                   instr.init;