+ first part of arm assembler reader

compiler/arm/agarmgas.pas

@@ -51,7 +51,7 @@ unit agarmgas;
        systems,
        assemble,
        aasmcpu,
-       itarmgas,
+       itcpugas,
        cgbase;
 
     const
@@ -226,7 +226,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2003-11-07 15:58:32  florian
+  Revision 1.14  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+
+  Revision 1.13  2003/11/07 15:58:32  florian
     * Florian's culmutative nr. 1; contains:
       - invalid calling conventions for a certain cpu are rejected
       - arm softfloat calling conventions

compiler/arm/cpubase.pas

@@ -141,7 +141,7 @@ unit cpubase;
           or floating point single }
         PF_S,
         { floating point size }
-        PF_D,PF_E,PF_P,FP_EP,
+        PF_D,PF_E,PF_P,PF_EP,
         { load/store }
         PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T,
         { multiple load/store address modes }
@@ -564,7 +564,10 @@ unit cpubase;
 end.
 {
   $Log$
-  Revision 1.17  2003-11-02 14:30:03  florian
+  Revision 1.18  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+
+  Revision 1.17  2003/11/02 14:30:03  florian
     * fixed ARM for new reg. allocation scheme
 
   Revision 1.16  2003/10/31 08:40:51  mazen

compiler/arm/cpuinfo.pas

@@ -38,6 +38,7 @@ Type
    ts32real = single;
    ts64real = double;
    ts80real = extended;
+   ts128real = extended;
    ts64comp = comp;
 
    pbestreal=^bestreal;
@@ -111,7 +112,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.3  2003-11-07 15:58:32  florian
+  Revision 1.4  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+
+  Revision 1.3  2003/11/07 15:58:32  florian
     * Florian's culmutative nr. 1; contains:
       - invalid calling conventions for a certain cpu are rejected
       - arm softfloat calling conventions

compiler/arm/itcpugas.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-unit itarmgas;
+unit itcpugas;
 
 {$i fpcdefs.inc}
 
@@ -113,7 +113,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2003-11-12 16:05:39  florian
+  Revision 1.2  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+
+  Revision 1.1  2003/11/12 16:05:39  florian
     * assembler readers OOPed
     + typed currency constants
     + typed 128 bit float constants if the CPU supports it

compiler/arm/raarm.pas

@@ -0,0 +1,60 @@
+{
+    $Id$
+    Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman
+
+    Handles the common arm assembler reader routines
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit raarm;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      cpubase,
+      aasmtai,
+      rautils;
+
+    type
+      TARMOperand=class(TOperand)
+      end;
+
+      TARMInstruction=class(TInstruction)
+        oppostfix : toppostfix;
+        function ConcatInstruction(p:TAAsmoutput) : tai;override;
+      end;
+
+  implementation
+
+    uses
+      aasmcpu;
+
+    function TARMInstruction.ConcatInstruction(p:TAAsmoutput) : tai;
+      begin
+        result:=inherited ConcatInstruction(p);
+        (result as taicpu).oppostfix:=oppostfix;
+      end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+}

compiler/arm/raarmgas.pas

@@ -0,0 +1,755 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
+
+    Does the parsing for the ARM 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 raarmgas;
+
+{$i fpcdefs.inc}
+
+  Interface
+
+    uses
+      raatt,raarm,
+      cpubase;
+
+    type
+      tarmattreader = class(tattreader)
+        actoppostfix : TOpPostfix;
+        function is_asmopcode(const s: string):boolean;override;
+        function is_register(const s:string):boolean;override;
+        procedure handleopcode;override;
+        procedure BuildReference(oper : tarmoperand);
+        procedure BuildOperand(oper : tarmoperand);
+        procedure BuildOpCode(instr : tarminstruction);
+        procedure ReadSym(oper : tarmoperand);
+        procedure ConvertCalljmp(instr : tarminstruction);
+      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
+      ;
+
+
+    function tarmattreader.is_register(const s:string):boolean;
+      type
+        treg2str = record
+          name : string[2];
+          reg : tregister;
+        end;
+
+      const
+        extraregs : array[0..19] of treg2str = (
+          (name: 'A1'; reg : NR_R0),
+          (name: 'A2'; reg : NR_R1),
+          (name: 'A3'; reg : NR_R2),
+          (name: 'A4'; reg : NR_R3),
+          (name: 'V1'; reg : NR_R4),
+          (name: 'V2'; reg : NR_R5),
+          (name: 'V3'; reg : NR_R6),
+          (name: 'V4'; reg : NR_R7),
+          (name: 'V5'; reg : NR_R8),
+          (name: 'V6'; reg : NR_R9),
+          (name: 'V7'; reg : NR_R10),
+          (name: 'V8'; reg : NR_R11),
+          (name: 'WR'; reg : NR_R7),
+          (name: 'SB'; reg : NR_R9),
+          (name: 'SL'; reg : NR_R10),
+          (name: 'FP'; reg : NR_R11),
+          (name: 'IP'; reg : NR_R12),
+          (name: 'SP'; reg : NR_R13),
+          (name: 'LR'; reg : NR_R14),
+          (name: 'PC'; reg : NR_R15));
+
+      var
+        i : longint;
+
+      begin
+        result:=inherited is_register(s);
+        { reg found?
+          possible aliases are always 2 char
+        }
+        if result or (length(s)<>2) then
+          exit;
+        for i:=low(extraregs) to high(extraregs) do
+          begin
+            if s=extraregs[i].name then
+              begin
+                actasmregister:=extraregs[i].reg;
+                result:=true;
+                actasmtoken:=AS_REGISTER;
+                exit;
+              end;
+          end;
+      end;
+
+
+    procedure tarmattreader.ReadSym(oper : tarmoperand);
+      var
+         tempstr : string;
+         typesize,l,k : longint;
+      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;
+      end;
+
+
+    Procedure tarmattreader.BuildReference(oper : tarmoperand);
+
+      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;
+
+      var
+        l : longint;
+
+      begin
+        Consume(AS_LPAREN);
+        Case actasmtoken of
+          AS_HASH: { Constant expression  }
+            Begin
+              Consume(AS_HASH);
+              BuildConstantOperand(oper);
+            end;
+
+          AS_DOLLAR: { Constant expression  }
+            Begin
+              Consume(AS_DOLLAR);
+              BuildConstantOperand(oper);
+            end;
+
+          AS_INTNUM,
+          AS_MINUS,
+          AS_PLUS:
+            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
+              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);
+                 Consume_RParen;
+               end
+              else
+               Begin
+                 Message(asmr_e_invalid_reference_syntax);
+                 RecoverConsume(false);
+               end;
+            end; {end case }
+          AS_ID:
+            Begin
+              ReadSym(oper);
+              { add a constant expression? }
+              if (actasmtoken=AS_PLUS) then
+               begin
+                 l:=BuildConstExpression(true,true);
+                 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;
+              Consume(AS_RPAREN);
+            End;
+          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 ... }
+                  Consume_RParen;
+                end
+              else
+                begin
+                  Message(asmr_e_invalid_reference_syntax);
+                  RecoverConsume(false);
+                end;
+            end;
+        else
+          Begin
+            Message(asmr_e_invalid_reference_syntax);
+            RecoverConsume(false);
+          end;
+        end;
+      end;
+
+
+    Procedure tarmattreader.BuildOperand(oper : tarmoperand);
+      var
+        expr : string;
+        typesize,l : 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
+                  ReadSym(oper);
+                  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;
+
+
+      var
+        tempreg : tregister;
+        hl : tasmlabel;
+        ofs : longint;
+      Begin
+        expr:='';
+        case actasmtoken of
+          AS_LPAREN: { Memory reference or constant expression }
+            Begin
+              oper.InitRef;
+              BuildReference(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
+                begin
+                  ofs:=oper.opr.ref.offset;
+                  BuildConstantOperand(oper);
+                  inc(oper.opr.val,ofs);
+                end
+              else
+                BuildReference(oper);
+            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 not(oper.SetupVar(expr,false)) then
+                        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 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;
+                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;
+
+
+{*****************************************************************************
+                                tarmattreader
+*****************************************************************************}
+
+    procedure tarmattreader.BuildOpCode(instr : tarminstruction);
+      var
+        operandnum : longint;
+      Begin
+        { 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;
+            oppostfix:=actoppostfix;
+          end;
+
+        { 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
+                  begin
+                    { condition operands doesn't set the operand but write to the
+                      condition field of the instruction
+                    }
+                    if instr.Operands[operandnum].opr.typ<>OPR_NONE then
+                      Inc(operandnum);
+                  end;
+                Consume(AS_COMMA);
+              end;
+            AS_SEPARATOR,
+            AS_END : { End of asm operands for this opcode  }
+              begin
+                break;
+              end;
+          else
+            BuildOperand(instr.Operands[operandnum] as tarmoperand);
+          end; { end case }
+        until false;
+        if (operandnum=1) and (instr.Operands[operandnum].opr.typ=OPR_NONE) then
+          dec(operandnum);
+        instr.Ops:=operandnum;
+      end;
+
+
+    function tarmattreader.is_asmopcode(const s: string):boolean;
+
+      const
+        { sorted by length so longer postfixes will match first }
+        postfix2strsorted : array[1..19] of string[2] = (
+          'EP','SB','BT','SH',
+          'IA','IB','DA','DB','FD','FA','ED','EA',
+          'B','D','E','P','T','H','S');
+
+        postfixsorted : array[1..19] of TOpPostfix = (
+          PF_EP,PF_SB,PF_BT,PF_SH,
+          PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA,
+          PF_B,PF_D,PF_E,PF_P,PF_T,PF_H,PF_S);
+
+      var
+        str2opentry: tstr2opentry;
+        len,
+        j,
+        sufidx : longint;
+        hs : string;
+        maxlen : longint;
+        icond : tasmcond;
+      Begin
+        { making s a value parameter would break other assembler readers }
+        hs:=s;
+        is_asmopcode:=false;
+
+        { clear op code }
+        actopcode:=A_None;
+
+        actcondition:=C_None;
+
+        maxlen:=max(length(hs),5);
+        for j:=maxlen downto 1 do
+          begin
+            str2opentry:=tstr2opentry(iasmops.search(copy(hs,1,j)));
+            if assigned(str2opentry) then
+              begin
+                actopcode:=str2opentry.op;
+                actasmtoken:=AS_OPCODE;
+                { strip op code }
+                delete(hs,1,j);
+                break;
+             end;
+          end;
+        if not(assigned(str2opentry)) then
+          exit;
+        { search for condition, conditions are always 2 chars }
+        if length(hs)>1 then
+          begin
+            for icond:=low(tasmcond) to high(tasmcond) do
+              begin
+                if copy(hs,1,2)=cond2str[icond] then
+                  begin
+                    actcondition:=icond;
+                    { strip condition }
+                    delete(hs,1,2);
+                    break;
+                  end;
+              end;
+          end;
+        { check for postfix }
+        if length(hs)>0 then
+          begin
+            for j:=low(postfixsorted) to high(postfixsorted) do
+              begin
+                if copy(hs,1,length(postfix2strsorted[j]))=postfix2strsorted[j] then
+                  begin
+                    actoppostfix:=postfixsorted[j];
+                    { strip postfix }
+                    delete(hs,1,length(postfix2strsorted[j]));
+                    break;
+                  end;
+              end;
+          end;
+        { if we stripped all postfixes, it's a valid opcode }
+        is_asmopcode:=length(hs)=0;
+      end;
+
+
+    procedure tarmattreader.ConvertCalljmp(instr : tarminstruction);
+      var
+        newopr : toprrec;
+      begin
+        if instr.Operands[1].opr.typ=OPR_REFERENCE then
+          begin
+            newopr.typ:=OPR_SYMBOL;
+            newopr.symbol:=instr.Operands[1].opr.ref.symbol;
+            newopr.symofs:=instr.Operands[1].opr.ref.offset;
+            if (instr.Operands[1].opr.ref.base<>NR_NO) or
+              (instr.Operands[1].opr.ref.index<>NR_NO) then
+              Message(asmr_e_syn_operand);
+            instr.Operands[1].opr:=newopr;
+          end;
+      end;
+
+
+    procedure tarmattreader.handleopcode;
+      var
+        instr : tarminstruction;
+      begin
+        instr:=TarmInstruction.Create(TarmOperand);
+        BuildOpcode(instr);
+        if is_calljmp(instr.opcode) then
+          ConvertCalljmp(instr);
+        {
+        instr.AddReferenceSizes;
+        instr.SetInstructionOpsize;
+        instr.CheckOperandSizes;
+        }
+        instr.ConcatInstruction(curlist);
+        instr.Free;
+      end;
+
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_arm_att_info : tasmmodeinfo =
+          (
+            id    : asmmode_arm_gas;
+            idtxt : 'GAS';
+            casmreader : tarmattreader;
+          );
+
+  asmmode_arm_standard_info : tasmmodeinfo =
+          (
+            id    : asmmode_standard;
+            idtxt : 'STANDARD';
+            casmreader : tarmattreader;
+          );
+
+initialization
+  RegisterAsmMode(asmmode_arm_att_info);
+  RegisterAsmMode(asmmode_arm_standard_info);
+end.
+{
+  $Log$
+  Revision 1.1  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+}

compiler/arm/radirect.pas

@@ -1,349 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Reads inline Powerpc 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.
-
- ****************************************************************************
-}
-{
-  This unit reads ARM inline assembler and writes the lines direct to the output file.
-}
-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,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner,
-       { codegen }
-       cgbase,procinfo,
-       { constants }
-       itarmgas,
-       cpubase
-       ;
-
-    function is_register(const s:string):boolean;
-      begin
-        is_register:=false;
-        if gas_regnum_search(lower(s))<>NR_NO then
-          is_register:=true;
-      end;
-
-
-    function assemble : tnode;
-      var
-         retstr,s,hs : string;
-         c : char;
-         ende : boolean;
-         srsym,sym : tsym;
-         srsymtable : tsymtable;
-         code : TAAsmoutput;
-         framereg : tregister;
-         i,l : longint;
-
-       procedure writeasmline;
-         var
-           i : longint;
-         begin
-           i:=length(s);
-           while (i>0) and (s[i] in [' ',#9]) do
-            dec(i);
-           s[0]:=chr(i);
-           if s<>'' then
-            code.concat(Tai_direct.Create(strpnew(s)));
-            { consider it set function set if the offset was loaded }
-           if assigned(current_procinfo.procdef.funcretsym) and
-              (pos(retstr,upper(s))>0) then
-             tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
-           s:='';
-         end;
-
-     begin
-       ende:=false;
-       framereg:=NR_FRAME_POINTER_REG;
-       s:='';
-       if assigned(current_procinfo.procdef.funcretsym) and
-          is_fpu(current_procinfo.procdef.rettype.def) then
-         tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
-       { !!!!!
-       if (not is_void(current_procinfo.procdef.rettype.def)) then
-         retstr:=upper(tostr(tvarsym(current_procinfo.procdef.funcretsym).adjusted_address)+'('+gas_reg2str[procinfo^.framepointer]+')')
-       else
-       }
-         retstr:='';
-
-       c:=current_scanner.asmgetchar;
-       code:=TAAsmoutput.Create;
-       while not(ende) do
-         begin
-            { wrong placement
-            current_scanner.gettokenpos; }
-            case c of
-              'A'..'Z','a'..'z','_':
-                begin
-                   current_scanner.gettokenpos;
-                   i:=0;
-                   hs:='';
-                   while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
-                      or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
-                      or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
-                      or (c='_') do
-                     begin
-                        inc(i);
-                        hs[i]:=c;
-                        c:=current_scanner.asmgetchar;
-                     end;
-                   hs[0]:=chr(i);
-                   if upper(hs)='END' then
-                      ende:=true
-                   else
-                      begin
-                         if c=':' then
-                           begin
-                             searchsym(upper(hs),srsym,srsymtable);
-                             if srsym<>nil then
-                               if (srsym.typ = labelsym) then
-                                 Begin
-                                    hs:=tlabelsym(srsym).lab.name;
-                                    tlabelsym(srsym).lab.is_set:=true;
-                                 end
-                               else
-                                 Message(asmr_w_using_defined_as_local);
-                           end
-                         else
-                           { access to local variables }
-                           if assigned(current_procinfo.procdef) then
-                             begin
-                                { I don't know yet, what the ppc port requires }
-                                { we'll see how things settle down             }
-
-                                { is the last written character an special }
-                                { char ?                                   }
-                                { !!!
-                                if (s[length(s)]='%') and
-                                   ret_in_acc(current_procinfo.procdef.rettype.def) and
-                                   ((pos('AX',upper(hs))>0) or
-                                   (pos('AL',upper(hs))>0)) then
-                                  tfuncretsym(current_procinfo.procdef.funcretsym).funcretstate:=vs_assigned;
-                                }
-                                if ((s[length(s)]<>'0') or (hs[1]<>'x')) and not(is_register(hs)) 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
-                                               if (vo_is_external in tvarsym(sym).varoptions) then
-                                                 hs:=tvarsym(sym).mangledname
-                                               else
-                                                 begin
-                                                    if (tvarsym(sym).localloc.loc=LOC_REGISTER) then
-                                                      hs:=gas_regname(tvarsym(sym).localloc.register)
-                                                    else
-                                                      hs:='%%'+tvarsym(sym).name;
-                                                 end;
-                                            end
-                                          else
-                                          { call to local function }
-                                          if (sym.typ=procsym) and (pos('BL',upper(s))>0) then
-                                            hs:=tprocsym(sym).first_procdef.mangledname;
-                                       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
-                                               searchsym(upper(hs),sym,srsymtable);
-                                               if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
-                                                 begin
-                                                   case sym.typ of
-                                                     constsym :
-                                                       begin
-                                                         inc(tconstsym(sym).refs);
-                                                         case tconstsym(sym).consttyp of
-                                                           constint,constchar,constbool :
-                                                             hs:=tostr(tconstsym(sym).value.valueord);
-                                                           constpointer :
-                                                             hs:=tostr(tconstsym(sym).value.valueordptr);
-                                                           else
-                                                             Message(asmr_e_wrong_sym_type);
-                                                         end;
-                                                       end;
-                                                     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('BL',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
-{$ifdef dummy}
-                                               else if upper(hs)='__SELF' then
-                                                 begin
-                                                    if assigned(procinfo^._class) then
-                                                      hs:=tostr(procinfo^.selfpointer_offset)+
-                                                          '('+gas_reg2str[procinfo^.framepointer]+')'
-                                                    else
-                                                     Message(asmr_e_cannot_use_SELF_outside_a_method);
-                                                 end
-                                               else if upper(hs)='__RESULT' then
-                                                 begin
-                                                    if (not is_void(current_procinfo.procdef.rettype.def)) then
-                                                      hs:=retstr
-                                                    else
-                                                      Message(asmr_e_void_function);
-                                                 end
-                                               { implement old stack/frame pointer access for nested procedures }
-                                               {!!!!
-                                               else if upper(hs)='__OLDSP' then
-                                                 begin
-                                                    { complicate to check there }
-                                                    { we do it: }
-                                                    if lexlevel>normal_function_level then
-                                                      hs:=tostr(procinfo^.framepointer_offset)+
-                                                        '('+gas_reg2str[procinfo^.framepointer]+')'
-                                                    else
-                                                      Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
-                                                 end;
-                                               }
-                                               end;
-{$endif dummy}
-                                            end;
-                                       end;
-                                  end;
-                             end;
-                         s:=s+hs;
-                      end;
-                end;
-              ';',#10,#13:
-                begin
-                   if pos(retstr,s) > 0 then
-                     tvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_assigned;
-                   writeasmline;
-                   c:=current_scanner.asmgetchar;
-                end;
-              #26:
-                Message(scan_f_end_of_file);
-              else
-                begin
-                  current_scanner.gettokenpos;
-                  inc(byte(s[0]));
-                  s[length(s)]:=c;
-                  c:=current_scanner.asmgetchar;
-                end;
-            end;
-         end;
-       writeasmline;
-       assemble:=casmnode.create(code);
-     end;
-
-{*****************************************************************************
-                                     Initialize
-*****************************************************************************}
-
-const
-  asmmode_arm_direct_info : tasmmodeinfo =
-          (
-            id    : asmmode_direct;
-            idtxt : 'DIRECT'
-          );
-
-initialization
-  RegisterAsmMode(asmmode_arm_direct_info);
-end.
-{
-  $Log$
-  Revision 1.5  2003-11-02 14:30:03  florian
-    * fixed ARM for new reg. allocation scheme
-
-  Revision 1.4  2003/09/04 00:15:29  florian
-    * first bunch of adaptions of arm compiler for new register type
-
-  Revision 1.3  2003/09/01 15:11:17  florian
-    * fixed reference handling
-    * fixed operand postfix for floating point instructions
-    * fixed wrong shifter constant handling
-
-  Revision 1.2  2003/08/16 13:23:01  florian
-    * several arm related stuff fixed
-
-  Revision 1.1  2003/07/21 16:35:30  florian
-    * very basic stuff for the arm
-}

compiler/compiler.pas

@@ -209,6 +209,9 @@ uses
 {$ifdef powerpc}
   ,rappcgas
 {$endif powerpc}
+{$ifdef arm}
+  ,raarmgas
+{$endif arm}
   ;
 
 function Compile(const cmd:string):longint;
@@ -417,7 +420,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.41  2003-11-12 16:05:39  florian
+  Revision 1.42  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+
+  Revision 1.41  2003/11/12 16:05:39  florian
     * assembler readers OOPed
     + typed currency constants
     + typed 128 bit float constants if the CPU supports it

compiler/raatt.pas

@@ -47,7 +47,7 @@ unit raatt;
         AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM,
         AS_REALNUM,AS_COMMA,AS_LPAREN,
         AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,
-        AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_DOLLAR,
+        AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_DOLLAR,AS_HASH,AS_LSBRACKET,AS_RSBRACKET,
         {------------------ Assembler directives --------------------}
         AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL,
         AS_ALIGN,AS_BALIGN,AS_P2ALIGN,AS_ASCII,
@@ -68,7 +68,7 @@ unit raatt;
         '','Label','LLabel','string','integer',
         'float',',','(',
         ')',':','.','+','-','*',
-        ';','identifier','register','opcode','/','$',
+        ';','identifier','register','opcode','/','$','#','{','}',
         '.byte','.word','.long','.quad','.globl',
         '.align','.balign','.p2align','.ascii',
         '.asciz','.lcomm','.comm','.single','.double','.tfloat',
@@ -91,7 +91,7 @@ unit raatt;
          procedure handleopcode;virtual;abstract;
          function is_asmopcode(const s: string) : boolean;virtual;abstract;
          Function is_asmdirective(const s: string):boolean;
-         function is_register(const s:string):boolean;
+         function is_register(const s:string):boolean;virtual;
          function is_locallabel(const s: string):boolean;
          procedure GetToken;
          function consume(t : tasmtoken):boolean;
@@ -193,10 +193,20 @@ unit raatt;
         while c in [' ',#9] do
          c:=current_scanner.asmgetchar;
         { get token pos }
+{$ifdef arm}
+        if not (c in [#10,#13,';']) then
+          current_scanner.gettokenpos;
+{$else arm}
         if not (c in [#10,#13,'{',';']) then
           current_scanner.gettokenpos;
+{$endif arm}
+
         { Local Label, Label, Directive, Prefix or Opcode }
+{$ifdef arm}
+        if firsttoken and not(c in [#10,#13,';']) then
+{$else arm}
         if firsttoken and not(c in [#10,#13,'{',';']) then
+{$endif arm}
          begin
            firsttoken:=FALSE;
            len:=0;
@@ -560,6 +570,30 @@ unit raatt;
                  exit;
                end;
 
+             '#' :
+               begin
+                 actasmtoken:=AS_HASH;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+{$ifdef arm}
+             // the arm assembler uses { ... } for register sets
+             '{' :
+               begin
+                 actasmtoken:=AS_LSBRACKET;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '}' :
+               begin
+                 actasmtoken:=AS_RSBRACKET;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+{$endif arm}
+
              ',' :
                begin
                  actasmtoken:=AS_COMMA;
@@ -656,7 +690,10 @@ unit raatt;
                  exit;
                end;
 
-             '{',#13,#10,';' :
+{$ifndef arm}
+             '{',
+{$endif arm}
+             #13,#10,';' :
                begin
                  { the comment is read by asmgetchar }
                  c:=current_scanner.asmgetchar;
@@ -1421,7 +1458,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  2003-11-15 19:00:10  florian
+  Revision 1.3  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+
+  Revision 1.2  2003/11/15 19:00:10  florian
     * fixed ppc assembler reader
 
   Revision 1.1  2003/11/12 16:05:39  florian

compiler/rautils.pas

@@ -111,7 +111,9 @@ type
     constructor create(optype : tcoperand);virtual;
     destructor  destroy;override;
     Procedure BuildOpcode;virtual;abstract;
-    procedure ConcatInstruction(p:TAAsmoutput);virtual;
+    { converts the instruction to an instruction how it's used by the assembler writer
+      and concats it to the passed list, the newly created item is returned }
+    function ConcatInstruction(p:TAAsmoutput) : tai;virtual;
     Procedure Swapoperands;
   end;
 
@@ -1097,7 +1099,7 @@ Begin
 end;
 
 
-  procedure TInstruction.ConcatInstruction(p:TAAsmoutput);
+  function TInstruction.ConcatInstruction(p:TAAsmoutput) : tai;
     var
       ai   : taicpu;
       i : longint;
@@ -1122,12 +1124,12 @@ end;
          end;
        end;
      ai.SetCondition(condition);
-
      { Concat the opcode or give an error }
       if assigned(ai) then
          p.concat(ai)
       else
        Message(asmr_e_invalid_opcode_and_operand);
+      result:=ai;
     end;
 
 
@@ -1616,7 +1618,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.77  2003-11-12 16:05:39  florian
+  Revision 1.78  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+
+  Revision 1.77  2003/11/12 16:05:39  florian
     * assembler readers OOPed
     + typed currency constants
     + typed 128 bit float constants if the CPU supports it

compiler/systems.pas

@@ -70,6 +70,8 @@ interface
             ,asmmode_i386_intel
             ,asmmode_ppc_gas
             ,asmmode_ppc_motorola
+            ,asmmode_arm_gas
+            ,asmmode_sparc_gas
        );
 
      (* IMPORTANT NOTE:
@@ -646,7 +648,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.72  2003-11-12 16:05:39  florian
+  Revision 1.73  2003-11-17 23:23:47  florian
+    + first part of arm assembler reader
+
+  Revision 1.72  2003/11/12 16:05:39  florian
     * assembler readers OOPed
     + typed currency constants
     + typed 128 bit float constants if the CPU supports it

compiler/x86/rax86.pas

@@ -58,7 +58,7 @@ type
     procedure CheckNonCommutativeOpcodes;
     procedure SwapOperands;
     { opcode adding }
-    procedure ConcatInstruction(p : taasmoutput);override;
+    function ConcatInstruction(p : taasmoutput) : tai;override;
   end;
 
 const
@@ -487,7 +487,7 @@ end;
                               opcode Adding
 *****************************************************************************}
 
-procedure T386Instruction.ConcatInstruction(p : taasmoutput);
+function T386Instruction.ConcatInstruction(p : taasmoutput) : tai;
 var
   siz  : topsize;
   i,asize : longint;
@@ -727,12 +727,16 @@ begin
    end
   else
    Message(asmr_e_invalid_opcode_and_operand);
+  result:=ai;
 end;
 
 end.
 {
   $Log$
-  Revision 1.14  2003-11-12 16:05:40  florian
+  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
     * assembler readers OOPed
     + typed currency constants
     + typed 128 bit float constants if the CPU supports it