Various m68k fixes/additions:

  - fixes in asmreader, basic stuff works again, the rest is untested
  - removed lot of unnecessary ungetcpuregister()s
  - various other fixes i forgot
  + basic amigaos syscalls support. still lacks explicit funcretloc

git-svn-id: trunk@1943 -

compiler/m68k/aasmcpu.pas

@@ -430,6 +430,7 @@ type
 
     function taicpu.is_same_reg_move(regtype: Tregistertype):boolean;
       begin
+//        writeln('is_same_reg_move');
         result:=(((opcode=A_MOVE) or (opcode=A_EXG)) and
                  (regtype = R_INTREGISTER) and
                  (ops=2) and

compiler/m68k/agcpugas.pas

@@ -178,8 +178,10 @@ interface
         i : tsuperregister;
       begin
         case o.typ of
-          top_reg:
+          top_reg: begin
             getopstr:=gas_regname(o.reg);
+//            writeln('top_reg:',getopstr,'!');
+            end;
           top_ref:
             if o.ref^.refaddr=addr_full then
               begin
@@ -320,9 +322,10 @@ interface
                          (op = A_MULU) or
                          (op = A_MULS) or
                          (op = A_DIVS) or
-                         (op = A_DIVU)) and (i=1) then
+                         (op = A_DIVU)) and (i=2) then
+                      begin
                         sep:=':'
-                      else
+                      end else
                         sep:=',';
                       s:=s+sep+getopstr(taicpu(hp).oper[i]^)
                     end;

compiler/m68k/cgcpu.pas

@@ -403,7 +403,7 @@ unit cgcpu;
         opcode := topcg2tasmop[op];
         case op of
           OP_ADD :
-              Begin
+              begin
                 if (a >= 1) and (a <= 8) then
                     list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg))
                 else
@@ -414,20 +414,20 @@ unit cgcpu;
               end;
           OP_AND,
           OP_OR:
-              Begin
+              begin
                  list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,longint(a), reg));
               end;
           OP_DIV :
-              Begin
+              begin
                  internalerror(20020816);
               end;
           OP_IDIV :
-              Begin
+              begin
                  internalerror(20020816);
               end;
           OP_IMUL :
-              Begin
-             if aktoptprocessor = MC68000 then
+              begin
+                if aktoptprocessor = MC68000 then
                    begin
                      r:=NR_D0;
                      r2:=NR_D1;
@@ -445,18 +445,17 @@ unit cgcpu;
                     begin
                       if (isaddressregister(reg)) then
                        begin
-                         scratch_reg := cg.getintregister(list,OS_INT);
+                         scratch_reg := getintregister(list,OS_INT);
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
                          list.concat(taicpu.op_const_reg(A_MULS,S_L,a,scratch_reg));
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
-                         cg.ungetcpuregister(list,scratch_reg);
                        end
                       else
                          list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg));
                     end;
               end;
           OP_MUL :
-              Begin
+              begin
                  if aktoptprocessor = MC68000 then
                    begin
                      r:=NR_D0;
@@ -474,11 +473,10 @@ unit cgcpu;
                     begin
                       if (isaddressregister(reg)) then
                        begin
-                         scratch_reg := cg.getintregister(list,OS_INT);
+                         scratch_reg := getintregister(list,OS_INT);
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
                          list.concat(taicpu.op_const_reg(A_MULU,S_L,a,scratch_reg));
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
-                         cg.ungetcpuregister(list,scratch_reg);
                        end
                       else
                          list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg));
@@ -487,17 +485,16 @@ unit cgcpu;
           OP_SAR,
           OP_SHL,
           OP_SHR :
-              Begin
+              begin
                 if (a >= 1) and (a <= 8) then
                  begin
                    { now allowed to shift an address register }
                    if (isaddressregister(reg)) then
                      begin
-                       scratch_reg := cg.getintregister(list,OS_INT);
+                       scratch_reg := getintregister(list,OS_INT);
                        list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
                        list.concat(taicpu.op_const_reg(opcode,S_L,a, scratch_reg));
                        list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
-                       cg.ungetcpuregister(list,scratch_reg);
                      end
                    else
                      list.concat(taicpu.op_const_reg(opcode,S_L,a, reg));
@@ -514,15 +511,13 @@ unit cgcpu;
                        list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg2));
                        list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, scratch_reg2));
                        list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg2,reg));
-                       cg.ungetcpuregister(list,scratch_reg2);
                      end
                    else
                      list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg));
-                   cg.ungetcpuregister(list,scratch_reg);
                  end;
               end;
           OP_SUB :
-              Begin
+              begin
                 if (a >= 1) and (a <= 8) then
                     list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg))
                 else
@@ -547,7 +542,7 @@ unit cgcpu;
       begin
         case op of
           OP_ADD :
-              Begin
+              begin
                  if aktoptprocessor = ColdFire then
                   begin
                     { operation only allowed only a longword }
@@ -563,11 +558,11 @@ unit cgcpu;
           OP_AND,OP_OR,
           OP_SAR,OP_SHL,
           OP_SHR,OP_SUB,OP_XOR :
-              Begin
+              begin
                  { load to data registers }
                  if (isaddressregister(reg1)) then
                    begin
-                     hreg1 := cg.getintregister(list,OS_INT);
+                     hreg1 := getintregister(list,OS_INT);
                      list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
                    end
                  else
@@ -575,7 +570,7 @@ unit cgcpu;
 
                  if (isaddressregister(reg2))  then
                    begin
-                      hreg2:= cg.getintregister(list,OS_INT);
+                      hreg2:= getintregister(list,OS_INT);
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
                    end
                  else
@@ -600,25 +595,22 @@ unit cgcpu;
                     list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2));
                   end;
 
-                 if reg1 <> hreg1 then
-                    cg.ungetcpuregister(list,hreg1);
                  { move back result into destination register }
                  if reg2 <> hreg2 then
                    begin
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
-                      cg.ungetcpuregister(list,hreg2);
                    end;
               end;
           OP_DIV :
-              Begin
+              begin
                  internalerror(20020816);
               end;
           OP_IDIV :
-              Begin
+              begin
                  internalerror(20020816);
               end;
           OP_IMUL :
-              Begin
+              begin
                  sign_extend(list, size,reg1);
                  sign_extend(list, size,reg2);
                  if aktoptprocessor = MC68000 then
@@ -636,12 +628,14 @@ unit cgcpu;
                    end
                   else
                     begin
+//                     writeln('doing 68020');
+
                      if (isaddressregister(reg1)) then
-                       hreg1 := cg.getintregister(list,OS_INT)
+                       hreg1 := getintregister(list,OS_INT)
                      else
                        hreg1 := reg1;
                      if (isaddressregister(reg2))  then
-                       hreg2:= cg.getintregister(list,OS_INT)
+                       hreg2:= getintregister(list,OS_INT)
                      else
                        hreg2 := reg2;
 
@@ -650,18 +644,16 @@ unit cgcpu;
 
                      list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2));
 
-                     if reg1 <> hreg1 then
-                       cg.ungetcpuregister(list,hreg1);
                      { move back result into destination register }
+
                      if reg2 <> hreg2 then
                        begin
                           list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
-                          cg.ungetcpuregister(list,hreg2);
                        end;
                     end;
               end;
           OP_MUL :
-              Begin
+              begin
                  sign_extend(list, size,reg1);
                  sign_extend(list, size,reg2);
                  if aktoptprocessor = MC68000 then
@@ -695,16 +687,12 @@ unit cgcpu;
                      else
                        hreg2 := reg2;
 
-
                      list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2));
 
-                     if reg1<>hreg1 then
-                       cg.ungetcpuregister(list,hreg1);
                      { move back result into destination register }
                      if reg2<>hreg2 then
                        begin
                           list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
-                          cg.ungetcpuregister(list,hreg2);
                        end;
                     end;
               end;
@@ -720,7 +708,7 @@ unit cgcpu;
 
                 if (isaddressregister(reg2)) then
                   begin
-                     hreg2 := cg.getintregister(list,OS_INT);
+                     hreg2 := getintregister(list,OS_INT);
                      list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
                    end
                   else
@@ -740,7 +728,6 @@ unit cgcpu;
                 if reg2 <> hreg2 then
                   begin
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
-                    cg.ungetcpuregister(list,hreg2);
                   end;
 
               end;
@@ -768,13 +755,12 @@ unit cgcpu;
                  only longword comparison is supported,
                  and only on data registers.
                }
-               hregister := cg.getintregister(list,OS_INT);
+               hregister := getintregister(list,OS_INT);
                { always move to a data register }
                list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister));
                { sign/zero extend the register }
                sign_extend(list, size,hregister);
                list.concat(taicpu.op_const_reg(A_CMPI,S_L,a,hregister));
-               cg.ungetcpuregister(list,hregister);
              end
            else
              begin
@@ -839,7 +825,6 @@ unit cgcpu;
                   list.concat(taicpu.op_reg(A_NEG,S_B,hreg));
                 end;
              list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg));
-             cg.ungetcpuregister(list,hreg);
             end
           else
           begin
@@ -986,8 +971,6 @@ unit cgcpu;
                 end;
 
               { restore the registers that we have just used olny if they are used! }
-              ungetcpuregister(list, iregister);
-              ungetcpuregister(list, jregister);
               if jregister = NR_A1 then
                 hp2.base := NR_NO;
               if iregister = NR_A0 then
@@ -998,9 +981,6 @@ unit cgcpu;
 
 //           if delsource then
 //               tg.ungetiftemp(list,source);
-
-// Not needed? (KB)
-//           ungetcpuregister(list,hregister);
     end;
 
     procedure tcg68k.g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef);
@@ -1052,6 +1032,7 @@ unit cgcpu;
         r,hregister : tregister;
         ref : treference;
       begin
+//         writeln('g_proc_exit');
          { Routines with the poclearstack flag set use only a ret.
            also routines with parasize=0     }
          if current_procinfo.procdef.proccalloption in clearstack_pocalls then
@@ -1208,6 +1189,7 @@ unit cgcpu;
    hreg1, hreg2 : tregister;
    opcode : tasmop;
   begin
+//    writeln('a_op64_reg_reg');
     opcode := topcg2tasmop[op];
     case op of
       OP_ADD :
@@ -1270,6 +1252,7 @@ unit cgcpu;
    lowvalue : cardinal;
    highvalue : cardinal;
   begin
+//    writeln('a_op64_const_reg');
     { is it optimized out ? }
 //    if cg.optimize64_op_const_reg(list,op,value,reg) then
 //       exit;

compiler/m68k/cpunode.pas

@@ -35,7 +35,7 @@ unit cpunode;
          after the generic one (FK)
        }
          ncpuadd,
-//       nppccal,
+         n68kcal,
 //       nppccon,
 //       nppcflw,
 //       nppcmem,

compiler/m68k/cpupara.pas

@@ -43,11 +43,11 @@ unit cpupara;
           procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
+	   procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
          private
            procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword);
            function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
                                                var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint;   
-	   procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
            function parseparaloc(p : tparavarsym;const s : string) : boolean;override;
        end;
 

compiler/m68k/n68kcnv.pas

@@ -34,7 +34,7 @@ interface
           function first_int_to_real: tnode; override;
           procedure second_int_to_real;override;
           procedure second_int_to_bool;override;
-          procedure pass_2;override;
+//          procedure pass_2;override;
        end;
 
 implementation
@@ -212,7 +212,7 @@ implementation
          location.register := hreg1;
       end;
 
-
+{
     procedure tm68ktypeconvnode.pass_2;
 {$ifdef TESTOBJEXT2}
       var
@@ -232,7 +232,7 @@ implementation
            end;
          second_call_helper(convtype);
       end;
-
+}
 
 begin
    ctypeconvnode:=tm68ktypeconvnode;

compiler/m68k/ncpuadd.pas

@@ -168,6 +168,7 @@ implementation
       tmpreg : tregister;
       op : tasmop;
      begin
+       writeln('second_cmpordinal');
        { set result location }
        location_reset(location,LOC_JUMP,OS_NO);
 
@@ -320,6 +321,7 @@ implementation
 
     procedure t68kaddnode.second_cmp64bit;
      begin
+      writeln('second_cmp64bit');
 (*        load_left_right(true,false);
 
         case nodetype of

compiler/m68k/ra68kmot.pas

@@ -168,12 +168,12 @@ const
         str2opentry: tstr2opentry;
         hs : string;
         j : byte;
-      Begin
+      begin
         is_asmopcode:=false;
         { first of all we remove the suffix }
         j:=pos('.',s);
         if j>0 then
-          hs:=copy(s,3,255)
+          hs:=copy(s,1,j-1)
         else
           hs:=s;
 
@@ -209,7 +209,8 @@ const
     function tm68kmotreader.is_register(const s:string):boolean;
       begin
         is_register:=false;
-        actasmregister:=gas_regnum_search(lower(s));
+        // FIX ME!!! Ugly, needs a proper fix (KB)
+        actasmregister:=gas_regnum_search('%'+lower(s));
         if actasmregister<>NR_NO then
           begin
             is_register:=true;
@@ -1414,12 +1415,14 @@ const
                   end;
    { // Register, a variable reference or a constant reference // }
      AS_REGISTER: begin
+//                   writeln('register! ',actasmpattern);
                    { save the type of register used. }
                    tempstr := actasmpattern;
                    Consume(AS_REGISTER);
                    { // Simple register // }
                    if (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA) then
                    begin
+//                        writeln('simple reg');
                         if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
                          Message(asmr_e_invalid_operand_type);
                         oper.opr.typ := OPR_REGISTER;
@@ -1643,6 +1646,7 @@ const
          BuildOperand(Instr.Operands[operandnum] as tm68koperand);
      end; { end case }
     end; { end while }
+    instr.Ops:=operandnum;
   end;
 
 

compiler/ncal.pas

@@ -1458,14 +1458,14 @@ type
                  begin
                    hiddentree:=gen_vmt_tree;
                  end
-{$ifdef powerpc}
+{$if defined(powerpc) or defined(m68k)}
               else
                if vo_is_syscall_lib in currpara.varoptions then
                  begin
                    { lib parameter has no special type but proccalloptions must be a syscall }
                    hiddentree:=cloadnode.create(tprocdef(procdefinition).libsym,tprocdef(procdefinition).libsym.owner);
                  end
-{$endif powerpc}
+{$endif powerpc or m68k}
               else
                if vo_is_parentfp in currpara.varoptions then
                  begin

compiler/pdecsub.pas

@@ -1230,16 +1230,45 @@ end;
 
 
 procedure pd_syscall(pd:tabstractprocdef);
-{$ifdef powerpc}
+{$if defined(powerpc) or defined(m68k)}
 var
   vs  : tparavarsym;
   sym : tsym;
   symtable : tsymtable;
-{$endif powerpc}
+{$endif defined(powerpc) or defined(m68k)}
 begin
   if pd.deftype<>procdef then
     internalerror(2003042614);
   tprocdef(pd).forwarddef:=false;
+{$ifdef m68k}
+   if target_info.system in [system_m68k_amiga] then
+    begin
+      include(pd.procoptions,po_syscall_legacy);
+
+      if consume_sym(sym,symtable) then
+        begin
+          if (sym.typ=globalvarsym) and
+             (
+              (tabstractvarsym(sym).vartype.def.deftype=pointerdef) or
+              is_32bitint(tabstractvarsym(sym).vartype.def)
+             ) then
+            begin
+              tprocdef(pd).libsym:=sym;
+              if po_syscall_legacy in tprocdef(pd).procoptions then
+                begin
+                  vs:=tparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vartype,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]);
+                  paramanager.parseparaloc(vs,'A6');
+                  pd.parast.insert(vs);
+                end
+            end
+          else
+            Message(parser_e_32bitint_or_pointer_variable_expected);
+        end;
+      { FIX ME!!! 68k amigaos syscalls needs explicit funcretloc support to be complete (KB) }
+      (paramanager as tm68kparamanager).create_funcretloc_info(pd,calleeside);
+      (paramanager as tm68kparamanager).create_funcretloc_info(pd,callerside);
+    end;
+{$endif m68k}
 {$ifdef powerpc}
    if target_info.system in [system_powerpc_morphos] then
     begin

compiler/scandir.pas

@@ -912,6 +912,8 @@ implementation
       var
         sctype : string;
       begin
+        { not needed on amiga/m68k for now, because there's only one }
+        { syscall convention (legacy) (KB) }
         if not (target_info.system in [system_powerpc_morphos]) then
           comment (V_Warning,'Syscall directive is useless on this target.');
         current_scanner.skipspace;

compiler/symdef.pas

@@ -480,11 +480,11 @@ interface
           refcount : longint;
           _class : tobjectdef;
           _classderef : tderef;
-{$ifdef powerpc}
+{$if defined(powerpc) or defined(m68k)}
           { library symbol for AmigaOS/MorphOS }
           libsym : tsym;
           libsymderef : tderef;
-{$endif powerpc}
+{$endif powerpc or m68k}
           { name of the result variable to insert in the localsymtable }
           resultname : stringid;
           { true, if the procedure is only declared