* another bunch of x86-64 fixes mainly calling convention and

    assembler reader related

compiler/compiler.pas

@@ -209,6 +209,9 @@ uses
 {$ifdef powerpc}
   ,rappcgas
 {$endif powerpc}
+{$ifdef x86_64}
+  ,rax64att
+{$endif x86_64}
 {$ifdef arm}
   ,raarmgas
 {$endif arm}
@@ -423,7 +426,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.43  2003-12-04 10:46:19  mazen
+  Revision 1.44  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.43  2003/12/04 10:46:19  mazen
   + added support for spac assembler reader
 
   Revision 1.42  2003/11/17 23:23:47  florian

compiler/globals.pas

@@ -1779,7 +1779,7 @@ implementation
         {$IFDEF testvarsets}
         initsetalloc:=0;
         {$ENDIF}
-        initasmmode:=asmmode_x8664_gas;
+        initasmmode:=asmmode_x86_64_gas;
 {$endif x86_64}
         initinterfacetype:=it_interfacecom;
         initdefproccall:=pocall_default;
@@ -1796,7 +1796,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.120  2004-01-12 16:36:53  peter
+  Revision 1.121  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.120  2004/01/12 16:36:53  peter
     * removed asmmode_direct
 
   Revision 1.119  2004/01/02 16:50:24  jonas

compiler/i386/cgcpu.pas

@@ -40,7 +40,8 @@ unit cgcpu;
 
     type
       tcg386 = class(tcgx86)
-         class function reg_cgsize(const reg: tregister): tcgsize; override;
+        procedure init_register_allocators;override;
+        class function reg_cgsize(const reg: tregister): tcgsize; override;
      end;
 
       tcg64f386 = class(tcg64f32)
@@ -57,7 +58,20 @@ unit cgcpu;
     uses
        globtype,globals,verbose,systems,cutils,
        symdef,symsym,defutil,paramgr,
-       tgobj;
+       rgcpu,rgx86,tgobj;
+
+
+    procedure Tcg386.init_register_allocators;
+      begin
+        inherited init_register_allocators;
+        if cs_create_pic in aktmoduleswitches then
+          rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP,RS_EBX])
+        else
+          rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]);
+        rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_sse_imreg,[]);
+        rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_sse_imreg,[]);
+        rgfpu:=Trgx86fpu.create;
+      end;
 
 
     class function tcg386.reg_cgsize(const reg: tregister): tcgsize;
@@ -232,7 +246,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.43  2004-01-12 16:39:40  peter
+  Revision 1.44  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.43  2004/01/12 16:39:40  peter
     * sparc updates, mostly float related
 
   Revision 1.42  2003/12/24 00:10:02  florian

compiler/i386/cpubase.inc

@@ -153,7 +153,7 @@
          This value can be deduced from the CALLED_USED_REGISTERS array in the
          GCC source.
       }
-      std_saved_registers = [RS_ESI,RS_EDI,RS_EBX];
+      saved_standard_registers : array[0..2] of tsuperregister = (RS_EBX,RS_ESI,RS_EDI);
       {# Required parameter alignment when calling a routine declared as
          stdcall and cdecl. The alignment value should be the one defined
          by GCC or the target ABI.
@@ -165,7 +165,11 @@
 
 {
   $Log$
-  Revision 1.10  2003-10-17 14:38:32  peter
+  Revision 1.11  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.10  2003/10/17 14:38:32  peter
     * 64k registers supported
     * fixed some memory leaks
 

compiler/i386/ra386att.pas

@@ -24,774 +24,20 @@ Unit ra386att;
 
 {$i fpcdefs.inc}
 
-Interface
-
-  uses
-    cpubase,
-    raatt,rax86;
-
-  type
-    ti386attreader = class(tattreader)
-      ActOpsize : topsize;
-      function is_asmopcode(const s: string):boolean;override;
-      procedure handleopcode;override;
-      procedure BuildReference(oper : t386operand);
-      procedure BuildOperand(oper : t386operand);
-      procedure BuildOpCode(instr : t386instruction);
-      procedure handlepercent;override;
-    end;
-
-
-Implementation
+  interface
 
     uses
-      { helpers }
-      cutils,
-      { global }
-      globtype,globals,verbose,
-      systems,
-      { aasm }
-      cpuinfo,aasmbase,aasmtai,aasmcpu,
-      { symtable }
-      symconst,symbase,symtype,symsym,symtable,
-      { parser }
-      scanner,
-      procinfo,
-      itcpugas,
-      rabase,rautils,
-      cgbase,cgobj
-      ;
-
-    procedure ti386attreader.handlepercent;
-      var
-        len : longint;
-      begin
-        len:=1;
-        actasmpattern[len]:='%';
-        c:=current_scanner.asmgetchar;
-        { to be a register there must be a letter and not a number }
-        if c in ['0'..'9'] then
-         begin
-           actasmtoken:=AS_MOD;
-         end
-        else
-         begin
-           while c in ['a'..'z','A'..'Z','0'..'9'] do
-            Begin
-              inc(len);
-              actasmpattern[len]:=c;
-              c:=current_scanner.asmgetchar;
-            end;
-           actasmpattern[0]:=chr(len);
-           uppervar(actasmpattern);
-           if (actasmpattern = '%ST') and (c='(') then
-            Begin
-              actasmpattern:=actasmpattern+c;
-              c:=current_scanner.asmgetchar;
-              if c in ['0'..'9'] then
-               actasmpattern:=actasmpattern + c
-              else
-               Message(asmr_e_invalid_fpu_register);
-              c:=current_scanner.asmgetchar;
-              if c <> ')' then
-               Message(asmr_e_invalid_fpu_register)
-              else
-               Begin
-                 actasmpattern:=actasmpattern + c;
-                 c:=current_scanner.asmgetchar; { let us point to next character. }
-               end;
-            end;
-           if is_register(actasmpattern) then
-            exit;
-           Message(asmr_e_invalid_register);
-           actasmtoken:=raatt.AS_NONE;
-         end;
-      end;
-
-
-    Procedure ti386attreader.BuildReference(oper : t386operand);
-
-      procedure Consume_RParen;
-        begin
-          if actasmtoken <> AS_RPAREN then
-           Begin
-             Message(asmr_e_invalid_reference_syntax);
-             RecoverConsume(true);
-           end
-          else
-           begin
-             Consume(AS_RPAREN);
-             if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
-              Begin
-                Message(asmr_e_invalid_reference_syntax);
-                RecoverConsume(true);
-              end;
-           end;
-        end;
-
-
-      procedure Consume_Scale;
-        var
-          l : longint;
-        begin
-          { we have to process the scaling }
-          l:=BuildConstExpression(false,true);
-          if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) then
-           oper.opr.ref.scalefactor:=l
-          else
-           Begin
-             Message(asmr_e_wrong_scale_factor);
-             oper.opr.ref.scalefactor:=0;
-           end;
-        end;
+      rax86att;
 
-
-      begin
-        oper.InitRef;
-        Consume(AS_LPAREN);
-        Case actasmtoken of
-          AS_INTNUM,
-          AS_MINUS,
-          AS_PLUS: { absolute offset, such as fs:(0x046c) }
-            Begin
-              { offset(offset) is invalid }
-              If oper.opr.Ref.Offset <> 0 Then
-               Begin
-                 Message(asmr_e_invalid_reference_syntax);
-                 RecoverConsume(true);
-               End
-              Else
-               Begin
-                 oper.opr.Ref.Offset:=BuildConstExpression(false,true);
-                 Consume_RParen;
-               end;
-              exit;
-            End;
-          AS_REGISTER: { (reg ...  }
-            Begin
-              { Check if there is already a base (mostly ebp,esp) than this is
-                not allowed, because it will give crashing code }
-              if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or
-                 ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then
-                message(asmr_e_cannot_index_relative_var);
-              oper.opr.ref.base:=actasmregister;
-              Consume(AS_REGISTER);
-              { can either be a register or a right parenthesis }
-              { (reg)        }
-              if actasmtoken=AS_RPAREN then
-               Begin
-                 Consume_RParen;
-                 exit;
-               end;
-              { (reg,reg ..  }
-              Consume(AS_COMMA);
-              if actasmtoken=AS_REGISTER then
-               Begin
-                 oper.opr.ref.index:=actasmregister;
-                 Consume(AS_REGISTER);
-                 { check for scaling ... }
-                 case actasmtoken of
-                   AS_RPAREN:
-                     Begin
-                       Consume_RParen;
-                       exit;
-                     end;
-                   AS_COMMA:
-                     Begin
-                       Consume(AS_COMMA);
-                       Consume_Scale;
-                       Consume_RParen;
-                     end;
-                 else
-                   Begin
-                     Message(asmr_e_invalid_reference_syntax);
-                     RecoverConsume(false);
-                   end;
-                 end; { end case }
-               end
-              else
-               Begin
-                 Message(asmr_e_invalid_reference_syntax);
-                 RecoverConsume(false);
-               end;
-            end; {end case }
-          AS_COMMA: { (, ...  can either be scaling, or index }
-            Begin
-              Consume(AS_COMMA);
-              { Index }
-              if (actasmtoken=AS_REGISTER) then
-               Begin
-                 oper.opr.ref.index:=actasmregister;
-                 Consume(AS_REGISTER);
-                 { check for scaling ... }
-                 case actasmtoken of
-                   AS_RPAREN:
-                     Begin
-                       Consume_RParen;
-                       exit;
-                     end;
-                   AS_COMMA:
-                     Begin
-                       Consume(AS_COMMA);
-                       Consume_Scale;
-                       Consume_RParen;
-                     end;
-                 else
-                   Begin
-                     Message(asmr_e_invalid_reference_syntax);
-                     RecoverConsume(false);
-                   end;
-                 end; {end case }
-               end
-              { Scaling }
-              else
-               Begin
-                 Consume_Scale;
-                 Consume_RParen;
-                 exit;
-               end;
-            end;
-        else
-          Begin
-            Message(asmr_e_invalid_reference_syntax);
-            RecoverConsume(false);
-          end;
-        end;
+    type
+      ti386attreader = class(tx86attreader)
       end;
 
 
-    Procedure ti386attreader.BuildOperand(oper : t386operand);
-      var
-        tempstr,
-        expr : string;
-        typesize,
-        l,k : longint;
-
-
-        procedure AddLabelOperand(hl:tasmlabel);
-          begin
-            if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and
-               is_calljmp(actopcode) then
-             begin
-               oper.opr.typ:=OPR_SYMBOL;
-               oper.opr.symbol:=hl;
-             end
-            else
-             begin
-               oper.InitRef;
-               oper.opr.ref.symbol:=hl;
-             end;
-          end;
-
-
-        procedure MaybeRecordOffset;
-          var
-            hasdot  : boolean;
-            l,
-            toffset,
-            tsize   : longint;
-          begin
-            if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
-             exit;
-            l:=0;
-            hasdot:=(actasmtoken=AS_DOT);
-            if hasdot then
-             begin
-               if expr<>'' then
-                 begin
-                   BuildRecordOffsetSize(expr,toffset,tsize);
-                   inc(l,toffset);
-                   oper.SetSize(tsize,true);
-                 end;
-             end;
-            if actasmtoken in [AS_PLUS,AS_MINUS] then
-             inc(l,BuildConstExpression(true,false));
-            case oper.opr.typ of
-              OPR_LOCAL :
-                begin
-                  { don't allow direct access to fields of parameters, because that
-                    will generate buggy code. Allow it only for explicit typecasting }
-                  if hasdot and
-                     (not oper.hastype) and
-                     (tvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
-                     (current_procinfo.procdef.proccalloption<>pocall_register) then
-                    Message(asmr_e_cannot_access_field_directly_for_parameters);
-                  inc(oper.opr.localsymofs,l)
-                end;
-              OPR_CONSTANT :
-                inc(oper.opr.val,l);
-              OPR_REFERENCE :
-                inc(oper.opr.ref.offset,l);
-              else
-                internalerror(200309221);
-            end;
-          end;
-
-
-        function MaybeBuildReference:boolean;
-          { Try to create a reference, if not a reference is found then false
-            is returned }
-          begin
-            MaybeBuildReference:=true;
-            case actasmtoken of
-              AS_INTNUM,
-              AS_MINUS,
-              AS_PLUS:
-                Begin
-                  oper.opr.ref.offset:=BuildConstExpression(True,False);
-                  if actasmtoken<>AS_LPAREN then
-                    Message(asmr_e_invalid_reference_syntax)
-                  else
-                    BuildReference(oper);
-                end;
-              AS_LPAREN:
-                BuildReference(oper);
-              AS_ID: { only a variable is allowed ... }
-                Begin
-                  tempstr:=actasmpattern;
-                  Consume(AS_ID);
-                  { typecasting? }
-                  if (actasmtoken=AS_LPAREN) and
-                     SearchType(tempstr,typesize) then
-                   begin
-                     oper.hastype:=true;
-                     Consume(AS_LPAREN);
-                     BuildOperand(oper);
-                     Consume(AS_RPAREN);
-                     if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                       oper.SetSize(typesize,true);
-                   end
-                  else
-                   if not oper.SetupVar(tempstr,false) then
-                    Message1(sym_e_unknown_id,tempstr);
-                  { record.field ? }
-                  if actasmtoken=AS_DOT then
-                   begin
-                     BuildRecordOffsetSize(tempstr,l,k);
-                     inc(oper.opr.ref.offset,l);
-                   end;
-                  case actasmtoken of
-                    AS_END,
-                    AS_SEPARATOR,
-                    AS_COMMA: ;
-                    AS_LPAREN:
-                      BuildReference(oper);
-                  else
-                    Begin
-                      Message(asmr_e_invalid_reference_syntax);
-                      Consume(actasmtoken);
-                    end;
-                  end; {end case }
-                end;
-              else
-               MaybeBuildReference:=false;
-            end; { end case }
-          end;
-
-
-      const
-        regsize_2_size: array[S_B..S_L] of longint = (1,2,4);
-      var
-        tempreg : tregister;
-        hl      : tasmlabel;
-      Begin
-        expr:='';
-        case actasmtoken of
-          AS_LPAREN: { Memory reference or constant expression }
-            Begin
-              oper.InitRef;
-              BuildReference(oper);
-            end;
-
-          AS_DOLLAR: { Constant expression  }
-            Begin
-              Consume(AS_DOLLAR);
-              BuildConstantOperand(oper);
-            end;
-
-          AS_INTNUM,
-          AS_MINUS,
-          AS_PLUS:
-            Begin
-              { Constant memory offset }
-              { This must absolutely be followed by (  }
-              oper.InitRef;
-              oper.opr.ref.offset:=BuildConstExpression(True,False);
-              if actasmtoken<>AS_LPAREN then
-                Message(asmr_e_invalid_reference_syntax)
-              else
-                BuildReference(oper);
-            end;
+  implementation
 
-          AS_STAR: { Call from memory address }
-            Begin
-              Consume(AS_STAR);
-              if actasmtoken=AS_REGISTER then
-               begin
-                 oper.opr.typ:=OPR_REGISTER;
-                 oper.opr.reg:=actasmregister;
-                 oper.SetSize(regsize_2_size[reg2opsize(actasmregister)],true);
-                 Consume(AS_REGISTER);
-               end
-              else
-               begin
-                 oper.InitRef;
-                 if not MaybeBuildReference then
-                  Message(asmr_e_syn_operand);
-               end;
-              { this is only allowed for call's and jmp's }
-              if not is_calljmp(actopcode) then
-               Message(asmr_e_syn_operand);
-            end;
-
-          AS_ID: { A constant expression, or a Variable ref.  }
-            Begin
-              { Local Label ? }
-              if is_locallabel(actasmpattern) then
-               begin
-                 CreateLocalLabel(actasmpattern,hl,false);
-                 Consume(AS_ID);
-                 AddLabelOperand(hl);
-               end
-              else
-               { Check for label }
-               if SearchLabel(actasmpattern,hl,false) then
-                begin
-                  Consume(AS_ID);
-                  AddLabelOperand(hl);
-                end
-              else
-               { probably a variable or normal expression }
-               { or a procedure (such as in CALL ID)      }
-               Begin
-                 { is it a constant ? }
-                 if SearchIConstant(actasmpattern,l) then
-                  Begin
-                    if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
-                     Message(asmr_e_invalid_operand_type);
-                    BuildConstantOperand(oper);
-                  end
-                 else
-                  begin
-                    expr:=actasmpattern;
-                    Consume(AS_ID);
-                    { typecasting? }
-                    if (actasmtoken=AS_LPAREN) and
-                       SearchType(expr,typesize) then
-                     begin
-                       oper.hastype:=true;
-                       Consume(AS_LPAREN);
-                       BuildOperand(oper);
-                       Consume(AS_RPAREN);
-                       if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                         oper.SetSize(typesize,true);
-                     end
-                    else
-                     begin
-                       if oper.SetupVar(expr,false) then
-                        begin
-                        end
-                       else
-                        Begin
-                          { look for special symbols ... }
-                          if expr= '__HIGH' then
-                            begin
-                              consume(AS_LPAREN);
-                              if not oper.setupvar('high'+actasmpattern,false) then
-                                Message1(sym_e_unknown_id,'high'+actasmpattern);
-                              consume(AS_ID);
-                              consume(AS_RPAREN);
-                            end
-                          else
-                           if expr = '__RESULT' then
-                            oper.SetUpResult
-                          else
-                           if expr = '__SELF' then
-                            oper.SetupSelf
-                          else
-                           if expr = '__OLDEBP' then
-                            oper.SetupOldEBP
-                          else
-                            { check for direct symbolic names   }
-                            { only if compiling the system unit }
-                            if (cs_compilesystem in aktmoduleswitches) then
-                             begin
-                               if not oper.SetupDirectVar(expr) then
-                                Begin
-                                  { not found, finally ... add it anyways ... }
-                                  Message1(asmr_w_id_supposed_external,expr);
-                                  oper.InitRef;
-                                  oper.opr.ref.symbol:=objectlibrary.newasmsymbol(expr);
-                                end;
-                             end
-                          else
-                            Message1(sym_e_unknown_id,expr);
-                        end;
-                     end;
-                  end;
-                  if actasmtoken=AS_DOT then
-                    MaybeRecordOffset;
-                  { add a constant expression? }
-                  if (actasmtoken=AS_PLUS) then
-                   begin
-                     l:=BuildConstExpression(true,false);
-                     case oper.opr.typ of
-                       OPR_CONSTANT :
-                         inc(oper.opr.val,l);
-                       OPR_LOCAL :
-                         inc(oper.opr.localsymofs,l);
-                       OPR_REFERENCE :
-                         inc(oper.opr.ref.offset,l);
-                       else
-                         internalerror(200309202);
-                     end;
-                   end
-               end;
-              { Do we have a indexing reference, then parse it also }
-              if actasmtoken=AS_LPAREN then
-                BuildReference(oper);
-            end;
-
-          AS_REGISTER: { Register, a variable reference or a constant reference  }
-            Begin
-              { save the type of register used. }
-              tempreg:=actasmregister;
-              Consume(AS_REGISTER);
-              if actasmtoken = AS_COLON then
-               Begin
-                 Consume(AS_COLON);
-                 oper.InitRef;
-                 oper.opr.ref.segment:=tempreg;
-                 { This must absolutely be followed by a reference }
-                 if not MaybeBuildReference then
-                  Begin
-                    Message(asmr_e_invalid_seg_override);
-                    Consume(actasmtoken);
-                  end;
-               end
-              { Simple register  }
-              else if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
-                Begin
-                  if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
-                    Message(asmr_e_invalid_operand_type);
-                  oper.opr.typ:=OPR_REGISTER;
-                  oper.opr.reg:=tempreg;
-                  oper.SetSize(tcgsize2size[cg.reg_cgsize(oper.opr.reg)],true);
-                end
-              else
-                Message(asmr_e_syn_operand);
-            end;
-          AS_END,
-          AS_SEPARATOR,
-          AS_COMMA: ;
-        else
-          Begin
-            Message(asmr_e_syn_operand);
-            Consume(actasmtoken);
-          end;
-        end; { end case }
-      end;
-
-
-    procedure ti386attreader.BuildOpCode(instr : t386instruction);
-      var
-        operandnum : longint;
-        PrefixOp,OverrideOp: tasmop;
-      Begin
-        PrefixOp:=A_None;
-        OverrideOp:=A_None;
-        { prefix seg opcode / prefix opcode }
-        repeat
-          if is_prefix(actopcode) then
-            begin
-              PrefixOp:=ActOpcode;
-              with instr do
-                begin
-                  opcode:=ActOpcode;
-                  condition:=ActCondition;
-                  opsize:=ActOpsize;
-                  ConcatInstruction(curlist);
-                end;
-              Consume(AS_OPCODE);
-            end
-          else
-            if is_override(actopcode) then
-              begin
-                OverrideOp:=ActOpcode;
-                with instr do
-                  begin
-                    opcode:=ActOpcode;
-                    condition:=ActCondition;
-                    opsize:=ActOpsize;
-                    ConcatInstruction(curlist);
-                  end;
-                Consume(AS_OPCODE);
-              end
-            else
-              break;
-          { allow for newline as in gas styled syntax }
-          while actasmtoken=AS_SEPARATOR do
-            Consume(AS_SEPARATOR);
-        until (actasmtoken<>AS_OPCODE);
-        { opcode }
-        if (actasmtoken<>AS_OPCODE) then
-         Begin
-           Message(asmr_e_invalid_or_missing_opcode);
-           RecoverConsume(true);
-           exit;
-         end;
-        { Fill the instr object with the current state }
-        with instr do
-          begin
-            Opcode:=ActOpcode;
-            condition:=ActCondition;
-            opsize:=ActOpsize;
-          end;
-
-        { Valid combination of prefix/override and instruction ?  }
-
-        if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then
-           Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern);
-
-        if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then
-          Message1(asmr_e_invalid_override_and_opcode,actasmpattern);
-        { We are reading operands, so opcode will be an AS_ID }
-        operandnum:=1;
-        Consume(AS_OPCODE);
-        { Zero operand opcode ?  }
-        if actasmtoken in [AS_SEPARATOR,AS_END] then
-         begin
-           operandnum:=0;
-           exit;
-         end;
-        { Read the operands }
-        repeat
-          case actasmtoken of
-            AS_COMMA: { Operand delimiter }
-              Begin
-                if operandnum > Max_Operands then
-                  Message(asmr_e_too_many_operands)
-                else
-                  Inc(operandnum);
-                Consume(AS_COMMA);
-              end;
-            AS_SEPARATOR,
-            AS_END : { End of asm operands for this opcode  }
-              begin
-                break;
-              end;
-          else
-            BuildOperand(instr.Operands[operandnum] as t386operand);
-          end; { end case }
-        until false;
-        instr.Ops:=operandnum;
-      end;
-
-
-    function ti386attreader.is_asmopcode(const s: string):boolean;
-      const
-        { We need first to check the long prefixes, else we get probs
-          with things like movsbl }
-        att_sizesuffixstr : array[0..9] of string[2] = (
-          '','BW','BL','WL','B','W','L','S','Q','T'
-        );
-        att_sizesuffix : array[0..9] of topsize = (
-          S_NO,S_BW,S_BL,S_WL,S_B,S_W,S_L,S_FS,S_IQ,S_FX
-        );
-        att_sizefpusuffix : array[0..9] of topsize = (
-          S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_FL,S_FS,S_IQ,S_FX
-        );
-        att_sizefpuintsuffix : array[0..9] of topsize = (
-          S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_IL,S_IS,S_IQ,S_NO
-        );
-      var
-        str2opentry: tstr2opentry;
-        cond : string[4];
-        cnd  : tasmcond;
-        len,
-        j,
-        sufidx : longint;
-      Begin
-        is_asmopcode:=FALSE;
-
-        actopcode:=A_None;
-        actcondition:=C_None;
-        actopsize:=S_NO;
-
-        { search for all possible suffixes }
-        for sufidx:=low(att_sizesuffixstr) to high(att_sizesuffixstr) do
-         begin
-           len:=length(s)-length(att_sizesuffixstr[sufidx]);
-           if copy(s,len+1,length(att_sizesuffixstr[sufidx]))=att_sizesuffixstr[sufidx] then
-            begin
-              { here we search the entire table... }
-              str2opentry:=nil;
-              if {(length(s)>0) and} (len>0) then
-                str2opentry:=tstr2opentry(iasmops.search(copy(s,1,len)));
-              if assigned(str2opentry) then
-                begin
-                  actopcode:=str2opentry.op;
-                  if gas_needsuffix[actopcode]=attsufFPU then
-                   actopsize:=att_sizefpusuffix[sufidx]
-                  else if gas_needsuffix[actopcode]=attsufFPUint then
-                   actopsize:=att_sizefpuintsuffix[sufidx]
-                  else
-                   actopsize:=att_sizesuffix[sufidx];
-                  actasmtoken:=AS_OPCODE;
-                  is_asmopcode:=TRUE;
-                  exit;
-                end;
-              { not found, check condition opcodes }
-              j:=0;
-              while (j<CondAsmOps) do
-               begin
-                 if Copy(s,1,Length(CondAsmOpStr[j]))=CondAsmOpStr[j] then
-                  begin
-                    cond:=Copy(s,Length(CondAsmOpStr[j])+1,len-Length(CondAsmOpStr[j]));
-                    if cond<>'' then
-                     begin
-                       for cnd:=low(TasmCond) to high(TasmCond) do
-                        if Cond=Upper(cond2str[cnd]) then
-                         begin
-                           actopcode:=CondASmOp[j];
-                           if gas_needsuffix[actopcode]=attsufFPU then
-                            actopsize:=att_sizefpusuffix[sufidx]
-                           else if gas_needsuffix[actopcode]=attsufFPUint then
-                            actopsize:=att_sizefpuintsuffix[sufidx]
-                           else
-                            actopsize:=att_sizesuffix[sufidx];
-                           actcondition:=cnd;
-                           actasmtoken:=AS_OPCODE;
-                           is_asmopcode:=TRUE;
-                           exit;
-                         end;
-                     end;
-                  end;
-                 inc(j);
-               end;
-           end;
-         end;
-      end;
-
-
-    procedure ti386attreader.handleopcode;
-      var
-        instr : T386Instruction;
-      begin
-        instr:=T386Instruction.Create(T386Operand);
-        instr.OpOrder:=op_att;
-        BuildOpcode(instr);
-        instr.AddReferenceSizes;
-        instr.SetInstructionOpsize;
-        instr.CheckOperandSizes;
-        instr.ConcatInstruction(curlist);
-        instr.Free;
-      end;
-
-
-{*****************************************************************************
-                                     Initialize
-*****************************************************************************}
+    uses
+      rabase,systems;
 
 const
   asmmode_i386_att_info : tasmmodeinfo =
@@ -806,191 +52,7 @@ initialization
 end.
 {
   $Log$
-  Revision 1.58  2003-11-12 16:05:39  florian
-    * assembler readers OOPed
-    + typed currency constants
-    + typed 128 bit float constants if the CPU supports it
-
-  Revision 1.57  2003/11/10 19:08:32  peter
-    * line numbering is now only done when #10, #10#13 is really parsed
-      instead of when it is the next character
-
-  Revision 1.56  2003/10/29 16:47:18  peter
-    * fix field offset in reference
-
-  Revision 1.55  2003/10/26 13:37:22  florian
-    * fixed web bug 2128
-
-  Revision 1.54  2003/10/24 17:39:03  peter
-    * more intel parser updates
-
-  Revision 1.53  2003/10/23 17:19:44  peter
-    * typecasting fixes
-    * reference building more delphi compatible
-
-  Revision 1.52  2003/10/20 19:29:35  peter
-    * fix check for register subscription of reference parameter
-
-  Revision 1.51  2003/10/16 21:29:24  peter
-    + __HIGH() to retrieve high value
-
-  Revision 1.50  2003/10/07 18:21:18  peter
-    * fix crash
-    * allow parameter subscription for register parameters
-
-  Revision 1.49  2003/10/01 20:34:49  peter
-    * procinfo unit contains tprocinfo
-    * cginfo renamed to cgbase
-    * moved cgmessage to verbose
-    * fixed ppc and sparc compiles
-
-  Revision 1.48  2003/09/23 20:37:53  peter
-    * fix global var+offset
-
-  Revision 1.47  2003/09/23 17:56:06  peter
-    * locals and paras are allocated in the code generation
-    * tvarsym.localloc contains the location of para/local when
-      generating code for the current procedure
-
-  Revision 1.46  2003/09/03 15:55:01  peter
-    * NEWRA branch merged
-
-  Revision 1.45.2.2  2003/08/31 15:46:26  peter
-    * more updates for tregister
-
-  Revision 1.45.2.1  2003/08/28 18:35:08  peter
-    * tregister changed to cardinal
-
-  Revision 1.45  2003/05/30 23:57:08  peter
-    * more sparc cleanup
-    * accumulator removed, splitted in function_return_reg (called) and
-      function_result_reg (caller)
-
-  Revision 1.44  2003/05/22 21:32:29  peter
-    * removed some unit dependencies
-
-  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
-    * removed some ie checks
-
-  Revision 1.40  2003/03/18 18:15:53  peter
-    * changed reg2opsize to function
-
-  Revision 1.39  2003/02/20 15:52:58  pierre
-   * fix a range check error
-
-  Revision 1.38  2003/02/19 22:00:16  daniel
-    * Code generator converted to new register notation
-    - Horribily outdated todo.txt removed
-
-  Revision 1.37  2003/02/03 22:47:14  daniel
-    - Removed reg_2_opsize array
-
-  Revision 1.36  2003/01/08 18:43:57  daniel
-   * Tregister changed into a record
-
-  Revision 1.35  2002/12/14 15:02:03  carl
-    * maxoperands -> max_operands (for portability in rautils.pas)
-    * fix some range-check errors with loadconst
-    + add ncgadd unit to m68k
-    * some bugfix of a_param_reg with LOC_CREFERENCE
-
-  Revision 1.34  2002/12/01 22:08:34  carl
-    * some small cleanup (remove some specific operators which are not supported)
-
-  Revision 1.33  2002/11/30 23:16:39  carl
-    - removed unused message
-
-  Revision 1.32  2002/11/15 01:58:58  peter
-    * merged changes from 1.0.7 up to 04-11
-      - -V option for generating bug report tracing
-      - more tracing for option parsing
-      - errors for cdecl and high()
-      - win32 import stabs
-      - win32 records<=8 are returned in eax:edx (turned off by default)
-      - heaptrc update
-      - more info for temp management in .s file with EXTDEBUG
-
-  Revision 1.31  2002/09/03 16:26:28  daniel
-    * Make Tprocdef.defs protected
-
-  Revision 1.30  2002/08/13 18:01:52  carl
-    * rename swatoperands to swapoperands
-    + m68k first compilable version (still needs a lot of testing):
-        assembler generator, system information , inline
-        assembler reader.
-
-  Revision 1.29  2002/08/12 15:08:42  carl
-    + stab register indexes for powerpc (moved from gdb to cpubase)
-    + tprocessor enumeration moved to cpuinfo
-    + linker in target_info is now a class
-    * many many updates for m68k (will soon start to compile)
-    - removed some ifdef or correct them for correct cpu
-
-  Revision 1.28  2002/08/11 14:32:31  peter
-    * renamed current_library to objectlibrary
-
-  Revision 1.27  2002/08/11 13:24:17  peter
-    * saving of asmsymbols in ppu supported
-    * asmsymbollist global is removed and moved into a new class
-      tasmlibrarydata that will hold the info of a .a file which
-      corresponds with a single module. Added librarydata to tmodule
-      to keep the library info stored for the module. In the future the
-      objectfiles will also be stored to the tasmlibrarydata class
-    * all getlabel/newasmsymbol and friends are moved to the new class
-
-  Revision 1.26  2002/07/26 21:15:44  florian
-    * rewrote the system handling
-
-  Revision 1.25  2002/07/01 18:46:34  peter
-    * internal linker
-    * reorganized aasm layer
-
-  Revision 1.24  2002/05/18 13:34:25  peter
-    * readded missing revisions
-
-  Revision 1.23  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.21  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.20  2002/04/14 17:01:52  carl
-  + att_reg2str -> gas_reg2str
-
-  Revision 1.19  2002/04/04 19:06:13  peter
-    * removed unused units
-    * use tlocation.size in cg.a_*loc*() routines
-
-  Revision 1.18  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.17  2002/03/28 20:48:25  carl
-  - remove go32v1 support
-
-  Revision 1.16  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
-
+  Revision 1.59  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
 }

compiler/i386/ra386int.pas

@@ -65,10 +65,10 @@ Unit Ra386int;
          procedure BuildConstSymbolExpression(needofs,isref:boolean;var value:longint;var asmsym:string);
          function BuildConstExpression:longint;
          function BuildRefConstExpression:longint;
-         procedure BuildReference(oper : t386operand);
-         procedure BuildOperand(oper: t386operand);
-         procedure BuildConstantOperand(oper: t386operand);
-         procedure BuildOpCode(instr : t386instruction);
+         procedure BuildReference(oper : tx86operand);
+         procedure BuildOperand(oper: tx86operand);
+         procedure BuildConstantOperand(oper: tx86operand);
+         procedure BuildOpCode(instr : tx86instruction);
          procedure BuildConstant(maxvalue: longint);
        end;
 
@@ -1028,7 +1028,7 @@ Unit Ra386int;
       end;
 
 
-    procedure ti386intreader.BuildReference(oper : t386operand);
+    procedure ti386intreader.BuildReference(oper : tx86operand);
       var
         k,l,scale : longint;
         tempstr,hs : string;
@@ -1366,7 +1366,7 @@ Unit Ra386int;
       end;
 
 
-    Procedure ti386intreader.BuildConstantOperand(oper: t386operand);
+    Procedure ti386intreader.BuildConstantOperand(oper: tx86operand);
       var
         l : longint;
         tempstr : string;
@@ -1393,7 +1393,7 @@ Unit Ra386int;
       end;
 
 
-    Procedure ti386intreader.BuildOperand(oper: t386operand);
+    Procedure ti386intreader.BuildOperand(oper: tx86operand);
 
         procedure AddLabelOperand(hl:tasmlabel);
         begin
@@ -1634,7 +1634,7 @@ Unit Ra386int;
       end;
 
 
-    Procedure ti386intreader.BuildOpCode(instr : t386instruction);
+    Procedure ti386intreader.BuildOpCode(instr : tx86instruction);
       var
         PrefixOp,OverrideOp: tasmop;
         size,
@@ -1751,7 +1751,7 @@ Unit Ra386int;
                    Consume(AS_PTR);
                    instr.Operands[operandnum].InitRef;
                  end;
-                BuildOperand(instr.Operands[operandnum] as t386operand);
+                BuildOperand(instr.Operands[operandnum] as tx86operand);
                 { now set the size which was specified by the override }
                 instr.Operands[operandnum].setsize(size,true);
               end;
@@ -1776,10 +1776,10 @@ Unit Ra386int;
                    Consume(AS_PTR);
                    instr.Operands[operandnum].InitRef;
                  end;
-                BuildOperand(instr.Operands[operandnum] as t386operand);
+                BuildOperand(instr.Operands[operandnum] as tx86operand);
               end;
             else
-              BuildOperand(instr.Operands[operandnum] as t386operand);
+              BuildOperand(instr.Operands[operandnum] as tx86operand);
           end; { end case }
         until false;
         instr.Ops:=operandnum;
@@ -1856,7 +1856,7 @@ Unit Ra386int;
   function ti386intreader.Assemble: tlinkedlist;
     Var
       hl : tasmlabel;
-      instr : T386Instruction;
+      instr : Tx86Instruction;
     Begin
       Message1(asmr_d_start_reading,'intel');
       inexpression:=FALSE;
@@ -1920,7 +1920,7 @@ Unit Ra386int;
 
           AS_OPCODE :
             Begin
-              instr:=T386Instruction.Create(T386Operand);
+              instr:=Tx86Instruction.Create(Tx86Operand);
               BuildOpcode(instr);
               with instr do
                 begin
@@ -1977,7 +1977,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.68  2003-11-29 20:13:25  florian
+  Revision 1.69  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.68  2003/11/29 20:13:25  florian
     * fixed several pi_do_call problems
 
   Revision 1.67  2003/11/29 15:53:06  florian

compiler/systems.pas

@@ -70,7 +70,7 @@ interface
             ,asmmode_ppc_motorola
             ,asmmode_arm_gas
             ,asmmode_sparc_gas
-            ,asmmode_x8664_gas
+            ,asmmode_x86_64_gas
        );
 
      (* IMPORTANT NOTE:
@@ -649,7 +649,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.78  2004-01-12 16:39:40  peter
+  Revision 1.79  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.78  2004/01/12 16:39:40  peter
     * sparc updates, mostly float related
 
   Revision 1.77  2004/01/04 21:17:51  jonas

compiler/x86/cgx86.pas

@@ -37,7 +37,6 @@ unit cgx86;
     type
       tcgx86 = class(tcg)
         rgfpu   : Trgx86fpu;
-        procedure init_register_allocators;override;
         procedure done_register_allocators;override;
 
         function getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;override;
@@ -188,19 +187,6 @@ unit cgx86;
       end;
 
 
-    procedure Tcgx86.init_register_allocators;
-      begin
-        inherited init_register_allocators;
-        if cs_create_pic in aktmoduleswitches then
-          rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP,RS_EBX])
-        else
-          rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]);
-        rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_MM0,RS_MM1,RS_MM2,RS_MM3,RS_MM4,RS_MM5,RS_MM6,RS_MM7],first_sse_imreg,[]);
-        rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_MM0,RS_MM1,RS_MM2,RS_MM3,RS_MM4,RS_MM5,RS_MM6,RS_MM7],first_sse_imreg,[]);
-        rgfpu:=Trgx86fpu.create;
-      end;
-
-
     procedure Tcgx86.done_register_allocators;
       begin
         rg[R_INTREGISTER].free;
@@ -1806,63 +1792,45 @@ unit cgx86;
       var
         href : treference;
         size : longint;
+        r : integer;
       begin
         { Get temp }
         size:=0;
-        if RS_EBX in rg[R_INTREGISTER].used_in_proc then
-          inc(size,POINTER_SIZE);
-        if RS_ESI in rg[R_INTREGISTER].used_in_proc then
-          inc(size,POINTER_SIZE);
-        if RS_EDI in rg[R_INTREGISTER].used_in_proc then
-          inc(size,POINTER_SIZE);
+        for r:=low(saved_standard_registers) to high(saved_standard_registers) do
+          if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
+            inc(size,POINTER_SIZE);
         if size>0 then
           begin
             tg.GetTemp(list,size,tt_noreuse,current_procinfo.save_regs_ref);
             { Copy registers to temp }
             href:=current_procinfo.save_regs_ref;
-            if RS_EBX in rg[R_INTREGISTER].used_in_proc then
-              begin
-                a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_EBX,href);
-                inc(href.offset,POINTER_SIZE);
-              end;
-            if RS_ESI in rg[R_INTREGISTER].used_in_proc then
-              begin
-                a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_ESI,href);
-                inc(href.offset,POINTER_SIZE);
-              end;
-            if RS_EDI in rg[R_INTREGISTER].used_in_proc then
+
+            for r:=low(saved_standard_registers) to high(saved_standard_registers) do
               begin
-                a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_EDI,href);
-                inc(href.offset,POINTER_SIZE);
+                if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
+                  begin
+                    a_load_reg_ref(list,OS_ADDR,OS_ADDR,newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE),href);
+                    inc(href.offset,POINTER_SIZE);
+                  end;
+                include(rg[R_INTREGISTER].preserved_by_proc,saved_standard_registers[r]);
               end;
           end;
-        include(rg[R_INTREGISTER].preserved_by_proc,RS_EBX);
-        include(rg[R_INTREGISTER].preserved_by_proc,RS_ESI);
-        include(rg[R_INTREGISTER].preserved_by_proc,RS_EDI);
       end;
 
 
     procedure tcgx86.g_restore_standard_registers(list:Taasmoutput);
       var
         href : treference;
+        r : integer;
       begin
         { Copy registers from temp }
         href:=current_procinfo.save_regs_ref;
-        if RS_EBX in rg[R_INTREGISTER].used_in_proc then
-          begin
-            a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EBX);
-            inc(href.offset,POINTER_SIZE);
-          end;
-        if RS_ESI in rg[R_INTREGISTER].used_in_proc then
-          begin
-            a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_ESI);
-            inc(href.offset,POINTER_SIZE);
-          end;
-        if RS_EDI in rg[R_INTREGISTER].used_in_proc then
-          begin
-            a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EDI);
-            inc(href.offset,POINTER_SIZE);
-          end;
+        for r:=low(saved_standard_registers) to high(saved_standard_registers) do
+          if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
+            begin
+              a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE));
+              inc(href.offset,POINTER_SIZE);
+            end;
         tg.UnGetTemp(list,current_procinfo.save_regs_ref);
       end;
 
@@ -1927,7 +1895,11 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.101  2004-01-14 21:43:54  peter
+  Revision 1.102  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.101  2004/01/14 21:43:54  peter
     * add release_openarrayvalue
 
   Revision 1.100  2003/12/26 14:02:30  peter

compiler/x86/cpubase.pas

@@ -118,22 +118,22 @@ uses
       first_fpu_imreg     = $08;
 
       { MM Super registers }
-      RS_MM0        = $00;
-      RS_MM1        = $01;
-      RS_MM2        = $02;
-      RS_MM3        = $03;
-      RS_MM4        = $04;
-      RS_MM5        = $05;
-      RS_MM6        = $06;
-      RS_MM7        = $07;
-      RS_MM8        = $08;
-      RS_MM9        = $09;
-      RS_MM10       = $0a;
-      RS_MM11       = $0b;
-      RS_MM12       = $0c;
-      RS_MM13       = $0d;
-      RS_MM14       = $0e;
-      RS_MM15       = $0f;
+      RS_XMM0        = $00;
+      RS_XMM1        = $01;
+      RS_XMM2        = $02;
+      RS_XMM3        = $03;
+      RS_XMM4        = $04;
+      RS_XMM5        = $05;
+      RS_XMM6        = $06;
+      RS_XMM7        = $07;
+      RS_XMM8        = $08;
+      RS_XMM9        = $09;
+      RS_XMM10       = $0a;
+      RS_XMM11       = $0b;
+      RS_XMM12       = $0c;
+      RS_XMM13       = $0d;
+      RS_XMM14       = $0e;
+      RS_XMM15       = $0f;
 
       { Number of first imaginary register }
 {$ifdef x86_64}
@@ -535,7 +535,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2004-01-12 16:37:59  peter
+  Revision 1.36  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.35  2004/01/12 16:37:59  peter
     * moved spilling code from taicpu to rg
 
   Revision 1.34  2003/12/26 13:19:16  florian

compiler/x86/radirect.pas

@@ -1,500 +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,
-       { codegen }
-       cgbase,procinfo,
-       { constants }
-       itx86att,
-       cpubase
-       ;
-
-    function assemble : tnode;
-
-      var
-         uhs,
-         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)));
-           s:='';
-         end;
-
-     begin
-       ende:=false;
-       s:='';
-       if assigned(current_procinfo.procdef.funcretsym) and
-          is_fpu(current_procinfo.procdef.rettype.def) then
-         tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
-       c:=current_scanner.asmgetcharstart;
-       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(current_procinfo.procdef) then
-                            begin
-                               { is the last written character an special }
-                               { char ?                                   }
-                               if (s[length(s)]='%') and
-                                  (not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption)) and
-                                  ((pos('AX',upper(hs))>0) or
-                                  (pos('AL',upper(hs))>0)) then
-                                 tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
-                               if (s[length(s)]<>'%') and
-                                 (s[length(s)]<>'$') and
-                                 (s[length(s)]<>'.') and
-                                 ((s[length(s)]<>'0') or (hs[1]<>'x')) then
-                                 begin
-                                    if assigned(current_procinfo.procdef.localst) and
-                                       (current_procinfo.procdef.localst.symtablelevel>=normal_function_level) then
-                                      sym:=tsym(current_procinfo.procdef.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:='%%'+tvarsym(sym).name;
-                                           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(current_procinfo.procdef.parast) then
-                                           sym:=tsym(current_procinfo.procdef.parast.search(upper(hs)))
-                                         else
-                                           sym:=nil;
-                                         if assigned(sym) then
-                                           begin
-                                              if sym.typ=varsym then
-                                                begin
-                                                  hs:='%%'+tvarsym(sym).name;
-                                                  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
-                                         uhs:=upper(hs);
-                                         if (uhs='__SELF') then
-                                           begin
-                                             if assigned(current_procinfo.procdef._class) then
-                                              uhs:='self'
-                                             else
-                                              begin
-                                                Message(asmr_e_cannot_use_SELF_outside_a_method);
-                                                uhs:='';
-                                              end;
-                                           end
-                                         else
-                                          if (uhs='__OLDEBP') then
-                                           begin
-                                             if current_procinfo.procdef.parast.symtablelevel>normal_function_level then
-                                              uhs:='parentframe'
-                                             else
-                                              begin
-                                                Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
-                                                uhs:='';
-                                              end;
-                                           end
-                                         else
-                                          if uhs='__RESULT' then
-                                           begin
-                                             if (not is_void(current_procinfo.procdef.rettype.def)) then
-                                              uhs:='result'
-                                             else
-                                              begin
-                                                Message(asmr_e_void_function);
-                                                uhs:='';
-                                              end;
-                                           end;
-
-                                         if uhs<>'' then
-                                           searchsym(uhs,sym,srsymtable)
-                                         else
-                                           sym:=nil;
-                                         if assigned(sym) then
-                                          begin
-                                            case sym.owner.symtabletype of
-                                              globalsymtable,
-                                              staticsymtable :
-                                                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;
-                                              parasymtable,
-                                              localsymtable :
-                                                begin
-                                                  case sym.typ of
-                                                    varsym :
-                                                      begin
-                                                        hs:='%%'+tvarsym(sym).name;
-                                                        inc(tvarsym(sym).refs);
-                                                      end;
-                                                    typedconstsym :
-                                                      begin
-                                                        Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
-                                                        hs:=ttypedconstsym(sym).mangledname;
-                                                      end;
-                                                    else
-                                                      Message(asmr_e_wrong_sym_type);
-                                                  end;
-                                                end;
-                                             end;
-                                           end
-                                         end;
-                                      end;
-                                 end;
-                            end;
-                          s:=s+hs;
-                       end;
-                end;
-              '{',';',#10,#13 :
-                begin
-                  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
-{$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-11-10 19:08:32  peter
-    * line numbering is now only done when #10, #10#13 is really parsed
-      instead of when it is the next character
-
-  Revision 1.10  2003/10/01 20:34:51  peter
-    * procinfo unit contains tprocinfo
-    * cginfo renamed to cgbase
-    * moved cgmessage to verbose
-    * fixed ppc and sparc compiles
-
-  Revision 1.9  2003/09/23 17:56:06  peter
-    * locals and paras are allocated in the code generation
-    * tvarsym.localloc contains the location of para/local when
-      generating code for the current procedure
-
-  Revision 1.8  2003/09/03 15:55:02  peter
-    * NEWRA branch merged
-
-  Revision 1.7.2.1  2003/08/27 21:06:34  peter
-    * more updates
-
-  Revision 1.7  2003/06/13 21:19:33  peter
-    * current_procdef removed, use current_procinfo.procdef instead
-
-  Revision 1.6  2003/06/02 21:42:05  jonas
-    * function results can now also be regvars
-    - removed tprocinfo.return_offset, never use it again since it's invalid
-      if the result is a regvar
-
-  Revision 1.5  2003/05/22 21:33:31  peter
-    * removed some unit dependencies
-
-  Revision 1.4  2003/05/15 18:58:54  peter
-    * removed selfpointer_offset, vmtpointer_offset
-    * tvarsym.adjusted_address
-    * address in localsymtable is now in the real direction
-    * removed some obsolete globals
-
-  Revision 1.3  2003/05/13 19:15:28  peter
-    * removed radirect
-
-  Revision 1.2  2003/05/01 07:59:43  florian
-    * introduced defaultordconsttype to decribe the default size of ordinal constants
-      on 64 bit CPUs it's equal to cs64bitdef while on 32 bit CPUs it's equal to s32bitdef
-    + added defines CPU32 and CPU64 for 32 bit and 64 bit CPUs
-    * int64s/qwords are allowed as for loop counter on 64 bit CPUs
-
-  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_procinfo.procdef
-    * procinfo renamed to current_procinfo
-    * procinfo will now be stored in current_module so it can be
-      cleaned up properly
-    * gen_main_procsym changed to create_main_proc and release_main_proc
-      to also generate a tprocinfo structure
-    * fixed unit implicit initfinal
-
-  Revision 1.10  2003/04/27 07:29:52  peter
-    * current_procinfo.procdef cleanup, current_procinfo.procdef is now always nil when parsing
-      a new procdef declaration
-    * aktprocsym removed
-    * lexlevel removed, use symtable.symtablelevel instead
-    * implicit init/final code uses the normal genentry/genexit
-    * funcret state checking updated for new funcret handling
-
-  Revision 1.9  2003/04/25 20:59:35  peter
-    * removed funcretn,funcretsym, function result is now in varsym
-      and aliases for result and function name are added using absolutesym
-    * vs_hidden parameter for funcret passed in parameter
-    * vs_hidden fixes
-    * writenode changed to printnode and released from extdebug
-    * -vp option added to generate a tree.log with the nodetree
-    * nicer printnode for statements, callnode
-
-  Revision 1.8  2003/04/25 12:04:31  florian
-    * merged agx64att and ag386att to x86/agx86att
-
-  Revision 1.7  2003/04/21 20:05:10  peter
-    * removed some ie checks
-
-  Revision 1.6  2003/01/08 18:43:57  daniel
-   * Tregister changed into a record
-
-  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
-
-}

compiler/x86/rax86.pas

@@ -41,13 +41,13 @@ Function CheckOverride(overrideop,op:tasmop): Boolean;
 Procedure FWaitWarning;
 
 type
-  T386Operand=class(TOperand)
+  Tx86Operand=class(TOperand)
     opsize  : topsize;
     Procedure SetSize(_size:longint;force:boolean);override;
     Procedure SetCorrectSize(opcode:tasmop);override;
   end;
 
-  T386Instruction=class(TInstruction)
+  Tx86Instruction=class(TInstruction)
     OpOrder : TOperandOrder;
     opsize  : topsize;
     constructor Create(optype : tcoperand);override;
@@ -193,10 +193,10 @@ begin
 end;
 
 {*****************************************************************************
-                              T386Operand
+                              TX86Operand
 *****************************************************************************}
 
-Procedure T386Operand.SetSize(_size:longint;force:boolean);
+Procedure Tx86Operand.SetSize(_size:longint;force:boolean);
 begin
   inherited SetSize(_size,force);
   { OS_64 will be set to S_L and be fixed later
@@ -205,7 +205,7 @@ begin
 end;
 
 
-Procedure T386Operand.SetCorrectSize(opcode:tasmop);
+Procedure Tx86Operand.SetCorrectSize(opcode:tasmop);
 begin
   if gas_needsuffix[opcode]=attsufFPU then
     begin
@@ -229,14 +229,14 @@ end;
                               T386Instruction
 *****************************************************************************}
 
-constructor T386Instruction.Create(optype : tcoperand);
+constructor Tx86Instruction.Create(optype : tcoperand);
 begin
   inherited Create(optype);
   Opsize:=S_NO;
 end;
 
 
-procedure T386Instruction.SwapOperands;
+procedure Tx86Instruction.SwapOperands;
 begin
   Inherited SwapOperands;
   { mark the correct order }
@@ -247,7 +247,7 @@ begin
 end;
 
 
-procedure T386Instruction.AddReferenceSizes;
+procedure Tx86Instruction.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 }
@@ -256,69 +256,73 @@ var
   s : tasmsymbol;
   so : longint;
 begin
-  for i:=1to ops do
-   begin
-   operands[i].SetCorrectSize(opcode);
-   if t386operand(operands[i]).opsize=S_NO then
+  for i:=1 to ops do
     begin
-      case operands[i].Opr.Typ of
-        OPR_LOCAL,
-        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
+      operands[i].SetCorrectSize(opcode);
+      if tx86operand(operands[i]).opsize=S_NO then
+        begin
+          case operands[i].Opr.Typ of
+            OPR_LOCAL,
+            OPR_REFERENCE :
+              begin
+                if i=2 then
+                 operand2:=1
+                else
+                 operand2:=2;
+                if operand2<ops then
                  begin
-                   if ((opcode<>A_MOVD) and
-                       (opcode<>A_CVTSI2SS)) then
-                     t386operand(operands[i]).opsize:=t386operand(operands[operand2]).opsize;
+                   { 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
+                         tx86operand(operands[i]).opsize:=tx86operand(operands[operand2]).opsize;
+                     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
+                        tx86operand(operands[i]).opsize:=opsize
+                      else
+                       begin
+                         Message(asmr_e_unable_to_determine_reference_size);
+                         { recovery }
+                         tx86operand(operands[i]).opsize:=S_L;
+                       end;
+                    end;
                  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
-                    t386operand(operands[i]).opsize:=opsize
-                  else
-                   begin
-                     Message(asmr_e_unable_to_determine_reference_size);
-                     { recovery }
-                     t386operand(operands[i]).opsize:=S_L;
-                   end;
-                end;
-             end
-            else
-             begin
-               if opsize<>S_NO then
-                 t386operand(operands[i]).opsize:=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;
-            t386operand(operands[i]).opsize:=S_L;
+                else
+                 begin
+                   if opsize<>S_NO then
+                     tx86operand(operands[i]).opsize:=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;
+{$ifdef x86_64}
+                tx86operand(operands[i]).opsize:=S_Q;
+{$else x86_64}
+                tx86operand(operands[i]).opsize:=S_L;
+{$endif x86_64}
+              end;
           end;
-      end;
+        end;
     end;
-   end;
 end;
 
 
-procedure T386Instruction.SetInstructionOpsize;
+procedure Tx86Instruction.SetInstructionOpsize;
 begin
   if opsize<>S_NO then
    exit;
@@ -335,21 +339,21 @@ begin
            is_segment_reg(operands[1].opr.reg) then
           opsize:=S_L
         else
-          opsize:=t386operand(operands[1]).opsize;
+          opsize:=tx86operand(operands[1]).opsize;
       end;
     2 :
       begin
         case opcode of
           A_MOVZX,A_MOVSX :
             begin
-              case t386operand(operands[1]).opsize of
+              case tx86operand(operands[1]).opsize of
                 S_W :
-                  case t386operand(operands[2]).opsize of
+                  case tx86operand(operands[2]).opsize of
                     S_L :
                       opsize:=S_WL;
                   end;
                 S_B :
-                  case t386operand(operands[2]).opsize of
+                  case tx86operand(operands[2]).opsize of
                     S_W :
                       opsize:=S_BW;
                     S_L :
@@ -361,18 +365,18 @@ begin
                      32 bit register or memory, so no opsize is correct here PM }
             exit;
           A_OUT :
-            opsize:=t386operand(operands[1]).opsize;
+            opsize:=tx86operand(operands[1]).opsize;
           else
-            opsize:=t386operand(operands[2]).opsize;
+            opsize:=tx86operand(operands[2]).opsize;
         end;
       end;
     3 :
-      opsize:=t386operand(operands[3]).opsize;
+      opsize:=tx86operand(operands[3]).opsize;
   end;
 end;
 
 
-procedure T386Instruction.CheckOperandSizes;
+procedure Tx86Instruction.CheckOperandSizes;
 var
   sizeerr : boolean;
   i : longint;
@@ -403,11 +407,11 @@ begin
       begin
         case opsize of
           S_BW :
-            sizeerr:=(t386operand(operands[1]).opsize<>S_B) or (t386operand(operands[2]).opsize<>S_W);
+            sizeerr:=(tx86operand(operands[1]).opsize<>S_B) or (tx86operand(operands[2]).opsize<>S_W);
           S_BL :
-            sizeerr:=(t386operand(operands[1]).opsize<>S_B) or (t386operand(operands[2]).opsize<>S_L);
+            sizeerr:=(tx86operand(operands[1]).opsize<>S_B) or (tx86operand(operands[2]).opsize<>S_L);
           S_WL :
-            sizeerr:=(t386operand(operands[1]).opsize<>S_W) or (t386operand(operands[2]).opsize<>S_L);
+            sizeerr:=(tx86operand(operands[1]).opsize<>S_W) or (tx86operand(operands[2]).opsize<>S_L);
         end;
       end;
    end
@@ -416,8 +420,8 @@ begin
      for i:=1 to ops do
       begin
         if (operands[i].opr.typ<>OPR_CONSTANT) and
-           (t386operand(operands[i]).opsize in [S_B,S_W,S_L]) and
-           (t386operand(operands[i]).opsize<>opsize) then
+           (tx86operand(operands[i]).opsize in [S_B,S_W,S_L]) and
+           (tx86operand(operands[i]).opsize<>opsize) then
          sizeerr:=true;
       end;
    end;
@@ -436,7 +440,7 @@ 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;
+procedure Tx86Instruction.CheckNonCommutativeOpcodes;
 begin
   if (OpOrder=op_intel) then
     SwapOperands;
@@ -487,7 +491,7 @@ end;
                               opcode Adding
 *****************************************************************************}
 
-function T386Instruction.ConcatInstruction(p : taasmoutput) : tai;
+function Tx86Instruction.ConcatInstruction(p : taasmoutput) : tai;
 var
   siz  : topsize;
   i,asize : longint;
@@ -502,21 +506,21 @@ begin
   else
    begin
      if (Ops=2) and (operands[1].opr.typ=OPR_REGISTER) then
-      siz:=t386operand(operands[1]).opsize
+      siz:=tx86operand(operands[1]).opsize
      else
-      siz:=t386operand(operands[Ops]).opsize;
+      siz:=tx86operand(operands[Ops]).opsize;
      { MOVD should be of size S_LQ or S_QL, but these do not exist PM }
      if (ops=2) and
-        (t386operand(operands[1]).opsize<>S_NO) and
-        (t386operand(operands[2]).opsize<>S_NO) and
-        (t386operand(operands[1]).opsize<>t386operand(operands[2]).opsize) then
+        (tx86operand(operands[1]).opsize<>S_NO) and
+        (tx86operand(operands[2]).opsize<>S_NO) and
+        (tx86operand(operands[1]).opsize<>tx86operand(operands[2]).opsize) then
        siz:=S_NO;
    end;
 
    if ((opcode=A_MOVD)or
        (opcode=A_CVTSI2SS)) and
-      ((t386operand(operands[1]).opsize=S_NO) or
-       (t386operand(operands[2]).opsize=S_NO)) then
+      ((tx86operand(operands[1]).opsize=S_NO) or
+       (tx86operand(operands[2]).opsize=S_NO)) then
      siz:=S_NO;
    { NASM does not support FADD without args
      as alias of FADDP
@@ -721,7 +725,9 @@ begin
    begin
      { Check the instruction if it's valid }
 {$ifndef NOAG386BIN}
+{$ifndef x86_64}
      ai.CheckIfValid;
+{$endif x86_64}
 {$endif NOAG386BIN}
      p.concat(ai);
    end
@@ -733,7 +739,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.15  2003-11-17 23:23:47  florian
+  Revision 1.16  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.15  2003/11/17 23:23:47  florian
     + first part of arm assembler reader
 
   Revision 1.14  2003/11/12 16:05:40  florian

compiler/x86/rax86att.pas

@@ -0,0 +1,986 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
+
+    Does the parsing for the x86 GNU AS styled inline assembler.
+
+    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 rax86att;
+
+{$i fpcdefs.inc}
+
+Interface
+
+  uses
+    cpubase,
+    raatt,rax86;
+
+  type
+    tx86attreader = class(tattreader)
+      ActOpsize : topsize;
+      function is_asmopcode(const s: string):boolean;override;
+      procedure handleopcode;override;
+      procedure BuildReference(oper : tx86operand);
+      procedure BuildOperand(oper : tx86operand);
+      procedure BuildOpCode(instr : tx86instruction);
+      procedure handlepercent;override;
+    end;
+
+
+Implementation
+
+    uses
+      { helpers }
+      cutils,
+      { global }
+      globtype,globals,verbose,
+      systems,
+      { aasm }
+      cpuinfo,aasmbase,aasmtai,aasmcpu,
+      { symtable }
+      symconst,symbase,symtype,symsym,symtable,
+      { parser }
+      scanner,
+      procinfo,
+      itcpugas,
+      rabase,rautils,
+      cgbase,cgobj
+      ;
+
+    procedure tx86attreader.handlepercent;
+      var
+        len : longint;
+      begin
+        len:=1;
+        actasmpattern[len]:='%';
+        c:=current_scanner.asmgetchar;
+        { to be a register there must be a letter and not a number }
+        if c in ['0'..'9'] then
+         begin
+           actasmtoken:=AS_MOD;
+         end
+        else
+         begin
+           while c in ['a'..'z','A'..'Z','0'..'9'] do
+            Begin
+              inc(len);
+              actasmpattern[len]:=c;
+              c:=current_scanner.asmgetchar;
+            end;
+           actasmpattern[0]:=chr(len);
+           uppervar(actasmpattern);
+           if (actasmpattern = '%ST') and (c='(') then
+            Begin
+              actasmpattern:=actasmpattern+c;
+              c:=current_scanner.asmgetchar;
+              if c in ['0'..'9'] then
+               actasmpattern:=actasmpattern + c
+              else
+               Message(asmr_e_invalid_fpu_register);
+              c:=current_scanner.asmgetchar;
+              if c <> ')' then
+               Message(asmr_e_invalid_fpu_register)
+              else
+               Begin
+                 actasmpattern:=actasmpattern + c;
+                 c:=current_scanner.asmgetchar; { let us point to next character. }
+               end;
+            end;
+           if is_register(actasmpattern) then
+            exit;
+           Message(asmr_e_invalid_register);
+           actasmtoken:=raatt.AS_NONE;
+         end;
+      end;
+
+
+    Procedure tx86attreader.BuildReference(oper : tx86operand);
+
+      procedure Consume_RParen;
+        begin
+          if actasmtoken <> AS_RPAREN then
+           Begin
+             Message(asmr_e_invalid_reference_syntax);
+             RecoverConsume(true);
+           end
+          else
+           begin
+             Consume(AS_RPAREN);
+             if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
+              Begin
+                Message(asmr_e_invalid_reference_syntax);
+                RecoverConsume(true);
+              end;
+           end;
+        end;
+
+
+      procedure Consume_Scale;
+        var
+          l : longint;
+        begin
+          { we have to process the scaling }
+          l:=BuildConstExpression(false,true);
+          if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) then
+           oper.opr.ref.scalefactor:=l
+          else
+           Begin
+             Message(asmr_e_wrong_scale_factor);
+             oper.opr.ref.scalefactor:=0;
+           end;
+        end;
+
+
+      begin
+        oper.InitRef;
+        Consume(AS_LPAREN);
+        Case actasmtoken of
+          AS_INTNUM,
+          AS_MINUS,
+          AS_PLUS: { absolute offset, such as fs:(0x046c) }
+            Begin
+              { offset(offset) is invalid }
+              If oper.opr.Ref.Offset <> 0 Then
+               Begin
+                 Message(asmr_e_invalid_reference_syntax);
+                 RecoverConsume(true);
+               End
+              Else
+               Begin
+                 oper.opr.Ref.Offset:=BuildConstExpression(false,true);
+                 Consume_RParen;
+               end;
+              exit;
+            End;
+          AS_REGISTER: { (reg ...  }
+            Begin
+              { Check if there is already a base (mostly ebp,esp) than this is
+                not allowed, because it will give crashing code }
+              if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or
+                 ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then
+                message(asmr_e_cannot_index_relative_var);
+              oper.opr.ref.base:=actasmregister;
+              Consume(AS_REGISTER);
+              { can either be a register or a right parenthesis }
+              { (reg)        }
+              if actasmtoken=AS_RPAREN then
+               Begin
+                 Consume_RParen;
+                 exit;
+               end;
+              { (reg,reg ..  }
+              Consume(AS_COMMA);
+              if actasmtoken=AS_REGISTER then
+               Begin
+                 oper.opr.ref.index:=actasmregister;
+                 Consume(AS_REGISTER);
+                 { check for scaling ... }
+                 case actasmtoken of
+                   AS_RPAREN:
+                     Begin
+                       Consume_RParen;
+                       exit;
+                     end;
+                   AS_COMMA:
+                     Begin
+                       Consume(AS_COMMA);
+                       Consume_Scale;
+                       Consume_RParen;
+                     end;
+                 else
+                   Begin
+                     Message(asmr_e_invalid_reference_syntax);
+                     RecoverConsume(false);
+                   end;
+                 end; { end case }
+               end
+              else
+               Begin
+                 Message(asmr_e_invalid_reference_syntax);
+                 RecoverConsume(false);
+               end;
+            end; {end case }
+          AS_COMMA: { (, ...  can either be scaling, or index }
+            Begin
+              Consume(AS_COMMA);
+              { Index }
+              if (actasmtoken=AS_REGISTER) then
+               Begin
+                 oper.opr.ref.index:=actasmregister;
+                 Consume(AS_REGISTER);
+                 { check for scaling ... }
+                 case actasmtoken of
+                   AS_RPAREN:
+                     Begin
+                       Consume_RParen;
+                       exit;
+                     end;
+                   AS_COMMA:
+                     Begin
+                       Consume(AS_COMMA);
+                       Consume_Scale;
+                       Consume_RParen;
+                     end;
+                 else
+                   Begin
+                     Message(asmr_e_invalid_reference_syntax);
+                     RecoverConsume(false);
+                   end;
+                 end; {end case }
+               end
+              { Scaling }
+              else
+               Begin
+                 Consume_Scale;
+                 Consume_RParen;
+                 exit;
+               end;
+            end;
+        else
+          Begin
+            Message(asmr_e_invalid_reference_syntax);
+            RecoverConsume(false);
+          end;
+        end;
+      end;
+
+
+    Procedure tx86attreader.BuildOperand(oper : tx86operand);
+      var
+        tempstr,
+        expr : string;
+        typesize,
+        l,k : longint;
+
+
+        procedure AddLabelOperand(hl:tasmlabel);
+          begin
+            if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and
+               is_calljmp(actopcode) then
+             begin
+               oper.opr.typ:=OPR_SYMBOL;
+               oper.opr.symbol:=hl;
+             end
+            else
+             begin
+               oper.InitRef;
+               oper.opr.ref.symbol:=hl;
+             end;
+          end;
+
+
+        procedure MaybeRecordOffset;
+          var
+            hasdot  : boolean;
+            l,
+            toffset,
+            tsize   : longint;
+          begin
+            if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
+             exit;
+            l:=0;
+            hasdot:=(actasmtoken=AS_DOT);
+            if hasdot then
+             begin
+               if expr<>'' then
+                 begin
+                   BuildRecordOffsetSize(expr,toffset,tsize);
+                   inc(l,toffset);
+                   oper.SetSize(tsize,true);
+                 end;
+             end;
+            if actasmtoken in [AS_PLUS,AS_MINUS] then
+             inc(l,BuildConstExpression(true,false));
+            case oper.opr.typ of
+              OPR_LOCAL :
+                begin
+                  { don't allow direct access to fields of parameters, because that
+                    will generate buggy code. Allow it only for explicit typecasting }
+                  if hasdot and
+                     (not oper.hastype) and
+                     (tvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
+                     (current_procinfo.procdef.proccalloption<>pocall_register) then
+                    Message(asmr_e_cannot_access_field_directly_for_parameters);
+                  inc(oper.opr.localsymofs,l)
+                end;
+              OPR_CONSTANT :
+                inc(oper.opr.val,l);
+              OPR_REFERENCE :
+                inc(oper.opr.ref.offset,l);
+              else
+                internalerror(200309221);
+            end;
+          end;
+
+
+        function MaybeBuildReference:boolean;
+          { Try to create a reference, if not a reference is found then false
+            is returned }
+          begin
+            MaybeBuildReference:=true;
+            case actasmtoken of
+              AS_INTNUM,
+              AS_MINUS,
+              AS_PLUS:
+                Begin
+                  oper.opr.ref.offset:=BuildConstExpression(True,False);
+                  if actasmtoken<>AS_LPAREN then
+                    Message(asmr_e_invalid_reference_syntax)
+                  else
+                    BuildReference(oper);
+                end;
+              AS_LPAREN:
+                BuildReference(oper);
+              AS_ID: { only a variable is allowed ... }
+                Begin
+                  tempstr:=actasmpattern;
+                  Consume(AS_ID);
+                  { typecasting? }
+                  if (actasmtoken=AS_LPAREN) and
+                     SearchType(tempstr,typesize) then
+                   begin
+                     oper.hastype:=true;
+                     Consume(AS_LPAREN);
+                     BuildOperand(oper);
+                     Consume(AS_RPAREN);
+                     if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
+                       oper.SetSize(typesize,true);
+                   end
+                  else
+                   if not oper.SetupVar(tempstr,false) then
+                    Message1(sym_e_unknown_id,tempstr);
+                  { record.field ? }
+                  if actasmtoken=AS_DOT then
+                   begin
+                     BuildRecordOffsetSize(tempstr,l,k);
+                     inc(oper.opr.ref.offset,l);
+                   end;
+                  case actasmtoken of
+                    AS_END,
+                    AS_SEPARATOR,
+                    AS_COMMA: ;
+                    AS_LPAREN:
+                      BuildReference(oper);
+                  else
+                    Begin
+                      Message(asmr_e_invalid_reference_syntax);
+                      Consume(actasmtoken);
+                    end;
+                  end; {end case }
+                end;
+              else
+               MaybeBuildReference:=false;
+            end; { end case }
+          end;
+
+
+      const
+        regsize_2_size: array[S_B..S_L] of longint = (1,2,4);
+      var
+        tempreg : tregister;
+        hl      : tasmlabel;
+      Begin
+        expr:='';
+        case actasmtoken of
+          AS_LPAREN: { Memory reference or constant expression }
+            Begin
+              oper.InitRef;
+              BuildReference(oper);
+            end;
+
+          AS_DOLLAR: { Constant expression  }
+            Begin
+              Consume(AS_DOLLAR);
+              BuildConstantOperand(oper);
+            end;
+
+          AS_INTNUM,
+          AS_MINUS,
+          AS_PLUS:
+            Begin
+              { Constant memory offset }
+              { This must absolutely be followed by (  }
+              oper.InitRef;
+              oper.opr.ref.offset:=BuildConstExpression(True,False);
+              if actasmtoken<>AS_LPAREN then
+                Message(asmr_e_invalid_reference_syntax)
+              else
+                BuildReference(oper);
+            end;
+
+          AS_STAR: { Call from memory address }
+            Begin
+              Consume(AS_STAR);
+              if actasmtoken=AS_REGISTER then
+               begin
+                 oper.opr.typ:=OPR_REGISTER;
+                 oper.opr.reg:=actasmregister;
+                 oper.SetSize(regsize_2_size[reg2opsize(actasmregister)],true);
+                 Consume(AS_REGISTER);
+               end
+              else
+               begin
+                 oper.InitRef;
+                 if not MaybeBuildReference then
+                  Message(asmr_e_syn_operand);
+               end;
+              { this is only allowed for call's and jmp's }
+              if not is_calljmp(actopcode) then
+               Message(asmr_e_syn_operand);
+            end;
+
+          AS_ID: { A constant expression, or a Variable ref.  }
+            Begin
+              { Local Label ? }
+              if is_locallabel(actasmpattern) then
+               begin
+                 CreateLocalLabel(actasmpattern,hl,false);
+                 Consume(AS_ID);
+                 AddLabelOperand(hl);
+               end
+              else
+               { Check for label }
+               if SearchLabel(actasmpattern,hl,false) then
+                begin
+                  Consume(AS_ID);
+                  AddLabelOperand(hl);
+                end
+              else
+               { probably a variable or normal expression }
+               { or a procedure (such as in CALL ID)      }
+               Begin
+                 { is it a constant ? }
+                 if SearchIConstant(actasmpattern,l) then
+                  Begin
+                    if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
+                     Message(asmr_e_invalid_operand_type);
+                    BuildConstantOperand(oper);
+                  end
+                 else
+                  begin
+                    expr:=actasmpattern;
+                    Consume(AS_ID);
+                    { typecasting? }
+                    if (actasmtoken=AS_LPAREN) and
+                       SearchType(expr,typesize) then
+                     begin
+                       oper.hastype:=true;
+                       Consume(AS_LPAREN);
+                       BuildOperand(oper);
+                       Consume(AS_RPAREN);
+                       if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
+                         oper.SetSize(typesize,true);
+                     end
+                    else
+                     begin
+                       if oper.SetupVar(expr,false) then
+                        begin
+                        end
+                       else
+                        Begin
+                          { look for special symbols ... }
+                          if expr= '__HIGH' then
+                            begin
+                              consume(AS_LPAREN);
+                              if not oper.setupvar('high'+actasmpattern,false) then
+                                Message1(sym_e_unknown_id,'high'+actasmpattern);
+                              consume(AS_ID);
+                              consume(AS_RPAREN);
+                            end
+                          else
+                           if expr = '__RESULT' then
+                            oper.SetUpResult
+                          else
+                           if expr = '__SELF' then
+                            oper.SetupSelf
+                          else
+                           if expr = '__OLDEBP' then
+                            oper.SetupOldEBP
+                          else
+                            { check for direct symbolic names   }
+                            { only if compiling the system unit }
+                            if (cs_compilesystem in aktmoduleswitches) then
+                             begin
+                               if not oper.SetupDirectVar(expr) then
+                                Begin
+                                  { not found, finally ... add it anyways ... }
+                                  Message1(asmr_w_id_supposed_external,expr);
+                                  oper.InitRef;
+                                  oper.opr.ref.symbol:=objectlibrary.newasmsymbol(expr);
+                                end;
+                             end
+                          else
+                            Message1(sym_e_unknown_id,expr);
+                        end;
+                     end;
+                  end;
+                  if actasmtoken=AS_DOT then
+                    MaybeRecordOffset;
+                  { add a constant expression? }
+                  if (actasmtoken=AS_PLUS) then
+                   begin
+                     l:=BuildConstExpression(true,false);
+                     case oper.opr.typ of
+                       OPR_CONSTANT :
+                         inc(oper.opr.val,l);
+                       OPR_LOCAL :
+                         inc(oper.opr.localsymofs,l);
+                       OPR_REFERENCE :
+                         inc(oper.opr.ref.offset,l);
+                       else
+                         internalerror(200309202);
+                     end;
+                   end
+               end;
+              { Do we have a indexing reference, then parse it also }
+              if actasmtoken=AS_LPAREN then
+                BuildReference(oper);
+            end;
+
+          AS_REGISTER: { Register, a variable reference or a constant reference  }
+            Begin
+              { save the type of register used. }
+              tempreg:=actasmregister;
+              Consume(AS_REGISTER);
+              if actasmtoken = AS_COLON then
+               Begin
+                 Consume(AS_COLON);
+                 oper.InitRef;
+                 oper.opr.ref.segment:=tempreg;
+                 { This must absolutely be followed by a reference }
+                 if not MaybeBuildReference then
+                  Begin
+                    Message(asmr_e_invalid_seg_override);
+                    Consume(actasmtoken);
+                  end;
+               end
+              { Simple register  }
+              else if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
+                Begin
+                  if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
+                    Message(asmr_e_invalid_operand_type);
+                  oper.opr.typ:=OPR_REGISTER;
+                  oper.opr.reg:=tempreg;
+                  oper.SetSize(tcgsize2size[cg.reg_cgsize(oper.opr.reg)],true);
+                end
+              else
+                Message(asmr_e_syn_operand);
+            end;
+          AS_END,
+          AS_SEPARATOR,
+          AS_COMMA: ;
+        else
+          Begin
+            Message(asmr_e_syn_operand);
+            Consume(actasmtoken);
+          end;
+        end; { end case }
+      end;
+
+
+    procedure tx86attreader.BuildOpCode(instr : tx86instruction);
+      var
+        operandnum : longint;
+        PrefixOp,OverrideOp: tasmop;
+      Begin
+        PrefixOp:=A_None;
+        OverrideOp:=A_None;
+        { prefix seg opcode / prefix opcode }
+        repeat
+          if is_prefix(actopcode) then
+            begin
+              PrefixOp:=ActOpcode;
+              with instr do
+                begin
+                  opcode:=ActOpcode;
+                  condition:=ActCondition;
+                  opsize:=ActOpsize;
+                  ConcatInstruction(curlist);
+                end;
+              Consume(AS_OPCODE);
+            end
+          else
+            if is_override(actopcode) then
+              begin
+                OverrideOp:=ActOpcode;
+                with instr do
+                  begin
+                    opcode:=ActOpcode;
+                    condition:=ActCondition;
+                    opsize:=ActOpsize;
+                    ConcatInstruction(curlist);
+                  end;
+                Consume(AS_OPCODE);
+              end
+            else
+              break;
+          { allow for newline as in gas styled syntax }
+          while actasmtoken=AS_SEPARATOR do
+            Consume(AS_SEPARATOR);
+        until (actasmtoken<>AS_OPCODE);
+        { opcode }
+        if (actasmtoken<>AS_OPCODE) then
+         Begin
+           Message(asmr_e_invalid_or_missing_opcode);
+           RecoverConsume(true);
+           exit;
+         end;
+        { Fill the instr object with the current state }
+        with instr do
+          begin
+            Opcode:=ActOpcode;
+            condition:=ActCondition;
+            opsize:=ActOpsize;
+          end;
+
+        { Valid combination of prefix/override and instruction ?  }
+
+        if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then
+           Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern);
+
+        if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then
+          Message1(asmr_e_invalid_override_and_opcode,actasmpattern);
+        { We are reading operands, so opcode will be an AS_ID }
+        operandnum:=1;
+        Consume(AS_OPCODE);
+        { Zero operand opcode ?  }
+        if actasmtoken in [AS_SEPARATOR,AS_END] then
+         begin
+           operandnum:=0;
+           exit;
+         end;
+        { Read the operands }
+        repeat
+          case actasmtoken of
+            AS_COMMA: { Operand delimiter }
+              Begin
+                if operandnum > Max_Operands then
+                  Message(asmr_e_too_many_operands)
+                else
+                  Inc(operandnum);
+                Consume(AS_COMMA);
+              end;
+            AS_SEPARATOR,
+            AS_END : { End of asm operands for this opcode  }
+              begin
+                break;
+              end;
+          else
+            BuildOperand(instr.Operands[operandnum] as tx86operand);
+          end; { end case }
+        until false;
+        instr.Ops:=operandnum;
+      end;
+
+
+    function tx86attreader.is_asmopcode(const s: string):boolean;
+      const
+        { We need first to check the long prefixes, else we get probs
+          with things like movsbl }
+        att_sizesuffixstr : array[0..9] of string[2] = (
+          '','BW','BL','WL','B','W','L','S','Q','T'
+        );
+        att_sizesuffix : array[0..9] of topsize = (
+          S_NO,S_BW,S_BL,S_WL,S_B,S_W,S_L,S_FS,S_IQ,S_FX
+        );
+        att_sizefpusuffix : array[0..9] of topsize = (
+          S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_FL,S_FS,S_IQ,S_FX
+        );
+        att_sizefpuintsuffix : array[0..9] of topsize = (
+          S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_IL,S_IS,S_IQ,S_NO
+        );
+      var
+        str2opentry: tstr2opentry;
+        cond : string[4];
+        cnd  : tasmcond;
+        len,
+        j,
+        sufidx : longint;
+      Begin
+        is_asmopcode:=FALSE;
+
+        actopcode:=A_None;
+        actcondition:=C_None;
+        actopsize:=S_NO;
+
+        { search for all possible suffixes }
+        for sufidx:=low(att_sizesuffixstr) to high(att_sizesuffixstr) do
+         begin
+           len:=length(s)-length(att_sizesuffixstr[sufidx]);
+           if copy(s,len+1,length(att_sizesuffixstr[sufidx]))=att_sizesuffixstr[sufidx] then
+            begin
+              { here we search the entire table... }
+              str2opentry:=nil;
+              if {(length(s)>0) and} (len>0) then
+                str2opentry:=tstr2opentry(iasmops.search(copy(s,1,len)));
+              if assigned(str2opentry) then
+                begin
+                  actopcode:=str2opentry.op;
+                  if gas_needsuffix[actopcode]=attsufFPU then
+                   actopsize:=att_sizefpusuffix[sufidx]
+                  else if gas_needsuffix[actopcode]=attsufFPUint then
+                   actopsize:=att_sizefpuintsuffix[sufidx]
+                  else
+                   actopsize:=att_sizesuffix[sufidx];
+                  actasmtoken:=AS_OPCODE;
+                  is_asmopcode:=TRUE;
+                  exit;
+                end;
+              { not found, check condition opcodes }
+              j:=0;
+              while (j<CondAsmOps) do
+               begin
+                 if Copy(s,1,Length(CondAsmOpStr[j]))=CondAsmOpStr[j] then
+                  begin
+                    cond:=Copy(s,Length(CondAsmOpStr[j])+1,len-Length(CondAsmOpStr[j]));
+                    if cond<>'' then
+                     begin
+                       for cnd:=low(TasmCond) to high(TasmCond) do
+                        if Cond=Upper(cond2str[cnd]) then
+                         begin
+                           actopcode:=CondASmOp[j];
+                           if gas_needsuffix[actopcode]=attsufFPU then
+                            actopsize:=att_sizefpusuffix[sufidx]
+                           else if gas_needsuffix[actopcode]=attsufFPUint then
+                            actopsize:=att_sizefpuintsuffix[sufidx]
+                           else
+                            actopsize:=att_sizesuffix[sufidx];
+                           actcondition:=cnd;
+                           actasmtoken:=AS_OPCODE;
+                           is_asmopcode:=TRUE;
+                           exit;
+                         end;
+                     end;
+                  end;
+                 inc(j);
+               end;
+           end;
+         end;
+      end;
+
+
+    procedure tx86attreader.handleopcode;
+      var
+        instr : Tx86Instruction;
+      begin
+        instr:=Tx86Instruction.Create(Tx86Operand);
+        instr.OpOrder:=op_att;
+        BuildOpcode(instr);
+        instr.AddReferenceSizes;
+        instr.SetInstructionOpsize;
+        instr.CheckOperandSizes;
+        instr.ConcatInstruction(curlist);
+        instr.Free;
+      end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.58  2003/11/12 16:05:39  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.57  2003/11/10 19:08:32  peter
+    * line numbering is now only done when #10, #10#13 is really parsed
+      instead of when it is the next character
+
+  Revision 1.56  2003/10/29 16:47:18  peter
+    * fix field offset in reference
+
+  Revision 1.55  2003/10/26 13:37:22  florian
+    * fixed web bug 2128
+
+  Revision 1.54  2003/10/24 17:39:03  peter
+    * more intel parser updates
+
+  Revision 1.53  2003/10/23 17:19:44  peter
+    * typecasting fixes
+    * reference building more delphi compatible
+
+  Revision 1.52  2003/10/20 19:29:35  peter
+    * fix check for register subscription of reference parameter
+
+  Revision 1.51  2003/10/16 21:29:24  peter
+    + __HIGH() to retrieve high value
+
+  Revision 1.50  2003/10/07 18:21:18  peter
+    * fix crash
+    * allow parameter subscription for register parameters
+
+  Revision 1.49  2003/10/01 20:34:49  peter
+    * procinfo unit contains tprocinfo
+    * cginfo renamed to cgbase
+    * moved cgmessage to verbose
+    * fixed ppc and sparc compiles
+
+  Revision 1.48  2003/09/23 20:37:53  peter
+    * fix global var+offset
+
+  Revision 1.47  2003/09/23 17:56:06  peter
+    * locals and paras are allocated in the code generation
+    * tvarsym.localloc contains the location of para/local when
+      generating code for the current procedure
+
+  Revision 1.46  2003/09/03 15:55:01  peter
+    * NEWRA branch merged
+
+  Revision 1.45.2.2  2003/08/31 15:46:26  peter
+    * more updates for tregister
+
+  Revision 1.45.2.1  2003/08/28 18:35:08  peter
+    * tregister changed to cardinal
+
+  Revision 1.45  2003/05/30 23:57:08  peter
+    * more sparc cleanup
+    * accumulator removed, splitted in function_return_reg (called) and
+      function_result_reg (caller)
+
+  Revision 1.44  2003/05/22 21:32:29  peter
+    * removed some unit dependencies
+
+  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
+    * removed some ie checks
+
+  Revision 1.40  2003/03/18 18:15:53  peter
+    * changed reg2opsize to function
+
+  Revision 1.39  2003/02/20 15:52:58  pierre
+   * fix a range check error
+
+  Revision 1.38  2003/02/19 22:00:16  daniel
+    * Code generator converted to new register notation
+    - Horribily outdated todo.txt removed
+
+  Revision 1.37  2003/02/03 22:47:14  daniel
+    - Removed reg_2_opsize array
+
+  Revision 1.36  2003/01/08 18:43:57  daniel
+   * Tregister changed into a record
+
+  Revision 1.35  2002/12/14 15:02:03  carl
+    * maxoperands -> max_operands (for portability in rautils.pas)
+    * fix some range-check errors with loadconst
+    + add ncgadd unit to m68k
+    * some bugfix of a_param_reg with LOC_CREFERENCE
+
+  Revision 1.34  2002/12/01 22:08:34  carl
+    * some small cleanup (remove some specific operators which are not supported)
+
+  Revision 1.33  2002/11/30 23:16:39  carl
+    - removed unused message
+
+  Revision 1.32  2002/11/15 01:58:58  peter
+    * merged changes from 1.0.7 up to 04-11
+      - -V option for generating bug report tracing
+      - more tracing for option parsing
+      - errors for cdecl and high()
+      - win32 import stabs
+      - win32 records<=8 are returned in eax:edx (turned off by default)
+      - heaptrc update
+      - more info for temp management in .s file with EXTDEBUG
+
+  Revision 1.31  2002/09/03 16:26:28  daniel
+    * Make Tprocdef.defs protected
+
+  Revision 1.30  2002/08/13 18:01:52  carl
+    * rename swatoperands to swapoperands
+    + m68k first compilable version (still needs a lot of testing):
+        assembler generator, system information , inline
+        assembler reader.
+
+  Revision 1.29  2002/08/12 15:08:42  carl
+    + stab register indexes for powerpc (moved from gdb to cpubase)
+    + tprocessor enumeration moved to cpuinfo
+    + linker in target_info is now a class
+    * many many updates for m68k (will soon start to compile)
+    - removed some ifdef or correct them for correct cpu
+
+  Revision 1.28  2002/08/11 14:32:31  peter
+    * renamed current_library to objectlibrary
+
+  Revision 1.27  2002/08/11 13:24:17  peter
+    * saving of asmsymbols in ppu supported
+    * asmsymbollist global is removed and moved into a new class
+      tasmlibrarydata that will hold the info of a .a file which
+      corresponds with a single module. Added librarydata to tmodule
+      to keep the library info stored for the module. In the future the
+      objectfiles will also be stored to the tasmlibrarydata class
+    * all getlabel/newasmsymbol and friends are moved to the new class
+
+  Revision 1.26  2002/07/26 21:15:44  florian
+    * rewrote the system handling
+
+  Revision 1.25  2002/07/01 18:46:34  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.24  2002/05/18 13:34:25  peter
+    * readded missing revisions
+
+  Revision 1.23  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.21  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.20  2002/04/14 17:01:52  carl
+  + att_reg2str -> gas_reg2str
+
+  Revision 1.19  2002/04/04 19:06:13  peter
+    * removed unused units
+    * use tlocation.size in cg.a_*loc*() routines
+
+  Revision 1.18  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.17  2002/03/28 20:48:25  carl
+  - remove go32v1 support
+
+  Revision 1.16  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
+
+}

compiler/x86_64/cgcpu.pas

@@ -32,10 +32,11 @@ unit cgcpu;
        cgbase,cgobj,cg64f64,cgx86,
        aasmbase,aasmtai,aasmcpu,
        cpubase,cpuinfo,cpupara,
-       node,symconst;
+       node,symconst,rgx86;
 
     type
       tcgx86_64 = class(tcgx86)
+        procedure init_register_allocators;override;
         class function reg_cgsize(const reg: tregister): tcgsize; override;
         procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
       end;
@@ -48,6 +49,19 @@ unit cgcpu;
        rgobj,tgobj,rgcpu;
 
 
+    procedure Tcgx86_64.init_register_allocators;
+      begin
+        inherited init_register_allocators;
+        if cs_create_pic in aktmoduleswitches then
+          rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP,RS_EBX])
+        else
+          rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]);
+        rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_sse_imreg,[]);
+        rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_sse_imreg,[]);
+        rgfpu:=Trgx86fpu.create;
+      end;
+
+
     class function tcgx86_64.reg_cgsize(const reg: tregister): tcgsize;
     const subreg2cgsize:array[Tsubregister] of Tcgsize =
           (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO);
@@ -206,7 +220,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  2004-01-13 18:08:58  florian
+  Revision 1.9  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.8  2004/01/13 18:08:58  florian
     * x86-64 compilation fixed
 
   Revision 1.7  2003/12/24 01:47:23  florian

compiler/x86_64/cpubase.inc

@@ -123,7 +123,7 @@ const
         This value can be deduced from the CALLED_USED_REGISTERS array in the
         GCC source.
       }
-      std_saved_registers = [RS_ESI,RS_EDI,RS_EBX];
+      saved_standard_registers : array[0..4] of tsuperregister = (RS_EBX,RS_R12,RS_R13,RS_R14,RS_R15);
       { Required parameter alignment when calling a routine declared as
         stdcall and cdecl. The alignment value should be the one defined
         by GCC or the target ABI.
@@ -135,7 +135,11 @@ const
 
 {
   $Log$
-  Revision 1.9  2003-12-22 19:00:17  florian
+  Revision 1.10  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.9  2003/12/22 19:00:17  florian
     * fixed some x86-64 issues
 
   Revision 1.8  2003/09/25 13:13:32  florian

compiler/x86_64/cpupara.pas

@@ -49,11 +49,12 @@ unit cpupara;
 
     uses
        verbose,
-       cpuinfo,cgbase,
+       cpuinfo,cgbase,systems,
        defutil;
 
     const
-      intreg_nr2reg : array[1..6] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9);
+      paraintsupregs : array[0..5] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9);
+      parammsupregs : array[0..7] of tsuperregister = (RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7);
 
     function getparaloc(p : tdef) : tcgloc;
 
@@ -120,15 +121,17 @@ unit cpupara;
          end;
       end;
 
+
     function tx86_64paramanager.getintparaloc(calloption : tproccalloption; nr : longint): tparalocation;
       begin
          fillchar(result,sizeof(tparalocation),0);
+         result.size:=OS_INT;
          if nr<1 then
            internalerror(200304303)
-         else if nr<=6 then
+         else if nr<=high(paraintsupregs)+1 then
            begin
               result.loc:=LOC_REGISTER;
-              result.register:=newreg(R_INTREGISTER,intreg_nr2reg[nr],R_SUBWHOLE);
+              result.register:=newreg(R_INTREGISTER,paraintsupregs[nr-1],R_SUBWHOLE);
            end
          else
            begin
@@ -140,11 +143,82 @@ unit cpupara;
 
 
     function tx86_64paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+      var
+        hp : tparaitem;
+        paraloc : tparalocation;
+        subreg : tsubregister;
+        pushaddr : boolean;
+        l,intparareg,mmparareg,
+        varalign,
+        paraalign,
+        parasize : longint;
       begin
-         { set default para_alignment to target_info.stackalignment }
-         { if para_alignment=0 then
-           para_alignment:=aktalignment.paraalign;
-         }
+        intparareg:=0;
+        mmparareg:=0;
+        parasize:=0;
+        paraalign:=get_para_align(p.proccalloption);
+        { Register parameters are assigned from left to right }
+        hp:=tparaitem(p.para.first);
+        while assigned(hp) do
+          begin
+            pushaddr:=push_addr_param(hp.paratyp,hp.paratype.def,p.proccalloption);
+            if pushaddr then
+              paraloc.size:=OS_ADDR
+            else
+              paraloc.size:=def_cgsize(hp.paratype.def);
+            paraloc.alignment:=paraalign;
+            if (intparareg<=high(paraintsupregs)) and
+               not(
+                   ((hp.paratype.def.deftype in [floatdef,recorddef,arraydef]) and
+                    (not pushaddr))
+                  ) then
+              begin
+                paraloc.loc:=LOC_REGISTER;
+                if paraloc.size=OS_NO then
+                  subreg:=R_SUBWHOLE
+                else
+                  subreg:=cgsize2subreg(paraloc.size);
+                paraloc.alignment:=paraalign;
+                paraloc.register:=newreg(R_INTREGISTER,paraintsupregs[intparareg],subreg);
+                inc(intparareg);
+              end
+            else if (mmparareg<=high(parammsupregs)) then
+              begin
+              end
+            else
+              begin
+                paraloc.loc:=LOC_REFERENCE;
+                if side=callerside then
+                  paraloc.reference.index:=NR_STACK_POINTER_REG
+                else
+                  paraloc.reference.index:=NR_FRAME_POINTER_REG;
+                l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                // varalign:=size_2_align(l);
+                paraloc.reference.offset:=parasize;
+                // varalign:=used_align(varalign,paraalign,paraalign);
+                // parasize:=align(parasize+l,varalign);
+              end;
+            hp.paraloc[side]:=paraloc;
+            hp:=tparaitem(hp.next);
+          end;
+        { Register parameters are assigned from left-to-right, adapt offset
+          for calleeside to be reversed }
+        hp:=tparaitem(p.para.first);
+        while assigned(hp) do
+          begin
+            if (hp.paraloc[side].loc=LOC_REFERENCE) then
+              begin
+                l:=push_size(hp.paratyp,hp.paratype.def,p.proccalloption);
+                // varalign:=used_align(size_2_align(l),paraalign,paraalign);
+                // l:=align(l,varalign);
+                hp.paraloc[side].reference.offset:=parasize-hp.paraloc[side].reference.offset-l;
+                if side=calleeside then
+                  inc(hp.paraloc[side].reference.offset,target_info.first_parm_offset);
+              end;
+            hp:=tparaitem(hp.next);
+          end;
+        { We need to return the size allocated }
+        result:=parasize;
       end;
 
 
@@ -153,7 +227,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2003-12-24 00:10:03  florian
+  Revision 1.6  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+
+  Revision 1.5  2003/12/24 00:10:03  florian
     - delete parameter in cg64 methods removed
 
   Revision 1.4  2003/04/30 20:53:32  florian

compiler/x86_64/rax64att.pas

@@ -0,0 +1,76 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
+
+    Does the parsing for the i386 GNU AS styled inline assembler.
+
+    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 rax64att;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      rax86att;
+
+    type
+      tx8664attreader = class(tx86attreader)
+        procedure handleopcode;override;
+      end;
+
+
+  implementation
+
+    uses
+      rabase,systems,rax86,aasmcpu;
+
+    procedure tx8664attreader.handleopcode;
+      var
+        instr : Tx86Instruction;
+      begin
+        instr:=Tx86Instruction.Create(Tx86Operand);
+        instr.OpOrder:=op_att;
+        BuildOpcode(instr);
+        instr.AddReferenceSizes;
+        instr.SetInstructionOpsize;
+        {
+        instr.CheckOperandSizes;
+        }
+        instr.ConcatInstruction(curlist);
+        instr.Free;
+      end;
+
+
+const
+  asmmode_x86_64_gas_info : tasmmodeinfo =
+          (
+            id    : asmmode_x86_64_gas;
+            idtxt : 'GAS';
+            casmreader : tx8664attreader;
+          );
+
+initialization
+  RegisterAsmMode(asmmode_x86_64_gas_info);
+end.
+{
+  $Log$
+  Revision 1.1  2004-01-14 23:39:05  florian
+    * another bunch of x86-64 fixes mainly calling convention and
+      assembler reader related
+}