瀏覽代碼

* merged more x86-64/i386 code

florian 22 年之前
父節點
當前提交
de6916276a

+ 5 - 2
compiler/i386/ra386att.pas

@@ -48,7 +48,7 @@ Implementation
        nbas,
        { parser }
        scanner,
-       ra386,agx86att,rautils
+       rax86,agx86att,rautils
        ;
 
 type
@@ -2133,7 +2133,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.42  2003-04-25 12:04:31  florian
+  Revision 1.43  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.42  2003/04/25 12:04:31  florian
     * merged agx64att and ag386att to x86/agx86att
 
   Revision 1.41  2003/04/21 20:05:10  peter

+ 5 - 2
compiler/i386/ra386int.pas

@@ -50,7 +50,7 @@ Implementation
        rgobj,
        { register allocator }
        scanner,
-       rautils,ra386,ag386int,
+       rautils,rax86,ag386int,
        { codegen }
        cgbase
        ;
@@ -1961,7 +1961,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.46  2003-04-27 11:21:35  peter
+  Revision 1.47  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.46  2003/04/27 11:21:35  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

+ 7 - 1
compiler/ncgflw.pas

@@ -809,8 +809,11 @@ implementation
                   cg.a_jmp_always(exprasmlist,aktexit2label);
                   r.enum:=R_INTREGISTER;
                   r.number:=NR_ACCUMULATOR;
+{$ifndef cpu64bit}
                   hreg.enum:=R_INTREGISTER;
                   hreg.number:=NR_ACCUMULATORHIGH;
+{$endif cpu64bit}
+
                   if allocated_acc then
                     cg.a_reg_dealloc(exprasmlist,r);
 {$ifndef cpu64bit}
@@ -1531,7 +1534,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.57  2003-04-29 07:29:14  michael
+  Revision 1.58  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.57  2003/04/29 07:29:14  michael
   + Patch from peter to fix wrong pushing of ansistring function results in open array
 
   Revision 1.56  2003/04/27 11:21:33  peter

+ 6 - 3
compiler/systems/i_linux.pas

@@ -286,7 +286,7 @@ unit i_linux;
 
        system_x86_64_linux_info : tsysteminfo =
           (
-            system       : system_i386_LINUX;
+            system       : system_x86_64_LINUX;
             name         : 'Linux for x86-64';
             shortname    : 'linux';
             flags        : [];
@@ -435,7 +435,7 @@ initialization
 {$endif CPU86_64}
 {$ifdef CPUALPHA}
   {$ifdef linux}
-    set_source_info(system_sparc_linux_info);
+    set_source_info(system_alpha_linux_info);
   {$endif linux}
 {$endif CPUALPHA}
 {$ifdef CPUSPARC}
@@ -446,7 +446,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.4  2003-02-06 22:36:55  mazen
+  Revision 1.5  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.4  2003/02/06 22:36:55  mazen
   * fixing bug related to errornous program main entry stack frame
 
   Revision 1.3  2003/01/11 16:35:15  marco

+ 17 - 3
compiler/i386/radirect.pas → compiler/x86/radirect.pas

@@ -47,7 +47,7 @@ interface
        nbas,
        { parser }
        scanner,
-       ra386,
+       rax86,
        { codegen }
        cgbase,
        { constants }
@@ -296,19 +296,33 @@ interface
 *****************************************************************************}
 
 const
+{$ifdef x86_64}
+  asmmode_x86_64_direct_info : tasmmodeinfo =
+          (
+            id    : asmmode_direct;
+            idtxt : 'DIRECT'
+          );
+{$else x86_64}
   asmmode_i386_direct_info : tasmmodeinfo =
           (
             id    : asmmode_direct;
             idtxt : 'DIRECT'
           );
+{$endif x86_64}
 
 initialization
+{$ifdef x86_64}
+  RegisterAsmMode(asmmode_x86_64_direct_info);
+{$else x86_64}
   RegisterAsmMode(asmmode_i386_direct_info);
-
+{$endif x86_64}
 end.
 {
   $Log$
-  Revision 1.11  2003-04-27 11:21:36  peter
+  Revision 1.1  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.11  2003/04/27 11:21:36  peter
     * aktprocdef renamed to current_procdef
     * procinfo renamed to current_procinfo
     * procinfo will now be stored in current_module so it can be

+ 9 - 3
compiler/i386/ra386.pas → compiler/x86/rax86.pas

@@ -2,7 +2,7 @@
     $Id$
     Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
 
-    Handles the common i386 assembler reader routines
+    Handles the common x86 assembler reader routines
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -20,7 +20,10 @@
 
  ****************************************************************************
 }
-unit Ra386;
+{
+  Contains the common x86 (i386 and x86-64) assembler reader routines.
+}
+unit rax86;
 
 {$i fpcdefs.inc}
 
@@ -680,7 +683,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.30  2003-04-25 12:04:31  florian
+  Revision 1.1  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.30  2003/04/25 12:04:31  florian
     * merged agx64att and ag386att to x86/agx86att
 
   Revision 1.29  2003/02/19 22:00:16  daniel

+ 8 - 1
compiler/x86_64/cgcpu.pas

@@ -55,6 +55,7 @@ unit cgcpu;
          srcref,dstref : treference;
          swap : boolean;
 
+{!!!
          procedure maybepushecx;
          begin
            if not(R_ECX in rg.unusedregsint) then
@@ -64,8 +65,10 @@ unit cgcpu;
              end
            else rg.getexplicitregisterint(list,R_ECX);
          end;
+}
 
       begin
+{!!!
          if (not loadref) and
             ((len<=8) or
              (not(cs_littlesize in aktglobalswitches ) and (len<=12))) then
@@ -166,6 +169,7 @@ unit cgcpu;
            end;
          if delsource then
           tg.ungetiftemp(list,source);
+}
       end;
 begin
   cg:=tcgx86_64.create;
@@ -173,7 +177,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2003-01-05 13:36:54  florian
+  Revision 1.4  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.3  2003/01/05 13:36:54  florian
     * x86-64 compiles
     + very basic support for float128 type (x86-64 only)
 

+ 99 - 25
compiler/x86_64/cpubase.inc

@@ -74,13 +74,76 @@ const
 *****************************************************************************}
 
     const
-      firstsaveintreg = R_EAX;
-      lastsaveintreg  = R_R15;
+      firstsaveintreg = RS_RAX;
+      lastsaveintreg  = RS_R15;
       firstsavefpureg = R_NO;
       lastsavefpureg  = R_NO;
       firstsavemmreg  = R_XMM0;
       lastsavemmreg   = R_XMM15;
 
+      general_registers = [R_EAX,R_EBX,R_ECX,R_EDX];
+      general_superregisters = [RS_RAX,RS_RBX,RS_RCX,RS_RDX];
+
+{$ifdef newra}
+      usableregsint = [first_imreg..last_imreg];
+{$else}
+      usableregsint = [RS_RAX,RS_RBX,RS_RCX,RS_RDX];
+{$endif}
+      c_countusableregsint = 4;
+
+      maxaddrregs = 1;
+      addrregs    = [R_ESI];
+      usableregsaddr = [RS_RSI];
+      c_countusableregsaddr = 1;
+
+      maxvarregs = 4;
+      varregs : array[1..maxvarregs] of Toldregister =
+         (R_EBX,R_EDX,R_ECX,R_EAX);
+
+      maxfpuvarregs = 8;
+
+      {# Registers which are defined as scratch and no need to save across
+         routine calls or in assembler blocks.
+      }
+{$ifndef newra}
+      max_scratch_regs = 1;
+      scratch_regs : array[1..max_scratch_regs] of Tsuperregister = (RS_RDI);
+{$endif}
+
+{*****************************************************************************
+                               GDB Information
+*****************************************************************************}
+
+      {# Register indexes for stabs information, when some
+         parameters or variables are stored in registers.
+
+         Taken from i386.c (dbx_register_map) and i386.h
+          (FIXED_REGISTERS) from GCC 3.x source code
+
+      }
+      stab_regindex : array[firstreg..lastreg] of shortint =
+        (-1,
+        0,1,2,3,4,5,6,7, {!!!! FIX ME }
+        0,1,2,3,4,5,6,7,7, {!!!! FIX ME }
+
+        0,1,2,3,4,5,6,7,
+        0,1,2,3,4,5,6,7, {!!!! FIX ME }
+
+        0,1,2,3,4,5,6,7,
+        0,1,2,3,4,5,6,7, {!!!! FIX ME }
+
+        0,1,2,3,4,5,6,7,
+        0,1,2,3,4,5,6,7, {!!!! FIX ME }
+        0,1,2,3,
+        -1,-1,-1,-1,-1,-1,
+        12,12,13,14,15,16,17,18,19,
+        -1,-1,-1,-1,-1,-1,
+        -1,-1,-1,-1,
+        -1,-1,-1,-1,-1,
+        29,30,31,32,33,34,35,36,
+        21,22,23,24,25,26,27,28,
+        21,22,23,24,25,26,27,28
+      );
 
 {*****************************************************************************
                           Default generic sizes
@@ -99,28 +162,33 @@ const
                           Generic Register names
 *****************************************************************************}
 
-       { location of function results }
-
-       stack_pointer_reg = R_RSP;
-       frame_pointer_reg = R_RBP;
-       self_pointer_reg  = R_RSI;
-       accumulator   = R_RAX;
-       { the return_result_reg, is used inside the called function to store its return
-         value when that is a scalar value otherwise a pointer to the address of the
-         result is placed inside it }
-       return_result_reg   = accumulator;
-
-       { the function_result_reg contains the function result after a call to a scalar
-         function othewise it contains a pointer to the returned result}
-       function_result_reg = accumulator;
-       accumulatorhigh = R_RDX;
-       { the register where the vmt offset is passed to the destructor }
-       { helper routine                                                }
-       vmt_offset_reg = R_RDI;
-
-       resultreg = R_RAX;
-       resultreg64 = R_RAX;
-       fpu_result_reg = R_ST;
+      {# Stack pointer register }
+      stack_pointer_reg = R_RSP;
+      NR_STACK_POINTER_REG = NR_RSP;
+      {# Frame pointer register }
+      frame_pointer_reg = R_RBP;
+      NR_FRAME_POINTER_REG = NR_RBP;
+      { Register for addressing absolute data in a position independant way,
+        such as in PIC code. The exact meaning is ABI specific. For
+        further information look at GCC source : PIC_OFFSET_TABLE_REGNUM
+      }
+      pic_offset_reg = R_EBX;
+      accumulator = R_RAX;
+      RS_ACCUMULATOR = RS_RAX;
+      NR_ACCUMULATOR = NR_RAX;
+      { the return_result_reg, is used inside the called function to store its return
+        value when that is a scalar value otherwise a pointer to the address of the
+        result is placed inside it }
+      return_result_reg   = accumulator;
+      RS_RETURN_RESULT_REG = RS_ACCUMULATOR;
+      NR_RETURN_RESULT_REG = NR_ACCUMULATOR;
+
+      { the function_result_reg contains the function result after a call to a scalar
+        function othewise it contains a pointer to the returned result}
+      function_result_reg = accumulator;
+
+      fpu_result_reg = R_ST;
+      mmresultreg = R_MM0;
 
 {*****************************************************************************
                        GCC /ABI linking information
@@ -146,7 +214,13 @@ const
 
 {
   $Log$
-  Revision 1.1  2003-04-25 11:12:09  florian
+  Revision 1.3  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.2  2002/04/25 16:12:09  florian
+    * fixed more problems with cpubase and x86-64
+
+  Revision 1.1  2003/04/25 11:12:09  florian
     * merged i386/cpubase and x86_64/cpubase to x86/cpubase;
       different stuff went to cpubase.inc
 }

+ 5 - 2
compiler/x86_64/cputarg.pas

@@ -52,7 +52,7 @@ implementation
 **************************************}
 
     {$ifndef NOAGX86_64ATT}
-      ,agx64att
+      ,agx86att
     {$endif}
 
       ,ogcoff
@@ -62,7 +62,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2002-09-07 15:25:15  peter
+  Revision 1.4  2003-04-30 15:45:35  florian
+    * merged more x86-64/i386 code
+
+  Revision 1.3  2002/09/07 15:25:15  peter
     * old logs removed and tabs fixed
 
   Revision 1.2  2002/07/25 22:55:34  florian

+ 0 - 380
compiler/x86_64/radirect.pas

@@ -1,380 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Reads inline assembler and writes the lines direct to the output
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit radirect;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      node;
-
-     function assemble : tnode;
-
-  implementation
-
-    uses
-       { common }
-       cutils,
-       { global }
-       globals,verbose,
-       systems,
-       { aasm }
-       aasmbase,aasmtai,aasmcpu,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,defutil,paramgr,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner,
-       rax86_64,
-       { codegen }
-       cgbase,
-       { constants }
-       agx64att
-       ;
-
-    function assemble : tnode;
-
-      var
-         retstr,s,hs : string;
-         c : char;
-         ende : boolean;
-         srsym,sym : tsym;
-         srsymtable : tsymtable;
-         code : TAAsmoutput;
-         i,l : longint;
-
-       procedure writeasmline;
-         var
-           i : longint;
-         begin
-           i:=length(s);
-           while (i>0) and (s[i] in [' ',#9]) do
-            dec(i);
-           s[0]:=chr(i);
-           if s<>'' then
-            code.concat(Tai_direct.Create(strpnew(s)));
-            { consider it set function set if the offset was loaded }
-           if assigned(aktprocdef.funcretsym) and
-              (pos(retstr,upper(s))>0) then
-             tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-           s:='';
-         end;
-
-     begin
-       ende:=false;
-       s:='';
-       if assigned(aktprocdef.funcretsym) and
-          is_fpu(aktprocdef.rettype.def) then
-         tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-       if (not is_void(aktprocdef.rettype.def)) then
-         retstr:=upper(tostr(procinfo.return_offset)+'('+gas_reg2str[procinfo.framepointer]+')')
-       else
-         retstr:='';
-         c:=current_scanner.asmgetchar;
-         code:=TAAsmoutput.Create;
-         while not(ende) do
-           begin
-              { wrong placement
-              current_scanner.gettokenpos; }
-              case c of
-                 'A'..'Z','a'..'z','_' : begin
-                      current_scanner.gettokenpos;
-                      i:=0;
-                      hs:='';
-                      while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
-                         or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
-                         or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
-                         or (c='_') do
-                        begin
-                           inc(i);
-                           hs[i]:=c;
-                           c:=current_scanner.asmgetchar;
-                        end;
-                      hs[0]:=chr(i);
-                      if upper(hs)='END' then
-                         ende:=true
-                      else
-                         begin
-                            if c=':' then
-                              begin
-                                searchsym(upper(hs),srsym,srsymtable);
-                                if srsym<>nil then
-                                  if (srsym.typ = labelsym) then
-                                    Begin
-                                       hs:=tlabelsym(srsym).lab.name;
-                                       tlabelsym(srsym).lab.is_set:=true;
-                                    end
-                                  else
-                                    Message(asmr_w_using_defined_as_local);
-                              end
-                            else if upper(hs)='FWAIT' then
-                             FwaitWarning
-                            else
-                            { access to local variables }
-                            if assigned(aktprocdef) then
-                              begin
-                                 { is the last written character an special }
-                                 { char ?                                   }
-                                 if (s[length(s)]='%') and
-                                    paramanager.ret_in_acc(aktprocdef.rettype.def,aktprocdef.proccalloption) and
-                                    ((pos('AX',upper(hs))>0) or
-                                    (pos('AL',upper(hs))>0)) then
-                                   tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-                                 if (s[length(s)]<>'%') and
-                                   (s[length(s)]<>'$') and
-                                   ((s[length(s)]<>'0') or (hs[1]<>'x')) then
-                                   begin
-                                      if assigned(aktprocdef.localst) and
-                                         (lexlevel >= normal_function_level) then
-                                        sym:=tsym(aktprocdef.localst.search(upper(hs)))
-                                      else
-                                        sym:=nil;
-                                      if assigned(sym) then
-                                        begin
-                                           if (sym.typ = labelsym) then
-                                             Begin
-                                                hs:=tlabelsym(sym).lab.name;
-                                             end
-                                           else if sym.typ=varsym then
-                                             begin
-                                             {variables set are after a comma }
-                                             {like in movl %eax,I }
-                                             if pos(',',s) > 0 then
-                                               tvarsym(sym).varstate:=vs_used
-                                             else
-                                             if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
-                                              Message1(sym_n_uninitialized_local_variable,hs);
-                                             if (vo_is_external in tvarsym(sym).varoptions) then
-                                               hs:=tvarsym(sym).mangledname
-                                             else
-                                               hs:='-'+tostr(tvarsym(sym).address)+
-                                                   '('+gas_reg2str[procinfo.framepointer]+')';
-                                             end
-                                           else
-                                           { call to local function }
-                                           if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
-                                              (pos('LEA',upper(s))>0)) then
-                                             begin
-                                                hs:=tprocsym(sym).first_procdef.mangledname;
-                                             end;
-                                        end
-                                      else
-                                        begin
-                                           if assigned(aktprocdef.parast) then
-                                             sym:=tsym(aktprocdef.parast.search(upper(hs)))
-                                           else
-                                             sym:=nil;
-                                           if assigned(sym) then
-                                             begin
-                                                if sym.typ=varsym then
-                                                  begin
-                                                     l:=tvarsym(sym).address;
-                                                     { set offset }
-                                                     inc(l,aktprocdef.parast.address_fixup);
-                                                     hs:=tostr(l)+'('+gas_reg2str[procinfo.framepointer]+')';
-                                                     if pos(',',s) > 0 then
-                                                       tvarsym(sym).varstate:=vs_used;
-                                                  end;
-                                             end
-                                      { I added that but it creates a problem in line.ppi
-                                      because there is a local label wbuffer and
-                                      a static variable WBUFFER ...
-                                      what would you decide, florian ?}
-                                      else
-
-                                        begin
-                                           searchsym(upper(hs),sym,srsymtable);
-                                           if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
-                                             begin
-                                               case sym.typ of
-                                                 varsym :
-                                                   begin
-                                                     Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
-                                                     hs:=tvarsym(sym).mangledname;
-                                                     inc(tvarsym(sym).refs);
-                                                   end;
-                                                 typedconstsym :
-                                                   begin
-                                                     Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
-                                                     hs:=ttypedconstsym(sym).mangledname;
-                                                   end;
-                                                 procsym :
-                                                   begin
-                                                     { procs can be called or the address can be loaded }
-                                                     if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
-                                                      begin
-                                                        if tprocsym(sym).procdef_count>1 then
-                                                          Message1(asmr_w_direct_global_is_overloaded_func,hs);
-                                                        Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
-                                                        hs:=tprocsym(sym).first_procdef.mangledname;
-                                                      end;
-                                                   end;
-                                                 else
-                                                   Message(asmr_e_wrong_sym_type);
-                                               end;
-                                             end
-                                           else if upper(hs)='__SELF' then
-                                             begin
-                                                if assigned(procinfo._class) then
-                                                  hs:=tostr(procinfo.selfpointer_offset)+
-                                                      '('+gas_reg2str[procinfo.framepointer]+')'
-                                                else
-                                                 Message(asmr_e_cannot_use_SELF_outside_a_method);
-                                             end
-                                           else if upper(hs)='__RESULT' then
-                                             begin
-                                                if (not is_void(aktprocdef.rettype.def)) then
-                                                  hs:=retstr
-                                                else
-                                                  Message(asmr_e_void_function);
-                                             end
-                                           else if upper(hs)='__OLDEBP' then
-                                             begin
-                                                { complicate to check there }
-                                                { we do it: }
-                                                if lexlevel>normal_function_level then
-                                                  hs:=tostr(procinfo.framepointer_offset)+
-                                                    '('+gas_reg2str[procinfo.framepointer]+')'
-                                                else
-                                                  Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
-                                             end;
-                                           end;
-                                        end;
-                                   end;
-                              end;
-                            s:=s+hs;
-                         end;
-                   end;
- '{',';',#10,#13 : begin
-                      if pos(retstr,s) > 0 then
-                        tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-                     writeasmline;
-                     c:=current_scanner.asmgetchar;
-                   end;
-             #26 : Message(scan_f_end_of_file);
-             else
-               begin
-                 current_scanner.gettokenpos;
-                 inc(byte(s[0]));
-                 s[length(s)]:=c;
-                 c:=current_scanner.asmgetchar;
-               end;
-           end;
-         end;
-       writeasmline;
-       assemble:=casmnode.create(code);
-     end;
-
-{*****************************************************************************
-                                     Initialize
-*****************************************************************************}
-
-const
-  asmmode_i386_direct_info : tasmmodeinfo =
-          (
-            id    : asmmode_direct;
-            idtxt : 'DIRECT'
-          );
-
-initialization
-  RegisterAsmMode(asmmode_i386_direct_info);
-
-end.
-{
-  $Log$
-  Revision 1.2  2003-01-05 13:36:54  florian
-    * x86-64 compiles
-    + very basic support for float128 type (x86-64 only)
-
-  Revision 1.5  2002/11/25 17:43:27  peter
-    * splitted defbase in defutil,symutil,defcmp
-    * merged isconvertable and is_equal into compare_defs(_ext)
-    * made operator search faster by walking the list only once
-
-  Revision 1.4  2002/11/18 17:32:00  peter
-    * pass proccalloption to ret_in_xxx and push_xxx functions
-
-  Revision 1.3  2002/09/03 16:26:28  daniel
-    * Make Tprocdef.defs protected
-
-  Revision 1.2  2002/08/17 09:23:47  florian
-    * first part of procinfo rewrite
-
-  Revision 1.1  2002/08/10 14:47:50  carl
-    + moved target_cpu_string to cpuinfo
-    * renamed asmmode enum.
-    * assembler reader has now less ifdef's
-    * move from nppcmem.pas -> ncgmem.pas vec. node.
-
-  Revision 1.21  2002/07/20 11:58:05  florian
-    * types.pas renamed to defbase.pas because D6 contains a types
-      unit so this would conflicts if D6 programms are compiled
-    + Willamette/SSE2 instructions to assembler added
-
-  Revision 1.20  2002/07/11 14:41:34  florian
-    * start of the new generic parameter handling
-
-  Revision 1.19  2002/07/01 18:46:34  peter
-    * internal linker
-    * reorganized aasm layer
-
-  Revision 1.18  2002/05/18 13:34:26  peter
-    * readded missing revisions
-
-  Revision 1.17  2002/05/16 19:46:52  carl
-  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
-  + try to fix temp allocation (still in ifdef)
-  + generic constructor calls
-  + start of tassembler / tmodulebase class cleanup
-
-  Revision 1.15  2002/05/12 16:53:18  peter
-    * moved entry and exitcode to ncgutil and cgobj
-    * foreach gets extra argument for passing local data to the
-      iterator function
-    * -CR checks also class typecasts at runtime by changing them
-      into as
-    * fixed compiler to cycle with the -CR option
-    * fixed stabs with elf writer, finally the global variables can
-      be watched
-    * removed a lot of routines from cga unit and replaced them by
-      calls to cgobj
-    * u32bit-s32bit updates for and,or,xor nodes. When one element is
-      u32bit then the other is typecasted also to u32bit without giving
-      a rangecheck warning/error.
-    * fixed pascal calling method with reversing also the high tree in
-      the parast, detected by tcalcst3 test
-
-  Revision 1.14  2002/04/15 19:12:09  carl
-  + target_info.size_of_pointer -> pointer_size
-  + some cleanup of unused types/variables
-  * move several constants from cpubase to their specific units
-    (where they are used)
-  + att_Reg2str -> gas_reg2str
-  + int_reg2str -> std_reg2str
-
-  Revision 1.13  2002/04/14 17:01:52  carl
-  + att_reg2str -> gas_reg2str
-
-}

+ 0 - 722
compiler/x86_64/rax86_64.pas

@@ -1,722 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
-
-    Handles the common x86-64 assembler reader routines
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit rax86_64;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  aasmbase,aasmtai,aasmcpu,
-  cpubase,rautils,cclasses;
-
-{ Parser helpers }
-function is_prefix(t:tasmop):boolean;
-function is_override(t:tasmop):boolean;
-Function CheckPrefix(prefixop,op:tasmop): Boolean;
-Function CheckOverride(overrideop,op:tasmop): Boolean;
-Procedure FWaitWarning;
-
-type
-  T386Operand=class(TOperand)
-    Procedure SetCorrectSize(opcode:tasmop);override;
-  end;
-
-  T386Instruction=class(TInstruction)
-    { Operand sizes }
-    procedure AddReferenceSizes;
-    procedure SetInstructionOpsize;
-    procedure CheckOperandSizes;
-    procedure CheckNonCommutativeOpcodes;
-    { opcode adding }
-    procedure ConcatInstruction(p : taasmoutput);override;
-  end;
-
-  tstr2opentry = class(Tnamedindexitem)
-    op: TAsmOp;
-  end;
-
-const
-  AsmPrefixes = 6;
-  AsmPrefix : array[0..AsmPrefixes-1] of TasmOP =(
-    A_LOCK,A_REP,A_REPE,A_REPNE,A_REPNZ,A_REPZ
-  );
-
-  AsmOverrides = 6;
-  AsmOverride : array[0..AsmOverrides-1] of TasmOP =(
-    A_SEGCS,A_SEGES,A_SEGDS,A_SEGFS,A_SEGGS,A_SEGSS
-  );
-
-  CondAsmOps=3;
-  CondAsmOp:array[0..CondAsmOps-1] of TasmOp=(
-    A_CMOVcc, A_Jcc, A_SETcc
-  );
-  CondAsmOpStr:array[0..CondAsmOps-1] of string[4]=(
-    'CMOV','J','SET'
-  );
-
-implementation
-
-uses
-  globtype,globals,systems,verbose,
-  cpuinfo,agx64att;
-
-{$define ATTOP}
-{$define INTELOP}
-
-{$ifdef NORA386INT}
-  {$ifdef NOAG386NSM}
-    {$ifdef NOAG386INT}
-      {$undef INTELOP}
-    {$endif}
-  {$endif}
-{$endif}
-
-{$ifdef NORA386ATT}
-  {$ifdef NOAG386ATT}
-    {$undef ATTOP}
-  {$endif}
-{$endif}
-
-
-
-{*****************************************************************************
-                              Parser Helpers
-*****************************************************************************}
-
-function is_prefix(t:tasmop):boolean;
-var
-  i : longint;
-Begin
-  is_prefix:=false;
-  for i:=1 to AsmPrefixes do
-   if t=AsmPrefix[i-1] then
-    begin
-      is_prefix:=true;
-      exit;
-    end;
-end;
-
-
-function is_override(t:tasmop):boolean;
-var
-  i : longint;
-Begin
-  is_override:=false;
-  for i:=1 to AsmOverrides do
-   if t=AsmOverride[i-1] then
-    begin
-      is_override:=true;
-      exit;
-    end;
-end;
-
-
-Function CheckPrefix(prefixop,op:tasmop): Boolean;
-{ Checks if the prefix is valid with the following opcode }
-{ return false if not, otherwise true                          }
-Begin
-  CheckPrefix := TRUE;
-(*  Case prefix of
-    A_REP,A_REPNE,A_REPE:
-      Case opcode Of
-        A_SCASB,A_SCASW,A_SCASD,
-        A_INS,A_OUTS,A_MOVS,A_CMPS,A_LODS,A_STOS:;
-        Else
-          Begin
-            CheckPrefix := FALSE;
-            exit;
-          end;
-      end; { case }
-    A_LOCK:
-      Case opcode Of
-        A_BT,A_BTS,A_BTR,A_BTC,A_XCHG,A_ADD,A_OR,A_ADC,A_SBB,A_AND,A_SUB,
-        A_XOR,A_NOT,A_NEG,A_INC,A_DEC:;
-        Else
-          Begin
-            CheckPrefix := FALSE;
-            Exit;
-          end;
-      end; { case }
-    A_NONE: exit; { no prefix here }
-    else
-      CheckPrefix := FALSE;
-   end; { end case } *)
-end;
-
-
-Function CheckOverride(overrideop,op:tasmop): Boolean;
-{ Check if the override is valid, and if so then }
-{ update the instr variable accordingly.         }
-Begin
-  CheckOverride := true;
-{     Case instr.getinstruction of
-    A_MOVS,A_XLAT,A_CMPS:
-      Begin
-        CheckOverride := TRUE;
-        Message(assem_e_segment_override_not_supported);
-      end
-  end }
-end;
-
-
-Procedure FWaitWarning;
-begin
-  if (target_info.system=system_i386_GO32V2) and (cs_fp_emulation in aktmoduleswitches) then
-   Message(asmr_w_fwait_emu_prob);
-end;
-
-{*****************************************************************************
-                              T386Operand
-*****************************************************************************}
-
-Procedure T386Operand.SetCorrectSize(opcode:tasmop);
-begin
-  if gas_needsuffix[opcode]=attsufFPU then
-    begin
-     case size of
-      S_L : size:=S_FS;
-      S_IQ : size:=S_FL;
-     end;
-    end
-  else if gas_needsuffix[opcode]=attsufFPUint then
-    begin
-      case size of
-      S_W : size:=S_IS;
-      S_L : size:=S_IL;
-      end;
-    end;
-end;
-
-
-{*****************************************************************************
-                              T386Instruction
-*****************************************************************************}
-
-procedure T386Instruction.AddReferenceSizes;
-{ this will add the sizes for references like [esi] which do not
-  have the size set yet, it will take only the size if the other
-  operand is a register }
-var
-  operand2,i : longint;
-  s : tasmsymbol;
-  so : longint;
-begin
-  for i:=1to ops do
-   begin
-   operands[i].SetCorrectSize(opcode);
-   if (operands[i].size=S_NO) then
-    begin
-      case operands[i].Opr.Typ of
-        OPR_REFERENCE :
-          begin
-            if i=2 then
-             operand2:=1
-            else
-             operand2:=2;
-            if operand2<ops then
-             begin
-               { Only allow register as operand to take the size from }
-               if operands[operand2].opr.typ=OPR_REGISTER then
-                 begin
-                   if ((opcode<>A_MOVD) and
-                       (opcode<>A_CVTSI2SS)) then
-                     operands[i].size:=operands[operand2].size;
-                 end
-               else
-                begin
-                  { if no register then take the opsize (which is available with ATT),
-                    if not availble then give an error }
-                  if opsize<>S_NO then
-                    operands[i].size:=opsize
-                  else
-                   begin
-                     Message(asmr_e_unable_to_determine_reference_size);
-                     { recovery }
-                     operands[i].size:=S_L;
-                   end;
-                end;
-             end
-            else
-             begin
-               if opsize<>S_NO then
-                 operands[i].size:=opsize
-             end;
-          end;
-        OPR_SYMBOL :
-          begin
-            { Fix lea which need a reference }
-            if opcode=A_LEA then
-             begin
-               s:=operands[i].opr.symbol;
-               so:=operands[i].opr.symofs;
-               operands[i].opr.typ:=OPR_REFERENCE;
-               Fillchar(operands[i].opr.ref,sizeof(treference),0);
-               operands[i].opr.ref.symbol:=s;
-               operands[i].opr.ref.offset:=so;
-             end;
-            operands[i].size:=S_L;
-          end;
-      end;
-    end;
-   end;
-end;
-
-
-procedure T386Instruction.SetInstructionOpsize;
-begin
-  if opsize<>S_NO then
-   exit;
-  case ops of
-    0 : ;
-    1 :
-      { "push es" must be stored as a long PM }
-      if ((opcode=A_PUSH) or
-          (opcode=A_POP)) and
-         (operands[1].opr.typ=OPR_REGISTER) and
-         ((operands[1].opr.reg>=firstsreg) and
-          (operands[1].opr.reg<=lastsreg)) then
-        opsize:=S_L
-      else
-        opsize:=operands[1].size;
-    2 :
-      begin
-        case opcode of
-          A_MOVZX,A_MOVSX :
-            begin
-              case operands[1].size of
-                S_W :
-                  case operands[2].size of
-                    S_L :
-                      opsize:=S_WL;
-                  end;
-                S_B :
-                  case operands[2].size of
-                    S_W :
-                      opsize:=S_BW;
-                    S_L :
-                      opsize:=S_BL;
-                  end;
-              end;
-            end;
-          A_MOVD : { movd is a move from a mmx register to a
-                     32 bit register or memory, so no opsize is correct here PM }
-            exit;
-          A_OUT :
-            opsize:=operands[1].size;
-          else
-            opsize:=operands[2].size;
-        end;
-      end;
-    3 :
-      opsize:=operands[3].size;
-  end;
-end;
-
-
-procedure T386Instruction.CheckOperandSizes;
-var
-  sizeerr : boolean;
-  i : longint;
-begin
-  { Check only the most common opcodes here, the others are done in
-    the assembler pass }
-  case opcode of
-    A_PUSH,A_POP,A_DEC,A_INC,A_NOT,A_NEG,
-    A_CMP,A_MOV,
-    A_ADD,A_SUB,A_ADC,A_SBB,
-    A_AND,A_OR,A_TEST,A_XOR: ;
-  else
-    exit;
-  end;
-  { Handle the BW,BL,WL separatly }
-  sizeerr:=false;
-  { special push/pop selector case }
-  if ((opcode=A_PUSH) or
-      (opcode=A_POP)) and
-     (operands[1].opr.typ=OPR_REGISTER) and
-     ((operands[1].opr.reg>=firstsreg) and
-      (operands[1].opr.reg<=lastsreg)) then
-     exit;
-  if opsize in [S_BW,S_BL,S_WL] then
-   begin
-     if ops<>2 then
-      sizeerr:=true
-     else
-      begin
-        case opsize of
-          S_BW :
-            sizeerr:=(operands[1].size<>S_B) or (operands[2].size<>S_W);
-          S_BL :
-            sizeerr:=(operands[1].size<>S_B) or (operands[2].size<>S_L);
-          S_WL :
-            sizeerr:=(operands[1].size<>S_W) or (operands[2].size<>S_L);
-        end;
-      end;
-   end
-  else
-   begin
-     for i:=1 to ops do
-      begin
-        if (operands[i].opr.typ<>OPR_CONSTANT) and
-           (operands[i].size in [S_B,S_W,S_L]) and
-           (operands[i].size<>opsize) then
-         sizeerr:=true;
-      end;
-   end;
-  if sizeerr then
-   begin
-     { if range checks are on then generate an error }
-     if (cs_compilesystem in aktmoduleswitches) or
-        not (cs_check_range in aktlocalswitches) then
-       Message(asmr_w_size_suffix_and_dest_dont_match)
-     else
-       Message(asmr_e_size_suffix_and_dest_dont_match);
-   end;
-end;
-
-
-{ This check must be done with the operand in ATT order
-  i.e.after swapping in the intel reader
-  but before swapping in the NASM and TASM writers PM }
-procedure T386Instruction.CheckNonCommutativeOpcodes;
-begin
-  if ((ops=2) and
-     (operands[1].opr.typ=OPR_REGISTER) and
-     (operands[2].opr.typ=OPR_REGISTER) and
-     { if the first is ST and the second is also a register
-       it is necessarily ST1 .. ST7 }
-     (operands[1].opr.reg=R_ST)) or
-      (ops=0)  then
-      if opcode=A_FSUBR then
-        opcode:=A_FSUB
-      else if opcode=A_FSUB then
-        opcode:=A_FSUBR
-      else if opcode=A_FDIVR then
-        opcode:=A_FDIV
-      else if opcode=A_FDIV then
-        opcode:=A_FDIVR
-      else if opcode=A_FSUBRP then
-        opcode:=A_FSUBP
-      else if opcode=A_FSUBP then
-        opcode:=A_FSUBRP
-      else if opcode=A_FDIVRP then
-        opcode:=A_FDIVP
-      else if opcode=A_FDIVP then
-        opcode:=A_FDIVRP;
-  if  ((ops=1) and
-      (operands[1].opr.typ=OPR_REGISTER) and
-      (operands[1].opr.reg in [R_ST1..R_ST7])) then
-      if opcode=A_FSUBRP then
-        opcode:=A_FSUBP
-      else if opcode=A_FSUBP then
-        opcode:=A_FSUBRP
-      else if opcode=A_FDIVRP then
-        opcode:=A_FDIVP
-      else if opcode=A_FDIVP then
-        opcode:=A_FDIVRP;
-end;
-
-{*****************************************************************************
-                              opcode Adding
-*****************************************************************************}
-
-procedure T386Instruction.ConcatInstruction(p : taasmoutput);
-var
-  siz  : topsize;
-  i,asize : longint;
-  ai   : taicpu;
-begin
-{ Get Opsize }
-  if (opsize<>S_NO) or (Ops=0) then
-   siz:=opsize
-  else
-   begin
-     if (Ops=2) and (operands[1].opr.typ=OPR_REGISTER) then
-      siz:=operands[1].size
-     else
-      siz:=operands[Ops].size;
-     { MOVD should be of size S_LQ or S_QL, but these do not exist PM }
-     if (ops=2) and (operands[1].size<>S_NO) and
-        (operands[2].size<>S_NO) and (operands[1].size<>operands[2].size) then
-       siz:=S_NO;
-   end;
-
-   if ((opcode=A_MOVD)or
-       (opcode=A_CVTSI2SS)) and
-      ((operands[1].size=S_NO) or
-       (operands[2].size=S_NO)) then
-     siz:=S_NO;
-   { NASM does not support FADD without args
-     as alias of FADDP
-     and GNU AS interprets FADD without operand differently
-     for version 2.9.1 and 2.9.5 !! }
-   if (ops=0) and
-      ((opcode=A_FADD) or
-       (opcode=A_FMUL) or
-       (opcode=A_FSUB) or
-       (opcode=A_FSUBR) or
-       (opcode=A_FDIV) or
-       (opcode=A_FDIVR)) then
-     begin
-       if opcode=A_FADD then
-         opcode:=A_FADDP
-       else if opcode=A_FMUL then
-         opcode:=A_FMULP
-       else if opcode=A_FSUB then
-         opcode:=A_FSUBP
-       else if opcode=A_FSUBR then
-         opcode:=A_FSUBRP
-       else if opcode=A_FDIV then
-         opcode:=A_FDIVP
-       else if opcode=A_FDIVR then
-         opcode:=A_FDIVRP;
-{$ifdef ATTOP}
-       message1(asmr_w_fadd_to_faddp,gas_op2str[opcode]);
-{$else}
-  {$ifdef INTELOP}
-       message1(asmr_w_fadd_to_faddp,std_op2str[opcode]);
-  {$else}
-       message1(asmr_w_fadd_to_faddp,'fXX');
-  {$endif INTELOP}
-{$endif ATTOP}
-     end;
-
-   { GNU AS interprets FDIV without operand differently
-     for version 2.9.1 and 2.10
-     we add explicit args to it !! }
-  if (ops=0) and
-     ((opcode=A_FSUBP) or
-      (opcode=A_FSUBRP) or
-      (opcode=A_FDIVP) or
-      (opcode=A_FDIVRP) or
-      (opcode=A_FSUB) or
-      (opcode=A_FSUBR) or
-      (opcode=A_FDIV) or
-      (opcode=A_FDIVR)) then
-     begin
-{$ifdef ATTOP}
-       message1(asmr_w_adding_explicit_args_fXX,gas_op2str[opcode]);
-{$else}
-  {$ifdef INTELOP}
-       message1(asmr_w_adding_explicit_args_fXX,gas_op2str[opcode]);
-  {$else}
-       message1(asmr_w_adding_explicit_args_fXX,'fXX');
-  {$endif INTELOP}
-{$endif ATTOP}
-       ops:=2;
-       operands[1].opr.typ:=OPR_REGISTER;
-       operands[2].opr.typ:=OPR_REGISTER;
-       operands[1].opr.reg:=R_ST;
-       operands[2].opr.reg:=R_ST1;
-     end;
-  if (ops=1) and
-      ((operands[1].opr.typ=OPR_REGISTER) and
-      (operands[1].opr.reg in [R_ST1..R_ST7])) and
-      ((opcode=A_FSUBP) or
-      (opcode=A_FSUBRP) or
-      (opcode=A_FDIVP) or
-      (opcode=A_FDIVRP) or
-      (opcode=A_FADDP) or
-      (opcode=A_FMULP)) then
-     begin
-{$ifdef ATTOP}
-       message1(asmr_w_adding_explicit_first_arg_fXX,gas_op2str[opcode]);
-{$else}
-  {$ifdef INTELOP}
-       message1(asmr_w_adding_explicit_first_arg_fXX,std_op2str[opcode]);
-  {$else}
-       message1(asmr_w_adding_explicit_first_arg_fXX,'fXX');
-  {$endif INTELOP}
-{$endif ATTOP}
-       ops:=2;
-       operands[2].opr.typ:=OPR_REGISTER;
-       operands[2].opr.reg:=operands[1].opr.reg;
-       operands[1].opr.reg:=R_ST;
-     end;
-
-  if (ops=1) and
-      ((operands[1].opr.typ=OPR_REGISTER) and
-      (operands[1].opr.reg in [R_ST1..R_ST7])) and
-      ((opcode=A_FSUB) or
-      (opcode=A_FSUBR) or
-      (opcode=A_FDIV) or
-      (opcode=A_FDIVR) or
-      (opcode=A_FADD) or
-      (opcode=A_FMUL)) then
-     begin
-{$ifdef ATTOP}
-       message1(asmr_w_adding_explicit_second_arg_fXX,gas_op2str[opcode]);
-{$else}
-  {$ifdef INTELOP}
-       message1(asmr_w_adding_explicit_second_arg_fXX,std_op2str[opcode]);
-  {$else}
-       message1(asmr_w_adding_explicit_second_arg_fXX,'fXX');
-  {$endif INTELOP}
-{$endif ATTOP}
-       ops:=2;
-       operands[2].opr.typ:=OPR_REGISTER;
-       operands[2].opr.reg:=R_ST;
-     end;
-
-   { I tried to convince Linus Torwald to add
-     code to support ENTER instruction
-     (when raising a stack page fault)
-     but he replied that ENTER is a bad instruction and
-     Linux does not need to support it
-     So I think its at least a good idea to add a warning
-     if someone uses this in assembler code
-     FPC itself does not use it at all PM }
-   if (opcode=A_ENTER) and ((target_info.system=system_i386_linux) or
-        (target_info.system=system_i386_FreeBSD)) then
-     begin
-       message(asmr_w_enter_not_supported_by_linux);
-     end;
-
-  ai:=taicpu.op_none(opcode,siz);
-  ai.Ops:=Ops;
-  for i:=1to Ops do
-   begin
-     case operands[i].opr.typ of
-       OPR_CONSTANT :
-         ai.loadconst(i-1,aword(operands[i].opr.val));
-       OPR_REGISTER:
-         ai.loadreg(i-1,operands[i].opr.reg);
-       OPR_SYMBOL:
-         ai.loadsymbol(i-1,operands[i].opr.symbol,operands[i].opr.symofs);
-       OPR_REFERENCE:
-         begin
-           ai.loadref(i-1,operands[i].opr.ref);
-           if operands[i].size<>S_NO then
-             begin
-               asize:=0;
-               case operands[i].size of
-                   S_B :
-                     asize:=OT_BITS8;
-                   S_W, S_IS :
-                     asize:=OT_BITS16;
-                   S_L, S_IL, S_FS:
-                     asize:=OT_BITS32;
-                   S_Q, S_D, S_FL, S_FV :
-                     asize:=OT_BITS64;
-                   S_FX :
-                     asize:=OT_BITS80;
-                 end;
-               if asize<>0 then
-                 ai.oper[i-1].ot:=(ai.oper[i-1].ot and not OT_SIZE_MASK) or asize;
-             end;
-         end;
-     end;
-   end;
-
-  if (opcode=A_CALL) and (opsize=S_FAR) then
-    opcode:=A_LCALL;
-  if (opcode=A_JMP) and (opsize=S_FAR) then
-    opcode:=A_LJMP;
-  if (opcode=A_LCALL) or (opcode=A_LJMP) then
-    opsize:=S_FAR;
- { Condition ? }
-  if condition<>C_None then
-   ai.SetCondition(condition);
-
- { Concat the opcode or give an error }
-  if assigned(ai) then
-   begin
-     { Check the instruction if it's valid }
-{$ifndef NOAG386BIN}
-     ai.CheckIfValid;
-{$endif NOAG386BIN}
-     p.concat(ai);
-   end
-  else
-   Message(asmr_e_invalid_opcode_and_operand);
-end;
-
-end.
-{
-  $Log$
-  Revision 1.2  2003-01-05 13:36:54  florian
-    * x86-64 compiles
-    + very basic support for float128 type (x86-64 only)
-
-  Revision 1.1  2002/07/24 22:38:15  florian
-    + initial release of x86-64 target code
-
-  Revision 1.22  2002/07/01 18:46:34  peter
-    * internal linker
-    * reorganized aasm layer
-
-  Revision 1.21  2002/05/18 13:34:25  peter
-    * readded missing revisions
-
-  Revision 1.20  2002/05/16 19:46:52  carl
-  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
-  + try to fix temp allocation (still in ifdef)
-  + generic constructor calls
-  + start of tassembler / tmodulebase class cleanup
-
-  Revision 1.18  2002/05/12 16:53:18  peter
-    * moved entry and exitcode to ncgutil and cgobj
-    * foreach gets extra argument for passing local data to the
-      iterator function
-    * -CR checks also class typecasts at runtime by changing them
-      into as
-    * fixed compiler to cycle with the -CR option
-    * fixed stabs with elf writer, finally the global variables can
-      be watched
-    * removed a lot of routines from cga unit and replaced them by
-      calls to cgobj
-    * u32bit-s32bit updates for and,or,xor nodes. When one element is
-      u32bit then the other is typecasted also to u32bit without giving
-      a rangecheck warning/error.
-    * fixed pascal calling method with reversing also the high tree in
-      the parast, detected by tcalcst3 test
-
-  Revision 1.17  2002/04/15 19:12:09  carl
-  + target_info.size_of_pointer -> pointer_size
-  + some cleanup of unused types/variables
-  * move several constants from cpubase to their specific units
-    (where they are used)
-  + att_Reg2str -> gas_reg2str
-  + int_reg2str -> std_reg2str
-
-  Revision 1.16  2002/04/04 19:06:13  peter
-    * removed unused units
-    * use tlocation.size in cg.a_*loc*() routines
-
-  Revision 1.15  2002/04/02 17:11:39  peter
-    * tlocation,treference update
-    * LOC_CONSTANT added for better constant handling
-    * secondadd splitted in multiple routines
-    * location_force_reg added for loading a location to a register
-      of a specified size
-    * secondassignment parses now first the right and then the left node
-      (this is compatible with Kylix). This saves a lot of push/pop especially
-      with string operations
-    * adapted some routines to use the new cg methods
-
-  Revision 1.14  2002/01/24 18:25:53  peter
-   * implicit result variable generation for assembler routines
-   * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
-
-}

+ 0 - 312
compiler/x86_64/rax86dir.pas

@@ -1,312 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2001 by Florian Klaempfl
-
-    Reads inline assembler and writes the lines direct to the output
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit Rax86dir;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      node;
-
-     function assemble : tnode;
-
-  implementation
-
-    uses
-       { common }
-       cutils,
-       { global }
-       globals,verbose,
-       systems,
-       { aasm }
-       cpubase,aasmtai,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,defbase,paramgr,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner,
-       rax86_64,
-       agx64att,
-       { codegen }
-       cgbase
-       ;
-
-    function assemble : tnode;
-
-      var
-         retstr,s,hs : string;
-         c : char;
-         ende : boolean;
-         srsym,sym : tsym;
-         srsymtable : tsymtable;
-         code : TAAsmoutput;
-         i,l : longint;
-
-       procedure writeasmline;
-         var
-           i : longint;
-         begin
-           i:=length(s);
-           while (i>0) and (s[i] in [' ',#9]) do
-            dec(i);
-           s[0]:=chr(i);
-           if s<>'' then
-            code.concat(Tai_direct.Create(strpnew(s)));
-            { consider it set function set if the offset was loaded }
-           if assigned(aktprocdef.funcretsym) and
-              (pos(retstr,upper(s))>0) then
-             tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-           s:='';
-         end;
-
-     begin
-       ende:=false;
-       s:='';
-       if assigned(aktprocdef.funcretsym) and
-          is_fpu(aktprocdef.rettype.def) then
-         tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-       if (not is_void(aktprocdef.rettype.def)) then
-         retstr:=upper(tostr(procinfo^.return_offset)+'('+att_reg2str[procinfo^.framepointer]+')')
-       else
-         retstr:='';
-         c:=current_scanner.asmgetchar;
-         code:=TAAsmoutput.Create;
-         while not(ende) do
-           begin
-              { wrong placement
-              current_scanner.gettokenpos; }
-              case c of
-                 'A'..'Z','a'..'z','_' : begin
-                      current_scanner.gettokenpos;
-                      i:=0;
-                      hs:='';
-                      while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
-                         or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
-                         or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
-                         or (c='_') do
-                        begin
-                           inc(i);
-                           hs[i]:=c;
-                           c:=current_scanner.asmgetchar;
-                        end;
-                      hs[0]:=chr(i);
-                      if upper(hs)='END' then
-                         ende:=true
-                      else
-                         begin
-                            if c=':' then
-                              begin
-                                searchsym(upper(hs),srsym,srsymtable);
-                                if srsym<>nil then
-                                  if (srsym.typ = labelsym) then
-                                    Begin
-                                       hs:=tlabelsym(srsym).lab.name;
-                                       tlabelsym(srsym).lab.is_set:=true;
-                                    end
-                                  else
-                                    Message(asmr_w_using_defined_as_local);
-                              end
-                            else if upper(hs)='FWAIT' then
-                             FwaitWarning
-                            else
-                            { access to local variables }
-                            if assigned(aktprocdef) then
-                              begin
-                                 { is the last written character an special }
-                                 { char ?                                   }
-                                 if (s[length(s)]='%') and
-                                    paramanager.ret_in_acc(aktprocdef.rettype.def) and
-                                    ((pos('AX',upper(hs))>0) or
-                                    (pos('AL',upper(hs))>0)) then
-                                   tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-                                 if (s[length(s)]<>'%') and
-                                   (s[length(s)]<>'$') and
-                                   ((s[length(s)]<>'0') or (hs[1]<>'x')) then
-                                   begin
-                                      if assigned(aktprocdef.localst) and
-                                         (lexlevel >= normal_function_level) then
-                                        sym:=tsym(aktprocdef.localst.search(upper(hs)))
-                                      else
-                                        sym:=nil;
-                                      if assigned(sym) then
-                                        begin
-                                           if (sym.typ = labelsym) then
-                                             Begin
-                                                hs:=tlabelsym(sym).lab.name;
-                                             end
-                                           else if sym.typ=varsym then
-                                             begin
-                                             {variables set are after a comma }
-                                             {like in movl %eax,I }
-                                             if pos(',',s) > 0 then
-                                               tvarsym(sym).varstate:=vs_used
-                                             else
-                                             if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
-                                              Message1(sym_n_uninitialized_local_variable,hs);
-                                             if (vo_is_external in tvarsym(sym).varoptions) then
-                                               hs:=tvarsym(sym).mangledname
-                                             else
-                                               hs:='-'+tostr(tvarsym(sym).address)+
-                                                   '('+att_reg2str[procinfo^.framepointer]+')';
-                                             end
-                                           else
-                                           { call to local function }
-                                           if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
-                                              (pos('LEA',upper(s))>0)) then
-                                             begin
-                                                hs:=tprocsym(sym).defs^.def.mangledname;
-                                             end;
-                                        end
-                                      else
-                                        begin
-                                           if assigned(aktprocdef.parast) then
-                                             sym:=tsym(aktprocdef.parast.search(upper(hs)))
-                                           else
-                                             sym:=nil;
-                                           if assigned(sym) then
-                                             begin
-                                                if sym.typ=varsym then
-                                                  begin
-                                                     l:=tvarsym(sym).address;
-                                                     { set offset }
-                                                     inc(l,aktprocdef.parast.address_fixup);
-                                                     hs:=tostr(l)+'('+att_reg2str[procinfo^.framepointer]+')';
-                                                     if pos(',',s) > 0 then
-                                                       tvarsym(sym).varstate:=vs_used;
-                                                  end;
-                                             end
-                                      { I added that but it creates a problem in line.ppi
-                                      because there is a local label wbuffer and
-                                      a static variable WBUFFER ...
-                                      what would you decide, florian ?}
-                                      else
-
-                                        begin
-                                           searchsym(upper(hs),sym,srsymtable);
-                                           if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
-                                             begin
-                                               case sym.typ of
-                                                 varsym :
-                                                   begin
-                                                     Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
-                                                     hs:=tvarsym(sym).mangledname;
-                                                     inc(tvarsym(sym).refs);
-                                                   end;
-                                                 typedconstsym :
-                                                   begin
-                                                     Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
-                                                     hs:=ttypedconstsym(sym).mangledname;
-                                                   end;
-                                                 procsym :
-                                                   begin
-                                                     { procs can be called or the address can be loaded }
-                                                     if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
-                                                      begin
-                                                        if assigned(tprocsym(sym).defs^.def) then
-                                                          Message1(asmr_w_direct_global_is_overloaded_func,hs);
-                                                        Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
-                                                        hs:=tprocsym(sym).defs^.def.mangledname;
-                                                      end;
-                                                   end;
-                                                 else
-                                                   Message(asmr_e_wrong_sym_type);
-                                               end;
-                                             end
-                                           else if upper(hs)='__SELF' then
-                                             begin
-                                                if assigned(procinfo^._class) then
-                                                  hs:=tostr(procinfo^.selfpointer_offset)+
-                                                      '('+att_reg2str[procinfo^.framepointer]+')'
-                                                else
-                                                 Message(asmr_e_cannot_use_SELF_outside_a_method);
-                                             end
-                                           else if upper(hs)='__RESULT' then
-                                             begin
-                                                if (not is_void(aktprocdef.rettype.def)) then
-                                                  hs:=retstr
-                                                else
-                                                  Message(asmr_e_void_function);
-                                             end
-                                           else if upper(hs)='__OLDEBP' then
-                                             begin
-                                                { complicate to check there }
-                                                { we do it: }
-                                                if lexlevel>normal_function_level then
-                                                  hs:=tostr(procinfo^.framepointer_offset)+
-                                                    '('+att_reg2str[procinfo^.framepointer]+')'
-                                                else
-                                                  Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
-                                             end;
-                                           end;
-                                        end;
-                                   end;
-                              end;
-                            s:=s+hs;
-                         end;
-                   end;
- '{',';',#10,#13 : begin
-                      if pos(retstr,s) > 0 then
-                        tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-                     writeasmline;
-                     c:=current_scanner.asmgetchar;
-                   end;
-             #26 : Message(scan_f_end_of_file);
-             else
-               begin
-                 current_scanner.gettokenpos;
-                 inc(byte(s[0]));
-                 s[length(s)]:=c;
-                 c:=current_scanner.asmgetchar;
-               end;
-           end;
-         end;
-       writeasmline;
-       assemble:=casmnode.create(code);
-     end;
-
-{*****************************************************************************
-                                     Initialize
-*****************************************************************************}
-
-const
-  asmmode_i386_direct_info : tasmmodeinfo =
-          (
-            id    : asmmode_i386_direct;
-            idtxt : 'DIRECT'
-          );
-
-initialization
-  RegisterAsmMode(asmmode_i386_direct_info);
-
-end.
-{
-  $Log$
-  Revision 1.2  2002-07-25 22:55:34  florian
-    * several fixes, small test units can be compiled
-
-  Revision 1.1  2002/07/24 22:38:15  florian
-    + initial release of x86-64 target code
-
-}