* m68k updates

compiler/ag68kgas.pas

@@ -53,7 +53,13 @@ unit ag68kgas;
       line_length = 70;
 
     var
+{$ifdef NEWINPUT}
+      infile : pinputfile;
+{$else}
+
       infile : pextfile;
+{$endif}
+
       includecount,lastline : longint;
 
     function double2str(d : double) : string;
@@ -207,10 +213,10 @@ unit ag68kgas;
 
     var
 {$ifdef GDB}
-
        n_line : byte;
 {$endif}
        lastsec : tsection;
+       lastsecidx : longint;
 
 
     const
@@ -246,9 +252,14 @@ unit ag68kgas;
 {$ifdef GDB}
          if cs_debuginfo in aktswitches then
           begin
-            if not (hp^.typ in  [ait_external,ait_stabn,ait_stabs,ait_stab_function_name]) then
+            if not (hp^.typ in  [ait_external,ait_stabn,ait_stabs,
+                   ait_label,ait_cut,ait_align,ait_stab_function_name]) then
              begin
+{$ifdef NEWINPUT}
+               if assigned(hp^.infile) and (pinputfile(hp^.infile)<>infile)  then
+{$else}
                if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile)  then
+{$endif NEWINPUT}
                 begin
                   infile:=hp^.infile;
                   inc(includecount);
@@ -331,10 +342,6 @@ unit ag68kgas;
                      end;
    ait_const_32bit, { alignment is required for 16/32 bit data! }
    ait_const_16bit:  begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
                        AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
                        consttyp:=hp^.typ;
                        l:=0;
@@ -367,39 +374,19 @@ unit ag68kgas;
                        AsmLn;
                      end;
   ait_const_symbol : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
                        AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
                      end;
     ait_real_64bit : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
                       AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
                      end;
     ait_real_32bit : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
                       AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
                      end;
  ait_real_extended : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
                       AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
                      { comp type is difficult to write so use double }
                      end;
           ait_comp : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
                        AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
                      end;
         ait_direct : begin
@@ -443,6 +430,15 @@ unit ag68kgas;
                         end;
                      end;
          ait_label : begin
+                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
+                          [ait_const_32bit,ait_const_16bit,ait_const_symbol,
+                           ait_real_64bit,ait_real_32bit,ait_string]) then
+                        begin
+                          if not(cs_littlesize in aktswitches) then
+                           AsmWriteLn(#9#9'.align 4')
+                          else
+                           AsmWriteLn(#9#9'.align 2');
+                        end;
                        if (pai_label(hp)^.l^.is_used) then
                         AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
                      end;
@@ -475,10 +471,14 @@ ait_labeled_instruction : begin
                      end;
    ait_instruction : begin
                        { old versions of GAS don't like PEA.L and LEA.L }
-                       if (pai68k(hp)^._operator <> A_LEA) and (pai68k(hp)^._operator<> A_PEA) then
-                           s:=#9+mot_op2str[pai68k(hp)^._operator]+gas_opsize2str[pai68k(hp)^.size]
+                       if (pai68k(hp)^._operator in [
+                            A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
+                            A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
+                            A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
+                            A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
+                        s:=#9+mot_op2str[pai68k(hp)^._operator]
                        else
-                           s:=#9+mot_op2str[pai68k(hp)^._operator];
+                        s:=#9+mot_op2str[pai68k(hp)^._operator]+mit_opsize2str[pai68k(hp)^.size];
                        if pai68k(hp)^.op1t<>top_none then
                         begin
                         { call and jmp need an extra handling                          }
@@ -526,21 +526,27 @@ ait_labeled_instruction : begin
                      end;
 ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 {$endif GDB}
-{$ifdef SMARTLINK}
-           ait_cut : begin { used to split into tiny assembler files }
-                       if (cs_smartlink in aktswitches) then
+           ait_cut : begin
+                     { create only a new file when the last is not empty }
+                       if AsmSize>0 then
                         begin
                           AsmClose;
                           DoAssemble;
                           AsmCreate;
-                          AsmWriteLn(ait_section2str[lastsec]);
-                        { avoid empty files }
-                          while assigned(hp^.next) and (pai(hp^.next)^.typ=ait_cut) do
-                           hp:=pai(hp^.next);
                         end;
+                     { avoid empty files }
+                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
+                        begin
+                          if pai(hp^.next)^.typ=ait_section then
+                           begin
+                             lastsec:=pai_section(hp^.next)^.sec;
+                             lastsecidx:=pai_section(hp^.next)^.idataidx;
+                           end;
+                          hp:=pai(hp^.next);
+                        end;
+                       if lastsec<>sec_none then
+                         AsmWriteLn(ait_section2str[lastsec,lastsecidx]);
                      end;
-{$endif SMARTLINK}
-
          else
           internalerror(10000);
          end;
@@ -584,8 +590,13 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
        end;
       infile:=current_module^.sourcefiles.files;
     { main source file is last in list }
+{$ifdef NEWINPUT}
+      while assigned(infile^.next) do
+       infile:=infile^.next;
+{$else}
       while assigned(infile^._next) do
        infile:=infile^._next;
+{$endif}
       lastline:=0;
 {$endif GDB}
 
@@ -612,7 +623,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 end.
 {
   $Log$
-  Revision 1.5  1998-06-05 17:46:04  peter
+  Revision 1.6  1998-07-10 10:50:54  peter
+    * m68k updates
+
+  Revision 1.5  1998/06/05 17:46:04  peter
     * tp doesn't like comp() typecast
 
   Revision 1.4  1998/06/04 23:51:28  peter

compiler/ag68kmit.pas

@@ -55,7 +55,13 @@ unit ag68kmit;
 
 {$ifdef GDB}
     var
+{$ifdef NEWINPUT}
+      infile : pinputfile;
+{$else}
+
       infile : pextfile;
+{$endif}
+
       includecount,
       lastline : longint;
 {$endif GDB}
@@ -250,6 +256,7 @@ unit ag68kmit;
       n_line  : byte;     { different types of source lines }
 {$endif}
       lastsec : tsection; { last section type written }
+      lastsecidx : longint;
 
     const
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
@@ -284,9 +291,14 @@ unit ag68kmit;
 {$ifdef GDB}
          if cs_debuginfo in aktswitches then
           begin
-            if not (hp^.typ in  [ait_external,ait_stabn,ait_stabs,ait_stab_function_name]) then
+            if not (hp^.typ in  [ait_external,ait_stabn,ait_stabs,
+                   ait_label,ait_cut,ait_align,ait_stab_function_name]) then
              begin
+{$ifdef NEWINPUT}
+               if assigned(hp^.infile) and (pinputfile(hp^.infile)<>infile)  then
+{$else}
                if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile)  then
+{$endif NEWINPUT}
                 begin
                   infile:=hp^.infile;
                   inc(includecount);
@@ -367,10 +379,6 @@ unit ag68kmit;
                      end;
    ait_const_32bit, { alignment is required for 16/32 bit data! }
    ait_const_16bit:  begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
                        AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
                        consttyp:=hp^.typ;
                        l:=0;
@@ -402,42 +410,20 @@ unit ag68kmit;
                        until (not found) or (l>line_length);
                        AsmLn;
                      end;
-  ait_const_symbol : begin
-                       if not(cs_littlesize in aktswitches) then
-                         AsmWriteLn(#9#9'.align 4')
-                       else
-                         AsmWriteLn(#9#9'.align 2');
-                       AsmWrite(#9'.long'#9);
-                       AsmWritePChar(pchar(pai_const(hp)^.value));
-                       AsmLn;
+  ait_const_symbol : Begin
+                       AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
                      end;
     ait_real_64bit : Begin
-                       if not(cs_littlesize in aktswitches) then
-                         AsmWriteLn(#9#9'.align 4')
-                       else
-                         AsmWriteLn(#9#9'.align 2');
                        AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
                      end;
     ait_real_32bit : Begin
-                       if not(cs_littlesize in aktswitches) then
-                         AsmWriteLn(#9#9'.align 4')
-                       else
-                         AsmWriteLn(#9#9'.align 2');
                        AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
                      end;
  ait_real_extended : Begin
-                       if not(cs_littlesize in aktswitches) then
-                         AsmWriteLn(#9#9'.align 4')
-                       else
-                         AsmWriteLn(#9#9'.align 2');
                        AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
                      { comp type is difficult to write so use double }
                      end;
           ait_comp : Begin
-                       if not(cs_littlesize in aktswitches) then
-                         AsmWriteLn(#9#9'.align 4')
-                       else
-                         AsmWriteLn(#9#9'.align 2');
                        AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
                      end;
         ait_direct : begin
@@ -481,6 +467,15 @@ unit ag68kmit;
                         end;
                      end;
          ait_label : begin
+                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
+                          [ait_const_32bit,ait_const_16bit,ait_const_symbol,
+                           ait_real_64bit,ait_real_32bit,ait_string]) then
+                        begin
+                          if not(cs_littlesize in aktswitches) then
+                           AsmWriteLn(#9#9'.align 4')
+                          else
+                           AsmWriteLn(#9#9'.align 2');
+                        end;
                        if (pai_label(hp)^.l^.is_used) then
                         AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
                      end;
@@ -568,6 +563,27 @@ ait_labeled_instruction : begin
                      end;
 ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 {$endif GDB}
+           ait_cut : begin
+                     { create only a new file when the last is not empty }
+                       if AsmSize>0 then
+                        begin
+                          AsmClose;
+                          DoAssemble;
+                          AsmCreate;
+                        end;
+                     { avoid empty files }
+                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
+                        begin
+                          if pai(hp^.next)^.typ=ait_section then
+                           begin
+                             lastsec:=pai_section(hp^.next)^.sec;
+                             lastsecidx:=pai_section(hp^.next)^.idataidx;
+                           end;
+                          hp:=pai(hp^.next);
+                        end;
+                       if lastsec<>sec_none then
+                         AsmWriteLn(ait_section2str[lastsec,lastsecidx]);
+                     end;
          else
           internalerror(10000);
          end;
@@ -611,8 +627,13 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
        end;
       infile:=current_module^.sourcefiles.files;
     { main source file is last in list }
+{$ifdef NEWINPUT}
+      while assigned(infile^.next) do
+       infile:=infile^.next;
+{$else}
       while assigned(infile^._next) do
        infile:=infile^._next;
+{$endif}
       lastline:=0;
 {$endif GDB}
 
@@ -639,7 +660,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 end.
 {
   $Log$
-  Revision 1.5  1998-06-05 17:46:05  peter
+  Revision 1.6  1998-07-10 10:50:55  peter
+    * m68k updates
+
+  Revision 1.5  1998/06/05 17:46:05  peter
     * tp doesn't like comp() typecast
 
   Revision 1.4  1998/06/04 23:51:29  peter

compiler/ag68kmot.pas

@@ -300,39 +300,19 @@ unit ag68kmot;
                        AsmWriteLn(StrPas(pai_datablock(hp)^.name)+#9#9'DS.B '+tostr(pai_datablock(hp)^.size));
                      end;
    ait_const_32bit : Begin
-                        if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9'CNOP 0,4')
-                        else
-                           AsmWriteLn(#9'CNOP 0,2');
                        AsmWriteLn(#9#9'DC.L'#9+tostr(pai_const(hp)^.value));
                      end;
    ait_const_16bit : Begin
-                        if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9'CNOP 0,4')
-                        else
-                           AsmWriteLn(#9'CNOP 0,2');
                        AsmWriteLn(#9#9'DC.W'#9+tostr(pai_const(hp)^.value));
                      end;
     ait_const_8bit : AsmWriteLn(#9#9'DC.B'#9+tostr(pai_const(hp)^.value));
   ait_const_symbol : Begin
-                        if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9'CNOP 0,4')
-                        else
-                           AsmWriteLn(#9'CNOP 0,2');
                        AsmWriteLn(#9#9+'DC.L '#9+StrPas(pchar(pai_const(hp)^.value)));
                      end;
     ait_real_64bit : Begin
-                        if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9'CNOP 0,4')
-                        else
-                           AsmWriteLn(#9'CNOP 0,2');
                        AsmWriteLn(#9#9'DC.D'#9+double2str(pai_double(hp)^.value));
                      end;
     ait_real_32bit : Begin
-                        if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9'CNOP 0,4')
-                        else
-                           AsmWriteLn(#9'CNOP 0,2');
                        AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value));
                      end;
 { TO SUPPORT SOONER OR LATER!!!
@@ -411,6 +391,15 @@ unit ag68kmot;
                         AsmLn;
                       end;
           ait_label : begin
+                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
+                          [ait_const_32bit,ait_const_16bit,ait_const_symbol,
+                           ait_real_64bit,ait_real_32bit,ait_string]) then
+                        begin
+                          if not(cs_littlesize in aktswitches) then
+                           AsmWriteLn(#9'CNOP 0,4')
+                          else
+                           AsmWriteLn(#9'CNOP 0,2');
+                        end;
                         AsmWrite(lab2str(pai_label(hp)^.l));
                         if assigned(hp^.next) and not(pai(hp^.next)^.typ in
                            [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
@@ -521,12 +510,10 @@ ait_labeled_instruction :
       Writetree(exportssection);
       Writetree(resourcesection);
 
-
       AsmLn;
       AsmWriteLn(#9'END');
       AsmLn;
 
-
 {$ifdef EXTDEBUG}
       if assigned(current_module^.mainsource) then
        comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^);
@@ -536,7 +523,10 @@ ait_labeled_instruction :
 end.
 {
   $Log$
-  Revision 1.5  1998-06-05 17:46:06  peter
+  Revision 1.6  1998-07-10 10:50:56  peter
+    * m68k updates
+
+  Revision 1.5  1998/06/05 17:46:06  peter
     * tp doesn't like comp() typecast
 
   Revision 1.4  1998/06/04 23:51:30  peter

compiler/cg68k2.pas

@@ -55,8 +55,8 @@ Interface
     procedure second_while_repeatn(var p : ptree);
     procedure secondifn(var p : ptree);
     procedure secondbreakn(var p : ptree);
-    { copies p a set element on the stack }
-    procedure pushsetelement(var p : ptree);
+    { copies p a set element into the d0.b register }
+    procedure loadsetelement(var p : ptree);
 
 Implementation
 
@@ -192,13 +192,15 @@ Implementation
                            { on the right we do not need the register anymore too }
                            del_reference(p^.right^.location.reference);
                            pushusedregisters(pushedregs,$ffff);
-                           emitpushreferenceaddr(p^.left^.location.reference);
+                           { WE INVERSE THE PARAMETERS!!! }
+                           { Because parameters are inversed in the rtl }
                            emitpushreferenceaddr(p^.right^.location.reference);
+                           emitpushreferenceaddr(p^.left^.location.reference);
                            emitcall('STRCONCAT',true);
+                           maybe_loadA5;
+                           popusedregisters(pushedregs);
                            set_location(p^.location,p^.left^.location);
                            ungetiftemp(p^.right^.location.reference);
-                           maybe_loada5;
-                           popusedregisters(pushedregs);
                         end; { this case }
               ltn,lten,gtn,gten,
                 equaln,unequaln :
@@ -234,8 +236,22 @@ Implementation
                            else
                              begin
                                pushusedregisters(pushedregs,$ffff);
+
+                               { parameters are directly passed via registers       }
+                               { this has several advantages, no loss of the flags  }
+                               { on exit ,and MUCH faster on m68k machines          }
+                               {  speed difference (68000)                          }
+                               {   normal routine: entry, exit code + push  = 124   }
+                               {   (best case)                                      }
+                               {   assembler routine: param setup (worst case) = 48 }
+
+                               exprasmlist^.concat(new(pai68k,op_ref_reg(
+                                    A_LEA,S_L,newreference(p^.left^.location.reference),R_A0)));
+                               exprasmlist^.concat(new(pai68k,op_ref_reg(
+                                    A_LEA,S_L,newreference(p^.right^.location.reference),R_A1)));
+{
                                emitpushreferenceaddr(p^.left^.location.reference);
-                               emitpushreferenceaddr(p^.right^.location.reference);
+                               emitpushreferenceaddr(p^.right^.location.reference); }
                                emitcall('STRCMP',true);
                                maybe_loada5;
                                popusedregisters(pushedregs);
@@ -286,12 +302,13 @@ Implementation
                 ((p^.left^.resulttype^.deftype=orddef) and
                  (porddef(p^.left^.resulttype)^.typ=u32bit)) or
                  ((p^.right^.resulttype^.deftype=orddef) and
-                 (porddef(p^.right^.resulttype)^.typ=u32bit)) or
+                 (porddef(p^.right^.resulttype)^.typ=u32bit))
 
-                { as well as small sets }
+                 { SMALL SETS DO NOT WORK BECAUSE OF ENDIAN! }
+              or  { as well as small sets }
                 ((p^.left^.resulttype^.deftype=setdef) and
-                 (psetdef(p^.left^.resulttype)^.settype=smallset)
-                ) then
+                 (psetdef(p^.left^.resulttype)^.settype=smallset))
+                 then
                 begin
            do_normal:
                    mboverflow:=false;
@@ -332,7 +349,6 @@ Implementation
                                        Message(sym_e_type_mismatch);
                                     end;
                                end;
-
                       muln : begin
                                 if is_set then
                                   begin
@@ -905,8 +921,13 @@ Implementation
                                      del_reference(p^.left^.location.reference);
                                      del_reference(p^.right^.location.reference);
                                      pushusedregisters(pushedregs,$ffff);
-                                     emitpushreferenceaddr(p^.right^.location.reference);
-                                     emitpushreferenceaddr(p^.left^.location.reference);
+
+{                                     emitpushreferenceaddr(p^.right^.location.reference);
+                                     emitpushreferenceaddr(p^.left^.location.reference);}
+                                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+                                       newreference(p^.left^.location.reference),R_A0)));
+                                     exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+                                       newreference(p^.right^.location.reference),R_A1)));
                                      emitcall('SET_COMP_SETS',true);
                                      maybe_loada5;
                                      popusedregisters(pushedregs);
@@ -933,6 +954,8 @@ Implementation
                                          newcsymbol('SET_ADD_SETS',0))));
                                        muln : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
                                          newcsymbol('SET_MUL_SETS',0))));
+                                       symdifn:
+                                              emitcall('SET_SYMDIF_SETS',true);
                                      end;
                                      maybe_loada5;
                                      popusedregisters(pushedregs);
@@ -1389,25 +1412,30 @@ Implementation
 
 
 
-    { copies p a set element on the stack }
-    procedure pushsetelement(var p : ptree);
+    { This routine needs to be further checked to see if it works correctly  }
+    { because contrary to the intel version, all large set elements are read }
+    { as 32-bit values, and then decomposed to find the correct byte.        }
+    { CHECKED -> Requires 32-bit read.                                       }
+    procedure loadsetelement(var p : ptree);
 
       var
          hr : tregister;
 
       begin
-         { copy the element on the stack, slightly complicated }
+         { copy the element in the d0.b register, slightly complicated }
          case p^.location.loc of
             LOC_REGISTER,
             LOC_CREGISTER : begin
                               hr:=p^.location.register;
-                              exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,hr,R_SPPUSH)));
+                              emit_reg_reg(A_MOVE,S_L,hr,R_D0);
                               ungetregister32(hr);
                            end;
             else
                begin
-                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
-                    newreference(p^.location.reference),R_SPPUSH)));
+                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
+                    newreference(p^.location.reference),R_D0)));
+{                  exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                    $ff,R_D0))); }
                   del_reference(p^.location.reference);
                end;
          end;
@@ -1491,7 +1519,7 @@ Implementation
                                     end;
                         end;
                 analizeset:=true;
-            end;
+            end;  { end analizeset }
 
       begin
          if psetdef(p^.right^.resulttype)^.settype=smallset then
@@ -1504,19 +1532,22 @@ Implementation
                    if codegenerror then
                      exit;
                    p^.location.resflags:=F_NE;
+                   { Because of the Endian of the m68k, we have to consider this as a  }
+                   { normal set and load it byte per byte, otherwise we will never get }
+                   { the correct result.                                               }
                        case p^.right^.location.loc of
-                      LOC_REGISTER,LOC_CREGISTER : begin
+                     LOC_REGISTER,LOC_CREGISTER :
+                       begin
                                                     emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
                                                     exprasmlist^.concat(new(pai68k,
-                                                      op_const_reg(A_AND,S_L, 1 shl
-                                                       (p^.left^.value and 31),R_D1)));
+                           op_const_reg(A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
                                                    end;
                       else
                        begin
                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
                              p^.right^.location.reference),R_D1)));
                            exprasmlist^.concat(new(pai68k,op_const_reg(
-                             A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
+                           A_AND,S_L,1 shl (p^.left^.value and 31) ,R_D1)));
                        end;
                    end;
                    del_reference(p^.right^.location.reference);
@@ -1545,7 +1576,7 @@ Implementation
                             { the set element isn't never samller than a byte  }
                             { and because it's a small set we need only 5 bits }
                             { but 8 bits are eaiser to load                    }
-                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
+                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
                               newreference(p^.left^.location.reference),R_D1)));
                             hr:=R_D1;
                             del_reference(p^.left^.location.reference);
@@ -1581,7 +1612,7 @@ Implementation
                    p^.location.resflags:=F_C;
                 end;
            end
-         else
+         else { NOT a small set }
            begin
               if p^.left^.treetype=ordconstn then
                 begin
@@ -1591,11 +1622,11 @@ Implementation
                    if codegenerror then
                      exit;
                    p^.location.resflags:=F_NE;
-                   inc(p^.right^.location.reference.offset,p^.left^.value shr 3);
-                   exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_B,
+                   inc(p^.right^.location.reference.offset,(p^.left^.value div 32)*4);
+                   exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L,
                        newreference(p^.right^.location.reference), R_D1)));
-                   exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_B,
-                       1 shl (p^.left^.value and 7),R_D1)));
+                   exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_L,
+                       1 shl (p^.left^.value mod 32),R_D1)));
                del_reference(p^.right^.location.reference);
             end
           else
@@ -1614,11 +1645,17 @@ Implementation
                         LOC_CREGISTER :
                            exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
                              255,p^.left^.location.register)));
+                        else
+                         Begin
+                           exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
+                             newreference(p^.left^.location.reference),R_D0)));
+                           exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
+                             255,R_D0)));
+                         end;
                       end;
                             {Get a label to jump to the end.}
                             p^.location.loc:=LOC_FLAGS;
-                            {It's better to use the zero flag when there are
-                             no ranges.}
+                      {It's better to use the zero flag when there are no ranges.}
                             if ranges then
                                 p^.location.resflags:=F_C
                             else
@@ -1638,15 +1675,16 @@ Implementation
                                         href.symbol:=stringdup(lab2str(l2));
                                         if setparts[i].start=setparts[i].stop-1 then
                                         begin
-
                                           case p^.left^.location.loc of
                                            LOC_REGISTER,
                                            LOC_CREGISTER :
-                                                  exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
+                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
                                                     setparts[i].start,p^.left^.location.register)));
                                           else
-                                                  exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
-                                                    setparts[i].start,newreference(p^.left^.location.reference))));
+                                         exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                           setparts[i].start,R_D0)));
+{                                         exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                           setparts[i].start,newreference(p^.left^.location.reference))));}
                                           end;
                                           {Result should be in carry flag when ranges are used.}
                                           { Here the m68k does not affect any flag except the  }
@@ -1658,11 +1696,13 @@ Implementation
                                           case p^.left^.location.loc of
                                            LOC_REGISTER,
                                            LOC_CREGISTER :
-                                                exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
+                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
                                                  setparts[i].stop,p^.left^.location.register)));
                                           else
-                                                exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
-                                                 setparts[i].stop,newreference(p^.left^.location.reference))));
+                                      exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                        setparts[i].stop,R_D0)));
+{                                      exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                      setparts[i].stop,newreference(p^.left^.location.reference))));}
                                           end;
                                           {Result should be in carry flag when ranges are used.}
                                           { Here the m68k does not affect any flag except the  }
@@ -1681,11 +1721,13 @@ Implementation
                                            case p^.left^.location.loc of
                                                LOC_REGISTER,
                                                LOC_CREGISTER :
-                                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
+                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
                                                          setparts[i].start,p^.left^.location.register)));
                                           else
-                                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
-                                                         setparts[i].start,newreference(p^.left^.location.reference))));
+                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                        setparts[i].start,R_D0)));
+{                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                        setparts[i].start,newreference(p^.left^.location.reference)))); }
                                           end;
                                                         {If lower, jump to next check.}
                                                         emitl(A_BCS,l2);
@@ -1697,11 +1739,13 @@ Implementation
                                            case p^.left^.location.loc of
                                                LOC_REGISTER,
                                                LOC_CREGISTER :
-                                                            exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
+                                              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
                                                          setparts[i].stop+1,p^.left^.location.register)));
                                           else
-                                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
-                                                         setparts[i].stop+1,newreference(p^.left^.location.reference))));
+                                              exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                                setparts[i].stop+1,R_D0)));
+{                                              exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                                setparts[i].stop+1,newreference(p^.left^.location.reference))));}
                                           end; { end case }
                                                         {If higher, element is in set.}
                                                         emitl(A_BCS,l);
@@ -1716,11 +1760,13 @@ Implementation
                               case p^.left^.location.loc of
                                 LOC_REGISTER,
                                 LOC_CREGISTER :
-                                        exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B,
+                                     exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
                                          setparts[i].stop,p^.left^.location.register)));
                               else
-                                        exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
-                                         setparts[i].stop,newreference(p^.left^.location.reference))));
+{                                     exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
+                                     setparts[i].stop,newreference(p^.left^.location.reference))));}
+                                     exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
+                                      setparts[i].stop,R_D0)));
                               end;
                                         {Result should be in carry flag when ranges are used.}
                                         if ranges then
@@ -1750,27 +1796,20 @@ Implementation
                            { of course not commutative }
                            if p^.swaped then
                              swaptree(p);
-                           pushsetelement(p^.left);
-                           emitpushreferenceaddr(p^.right^.location.reference);
+                            { SET_IN_BYTE is an inline assembler procedure instead  }
+                            { of a normal procedure, which is *MUCH* faster         }
+                            { Parameters are passed by registers, and FLAGS are set }
+                            { according to the result.                              }
+                            { a0   = address of set                                 }
+                            { d0.b = value to compare with                          }
+                            { CARRY SET IF FOUND ON EXIT                            }
+                            loadsetelement(p^.left);
+                            exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
+                              newreference(p^.right^.location.reference),R_A0)));;
+{                            emitpushreferenceaddr(p^.right^.location.reference);}
                            del_reference(p^.right^.location.reference);
-                           { registers need not be save. that happens in SET_IN_BYTE }
                            emitcall('SET_IN_BYTE',true);
                      { ungetiftemp(p^.right^.location.reference); }
-                          { here we must set the flags manually  }
-                          { on returne from the routine, because }
-                          { flags are corrupt when restoring the }
-                          { stack                                }
-                          exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0)));
-                          getlabel(hl2);
-                          emitl(A_BEQ,hl2);
-                          exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_B,
-                            $fe,R_CCR)));
-                          getlabel(hl3);
-                          emitl(A_BRA,hl3);
-                          emitl(A_LABEL,hl2);
-                          exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,
-                             $01,R_CCR)));
-                          emitl(A_LABEL,hl3);
                           p^.location.loc:=LOC_FLAGS;
                           p^.location.resflags:=F_C;
                         end;
@@ -1921,7 +1960,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.5  1998-06-08 13:13:37  pierre
+  Revision 1.6  1998-07-10 10:51:00  peter
+    * m68k updates
+
+  Revision 1.5  1998/06/08 13:13:37  pierre
     + temporary variables now in temp_gen.pas unit
       because it is processor independent
     * mppc68k.bat modified to undefine i386 and support_mmx
@@ -1939,111 +1981,4 @@ end.
     + started inline procedures
     + added starstarn : use ** for exponentiation (^ gave problems)
     + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.2  1998/03/28 23:09:54  florian
-    * secondin bugfix (m68k and i386)
-    * overflow checking bugfix (m68k and i386) -- pretty useless in
-      secondadd, since everything is done using 32-bit
-    * loading pointer to routines hopefully fixed (m68k)
-    * flags problem with calls to RTL internal routines fixed (still strcmp
-      to fix) (m68k)
-    * #ELSE was still incorrect (didn't take care of the previous level)
-    * problem with filenames in the command line solved
-    * problem with mangledname solved
-    * linking name problem solved (was case insensitive)
-    * double id problem and potential crash solved
-    * stop after first error
-    * and=>test problem removed
-    * correct read for all float types
-    * 2 sigsegv fixes and a cosmetic fix for Internal Error
-    * push/pop is now correct optimized (=> mov (%esp),reg)
-
-  Revision 1.1.1.1  1998/03/25 11:18:13  root
-  * Restored version
-
-  Revision 1.18  1998/03/10 01:17:15  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.17  1998/03/09 10:44:34  peter
-    + string='', string<>'', string:='', string:=char optimizes (the first 2
-      were already in cg68k2)
-
-  Revision 1.16  1998/03/06 00:52:02  peter
-    * replaced all old messages from errore.msg, only ExtDebug and some
-      Comment() calls are left
-    * fixed options.pas
-
-  Revision 1.15  1998/03/02 01:48:15  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.14  1998/02/14 05:05:43  carl
-    + now compiles under TP with overlays
-
-  Revision 1.13  1998/02/13 10:34:44  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.12  1998/02/12 11:49:49  daniel
-  Yes! Finally! After three retries, my patch!
-
-  Changes:
-
-  Complete rewrite of psub.pas.
-  Added support for DLL's.
-  Compiler requires less memory.
-  Platform units for each platform.
-
-  Revision 1.11  1998/02/07 06:51:51  carl
-    + moved secondraise from cg68k
-
-  Revision 1.10  1998/02/05 21:54:31  florian
-    + more MMX
-
-  Revision 1.9  1998/02/05 00:59:29  carl
-    + added secondas
-
-  Revision 1.8  1998/02/01 17:13:26  florian
-    + comparsion of class references
-
-  Revision 1.7  1998/01/21 22:34:23  florian
-    + comparsion of Delphi classes
-
-  Revision 1.6  1998/01/11 03:37:18  carl
-  * bugfix of muls.l under MC68000 target
-  * long subtract bugfix
-
-  Revision 1.3  1997/12/10 23:07:15  florian
-  * bugs fixed: 12,38 (also m68k),39,40,41
-  + warning if a system unit is without -Us compiled
-  + warning if a method is virtual and private (was an error)
-  * some indentions changed
-  + factor does a better error recovering (omit some crashes)
-  + problem with @type(x) removed (crashed the compiler)
-
-  Revision 1.2  1997/12/04 15:15:05  carl
-  + updated to v099.
-
-  Revision 1.1.1.1  1997/11/27 08:32:53  michael
-  FPC Compiler CVS start
-
-
-  Pre-CVS log:
-
-
-  FK     Florian Klaempfl
-  +      feature added
-  -      removed
-  *      bug fixed or changed
-
-  History:
-       8th october 1997:
-         + only a cmpb $0,_S is generated if s is a string and a
-           s='' or s<>'' is performed (FK)
-      17th october 1997:
-         + unit started (CEC)
-
 }

compiler/cga68k.pas

@@ -76,6 +76,10 @@ unit cga68k;
     uses
        systems,globals,verbose,files,types,pbase,
        tgen68k,hcodegen,temp_gen
+{$ifndef OLDPPU}
+       ,ppu
+{$endif}
+
 {$ifdef GDB}
        ,gdb
 {$endif}
@@ -1216,7 +1220,10 @@ end;
   end.
 {
   $Log$
-  Revision 1.6  1998-06-08 13:13:39  pierre
+  Revision 1.7  1998-07-10 10:51:01  peter
+    * m68k updates
+
+  Revision 1.6  1998/06/08 13:13:39  pierre
     + temporary variables now in temp_gen.pas unit
       because it is processor independent
     * mppc68k.bat modified to undefine i386 and support_mmx

compiler/ra68kmot.pas

@@ -236,15 +236,11 @@ var
     {* INIT TOKEN TO NOTHING *}
     token := AS_NONE;
     { while space and tab , continue scan... }
-    while (c = ' ') or (c = #9) do
-    begin
-      c := asmgetchar;
-    end;
+    while c in [' ',#9] do
+     c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
+    {$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
     { Possiblities for first token in a statement:                }
     {   Local Label, Label, Directive, Prefix or Opcode....       }
-    tokenpos.line:=current_module^.current_inputfile^.line_no;
-    tokenpos.column:=get_file_col;
-    tokenpos.fileindex:=current_module^.current_index;
     if firsttoken and not (c in [newline,#13,'{',';']) then
     begin
 
@@ -253,7 +249,7 @@ var
       begin
         token := AS_LLABEL;   { this is a local label }
         { Let us point to the next character }
-        c := asmgetchar;
+        c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
       end;
 
 
@@ -263,7 +259,7 @@ var
          { if there is an at_sign, then this must absolutely be a label }
          if c = '@' then forcelabel:=TRUE;
          actasmpattern := actasmpattern + c;
-         c := asmgetchar;
+         c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
       end;
 
       uppervar(actasmpattern);
@@ -275,7 +271,7 @@ var
              AS_LLABEL: ; { do nothing }
            end; { end case }
            { let us point to the next character }
-           c := asmgetchar;
+           c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
            gettoken := token;
            exit;
       end;
@@ -311,11 +307,11 @@ var
                 {                - @Result, @Code or @Data special variables.     }
                             begin
                              actasmpattern := c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              while c in  ['A'..'Z','a'..'z','0'..'9','_','@','.'] do
                              begin
                                actasmpattern := actasmpattern + c;
-                               c := asmgetchar;
+                               c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              end;
                              uppervar(actasmpattern);
                              gettoken := AS_ID;
@@ -324,11 +320,11 @@ var
       { identifier, register, opcode, prefix or directive }
          'A'..'Z','a'..'z','_': begin
                              actasmpattern := c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              while c in  ['A'..'Z','a'..'z','0'..'9','_','.'] do
                              begin
                                actasmpattern := actasmpattern + c;
-                               c := asmgetchar;
+                               c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              end;
                              uppervar(actasmpattern);
 
@@ -354,7 +350,7 @@ var
                           end;
            { override operator... not supported }
            '&':       begin
-                         c:=asmgetchar;
+                         c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                          gettoken := AS_AND;
                       end;
            { string or character }
@@ -365,7 +361,7 @@ var
                          begin
                            if c = '''' then
                            begin
-                              c:=asmgetchar;
+                              c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                               if c=newline then
                               begin
                                  Message(scan_f_string_exceeds_line);
@@ -374,11 +370,11 @@ var
                               repeat
                                   if c=''''then
                                    begin
-                                       c:=asmgetchar;
+                                       c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                        if c='''' then
                                         begin
                                                actasmpattern:=actasmpattern+'''';
-                                               c:=asmgetchar;
+                                               c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                                if c=newline then
                                                begin
                                                     Message(scan_f_string_exceeds_line);
@@ -390,7 +386,7 @@ var
                                    else
                                    begin
                                           actasmpattern:=actasmpattern+c;
-                                          c:=asmgetchar;
+                                          c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                           if c=newline then
                                             begin
                                                Message(scan_f_string_exceeds_line);
@@ -406,101 +402,101 @@ var
                    exit;
                  end;
            '$' :  begin
-                    c:=asmgetchar;
+                    c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                     while c in ['0'..'9','A'..'F','a'..'f'] do
                     begin
                       actasmpattern := actasmpattern + c;
-                      c := asmgetchar;
+                      c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                     end;
                    gettoken := AS_HEXNUM;
                    exit;
                   end;
            ',' : begin
                    gettoken := AS_COMMA;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '(' : begin
                    gettoken := AS_LPAREN;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            ')' : begin
                    gettoken := AS_RPAREN;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            ':' : begin
                    gettoken := AS_COLON;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
 {           '.' : begin
                    gettoken := AS_DOT;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end; }
            '+' : begin
                    gettoken := AS_PLUS;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '-' : begin
                    gettoken := AS_MINUS;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '*' : begin
                    gettoken := AS_STAR;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '/' : begin
                    gettoken := AS_SLASH;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '<' : begin
-                   c := asmgetchar;
+                   c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    { invalid characters }
                    if c <> '<' then
                     Message(assem_e_invalid_char_smaller);
                    { still assume << }
                    gettoken := AS_SHL;
-                   c := asmgetchar;
+                   c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '>' : begin
-                   c := asmgetchar;
+                   c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    { invalid characters }
                    if c <> '>' then
                     Message(assem_e_invalid_char_greater);
                    { still assume << }
                    gettoken := AS_SHR;
-                   c := asmgetchar;
+                   c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '|' : begin
                    gettoken := AS_OR;
-                   c := asmgetchar;
+                   c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '^' : begin
                   gettoken := AS_XOR;
-                  c := asmgetchar;
+                  c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                   exit;
                  end;
            '#' : begin
                   gettoken:=AS_APPT;
-                  c:=asmgetchar;
+                  c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                   exit;
                  end;
            '%' : begin
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    while c in ['0','1'] do
                    Begin
                      actasmpattern := actasmpattern + c;
-                     c := asmgetchar;
+                     c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    end;
                    gettoken := AS_BINNUM;
                    exit;
@@ -508,25 +504,25 @@ var
            { integer number }
            '0'..'9': begin
                         actasmpattern := c;
-                        c := asmgetchar;
+                        c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                         while c in ['0'..'9'] do
                           Begin
                              actasmpattern := actasmpattern + c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           end;
                         gettoken := AS_INTNUM;
                         exit;
                      end;
          ';' : begin
                   repeat
-                     c:=asmgetchar;
+                     c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                   until c=newline;
                   firsttoken := TRUE;
                   gettoken:=AS_SEPARATOR;
                end;
 
          '{',#13,newline : begin
-                            c:=asmgetchar;
+                            c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                             firsttoken := TRUE;
                             gettoken:=AS_SEPARATOR;
                            end;
@@ -753,6 +749,7 @@ var
   if fits then
   Begin
     case instr.numops of
+
      0:
         if instr.stropsize <> S_NO then
           p^.concat(new(pai68k,op_none(instruc,instr.stropsize)))
@@ -760,6 +757,10 @@ var
           p^.concat(new(pai68k,op_none(instruc,S_NO)));
      1: Begin
           case instr.operands[1].operandtype of
+           OPR_SYMBOL: Begin
+                             p^.concat(new(pai68k,op_ref(instruc,
+                               instr.stropsize, newreference(instr.operands[1].ref))));
+                         end;
            OPR_CONSTANT: Begin
                              p^.concat(new(pai68k,op_const(instruc,
                                instr.stropsize, instr.operands[1].val)));
@@ -1679,6 +1680,8 @@ var
                    Begin
                       InitAsmRef(instr);
                       instr.operands[operandnum].ref.offset:=BuildRefExpression;
+                      { negate because was preceded by a negative sign! }
+                      instr.operands[operandnum].ref.offset:=-instr.operands[operandnum].ref.offset;
                       BuildReference(instr);
                    end
                    else
@@ -2030,7 +2033,7 @@ var
     store_p:=p;
     { setup label linked list }
     labellist.init;
-    c:=asmgetchar;
+    c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
     actasmtoken:=gettoken;
     while actasmtoken<>AS_END do
     Begin
@@ -2174,7 +2177,10 @@ Begin
 end.
 {
   $Log$
-  Revision 1.2  1998-06-24 14:06:39  peter
+  Revision 1.3  1998-07-10 10:51:02  peter
+    * m68k updates
+
+  Revision 1.2  1998/06/24 14:06:39  peter
     * fixed the name changes
 
   Revision 1.1  1998/06/23 14:00:20  peter

compiler/symdef.inc

@@ -204,12 +204,14 @@
       if assigned(sym) then
         begin
            name := sym^.name;
-{$ifdef NEWINPUT}       
+{$ifdef NEWINPUT}
+
 
            sym_line_no:=sym^.fileinfo.line;
 {$else}
            sym_line_no:=sym^.line_no;
-{$endif}        
+{$endif}
+
 
         end
       else
@@ -853,22 +855,42 @@
     procedure tfiledef.setsize;
       begin
 {$ifdef i386}
-
          case target_info.target of
-            target_LINUX:
+      target_LINUX : begin
+                       case filetype of
+                     ft_text : savesize:=432;
+                    ft_typed,
+                  ft_untyped : savesize:=304;
+                       end;
+                     end;
+      target_Win32 : begin
+                       case filetype of
+                     ft_text : savesize:=434;
+                    ft_typed,
+                  ft_untyped : savesize:=306;
+                       end;
+                     end;
+
+         else
            begin
               case filetype of
-                 ft_text : savesize:=432;
-                 ft_typed,ft_untyped : savesize:=304;
+                 ft_text : savesize:=256;
+                 ft_typed,ft_untyped : savesize:=128;
               end;
            end;
-            target_Win32:
-              begin
-                 case filetype of
-                    ft_text : savesize:=434;
-                    ft_typed,ft_untyped : savesize:=306;
-                 end;
-           end
+         end;
+{$endif}
+{$ifdef m68k}
+         case target_info.target of
+      target_Amiga,
+     target_Mac68k : begin
+                       case filetype of
+                     ft_text : savesize:=434;
+                    ft_typed,
+                  ft_untyped : savesize:=306;
+                       end;
+                     end;
+
          else
            begin
               case filetype of
@@ -876,16 +898,8 @@
                  ft_typed,ft_untyped : savesize:=128;
               end;
            end;
-      end;
-{$endif}
-{$ifdef m68k}
-        case filetype of
-          ft_text : savesize:=256;
-         ft_typed,
-       ft_untyped : savesize:=128;
-        end;
+         end;
 {$endif}
-
       end;
 
 
@@ -1051,12 +1065,14 @@
                 if assigned(sym) then
                   begin
                      st := sym^.name;
-{$ifdef NEWINPUT}       
+{$ifdef NEWINPUT}
+
 
                      sym_line_no:=sym^.fileinfo.line;
 {$else}
                      sym_line_no:=sym^.line_no;
-{$endif}        
+{$endif}
+
 
                   end
                 else
@@ -2658,9 +2674,8 @@
 
 {
   $Log$
-  Revision 1.17  1998-07-10 00:00:03  peter
-    * fixed ttypesym bug finally
-    * fileinfo in the symtable and better using for unused vars
+  Revision 1.18  1998-07-10 10:51:04  peter
+    * m68k updates
 
   Revision 1.16  1998/07/07 11:20:13  peter
     + NEWINPUT for a better inputfile and scanner object

compiler/temp_gen.pas

@@ -106,10 +106,19 @@ unit temp_gen;
     procedure setfirsttemp(l : longint);
 
       begin
-         { generates problems
-         if (l mod 4 <> 0) then dec(l,l mod 4);}
+         { this is a negative value normally }
+         if l < 0 then
+          Begin
+            if odd(l) then
+             Dec(l);
+          end
+         else
+          Begin
+            if odd(l) then
+             Inc(l);
+          end;
          firsttemp:=l;
-         maxtemp := l;
+         maxtemp:=l;
          lastoccupied:=l;
       end;
 
@@ -194,9 +203,21 @@ unit temp_gen;
     function gettempsize : longint;
 
       begin
+{$ifdef i386}
+
          { align local data to dwords }
          if (maxtemp mod 4)<>0 then
            dec(maxtemp,4+(maxtemp mod 4));
+{$endif}
+{$ifdef m68k}   
+
+         { we only push words and we want to stay on }
+         { even stack addresses                      }
+         { maxtemp is negative                       }
+         if (maxtemp mod 2)<>0 then
+           dec(maxtemp);
+{$endif}        
+
          gettempsize:=-maxtemp;
       end;
 
@@ -242,7 +263,8 @@ unit temp_gen;
                      ' at pos '+tostr(pos)+ ' not found !');
 {$endif}
       end;
-      
+
+
     procedure ungetpersistanttemp(pos : longint;size : longint);
       var
          prev,hp : pfreerecord;
@@ -426,7 +448,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  1998-06-08 16:07:41  pierre
+  Revision 1.2  1998-07-10 10:51:05  peter
+    * m68k updates
+
+  Revision 1.1  1998/06/08 16:07:41  pierre
     * temp_gen contains all temporary var functions
       (processor independent)