* assembler readers OOPed

  + typed currency constants
  + typed 128 bit float constants if the CPU supports it

compiler/aasmtai.pas

@@ -191,7 +191,7 @@ interface
 {$endif GDB}
                   ait_cut,ait_marker,ait_align,ait_section,ait_comment,
                   ait_const_8bit,ait_const_16bit,ait_const_32bit,
-                  ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit
+                  ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit
                   ];
 
 
@@ -378,6 +378,14 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
 
+       { Generates an extended float (128 bit real) }
+       tai_real_128bit = class(tai)
+          value : ts128real;
+          constructor Create(_value : ts80real);
+          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+       end;
+
        { Generates a comp int (integer over 64 bits)
 
           This is Intel 80x86 specific, and is not
@@ -1094,6 +1102,33 @@ implementation
       end;
 
 
+{****************************************************************************
+                               TAI_real_80bit
+ ****************************************************************************}
+
+    constructor tai_real_128bit.Create(_value : ts128real);
+
+      begin
+         inherited Create;
+         typ:=ait_real_128bit;
+         value:=_value;
+      end;
+
+
+    constructor tai_real_128bit.ppuload(t:taitype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        value:=ppufile.getreal;
+      end;
+
+
+    procedure tai_real_128bit.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putreal(value);
+      end;
+
+
 {****************************************************************************
                                Tai_comp_64bit
  ****************************************************************************}
@@ -2153,7 +2188,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2003-11-07 15:58:32  florian
+  Revision 1.55  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.54  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/aggas.pas

@@ -79,13 +79,13 @@ implementation
       ,gdb
 {$endif GDB}
 {$ifdef x86}
-      ,itx86att
+      ,itcpugas
 {$endif}
 {$ifdef powerpc}
-      ,itppcgas
+      ,itcpugas
 {$endif}
 {$ifdef arm}
-      ,itarmgas
+      ,itcpugas
 {$endif}
       ;
 
@@ -832,7 +832,12 @@ var
 end.
 {
   $Log$
-  Revision 1.36  2003-10-01 20:34:48  peter
+  Revision 1.37  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.36  2003/10/01 20:34:48  peter
     * procinfo unit contains tprocinfo
     * cginfo renamed to cgbase
     * moved cgmessage to verbose

compiler/arm/itarmgas.pas → compiler/arm/itcpugas.pas

@@ -113,7 +113,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2003-11-02 14:30:03  florian
+  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
+
+  Revision 1.2  2003/11/02 14:30:03  florian
     * fixed ARM for new reg. allocation scheme
 
   Revision 1.1  2003/09/04 00:15:29  florian

compiler/arm/rasm.pas

@@ -1,69 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by The Free Pascal Team
-
-    This unit does the parsing process for the 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 Rasm;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses
-  node;
-
-   {
-     This routine is called to parse the instructions in assembler
-     blocks. It returns a complete list of directive and instructions
-   }
-   function assemble: tnode;
-
-
-Implementation
-
-    uses
-       { common }
-       cutils,cclasses,
-       { global }
-       globtype,globals,verbose,
-       systems,
-       { aasm }
-       cpubase,aasmbase,aasmtai,aasmcpu,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner
-       // ,rautils
-       ;
-
-    function assemble : tnode;
-     begin
-     end;
-
-Begin
-end.
-{
-  $Log$
-  Revision 1.1  2003-08-16 13:23:01  florian
-    * several arm related stuff fixed
-}

compiler/compiler.pas

@@ -195,6 +195,20 @@ uses
 {$ifdef win32}
   ,i_win32
 {$endif win32}
+  { assembler readers }
+{$ifdef i386}
+  {$ifndef NoRa386Int}
+       ,ra386int
+  {$endif NoRa386Int}
+  {$ifndef NoRa386Att}
+       ,ra386att
+  {$endif NoRa386Att}
+{$else}
+  ,rasm
+{$endif i386}
+{$ifdef powerpc}
+  ,rappcgas
+{$endif powerpc}
   ;
 
 function Compile(const cmd:string):longint;
@@ -403,7 +417,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.40  2003-09-05 17:41:12  florian
+  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
+
+  Revision 1.40  2003/09/05 17:41:12  florian
     * merged Wiktor's Watcom patches in 1.1
 
   Revision 1.39  2003/09/03 11:18:36  florian

compiler/globals.pas

@@ -1380,12 +1380,12 @@ implementation
       var
         t : tproccalloption;
       begin
-        SetAktProcCall:=false;
+        result:=false;
         for t:=low(tproccalloption) to high(tproccalloption) do
          if DefProcCallName[t]=s then
           begin
             AktDefProcCall:=t;
-            SetAktProcCall:=true;
+            result:=true;
             break;
           end;
         if changeinit then
@@ -1673,6 +1673,8 @@ implementation
         initglobalswitches:=[cs_check_unit_name,cs_link_static{$ifdef INTERNALLINKER},cs_link_internal,cs_link_map{$endif}];
         initoutputformat:=target_asm.id;
         fillchar(initalignment,sizeof(talignmentinfo),0);
+        { might be overridden later }
+        initasmmode:=asmmode_standard;
 {$ifdef i386}
         initoptprocessor:=Class386;
         initspecificoptprocessor:=Class386;
@@ -1691,7 +1693,6 @@ implementation
         {$IFDEF testvarsets}
          initsetalloc:=0;
         {$ENDIF}
-        initasmmode:=asmmode_standard;
 {$endif m68k}
 {$ifdef powerpc}
         initoptprocessor:=PPC604;
@@ -1699,7 +1700,6 @@ implementation
         {$IFDEF testvarsets}
          initsetalloc:=0;
         {$ENDIF}
-        initasmmode:=asmmode_direct;
         initfputype:=fpu_standard;
 {$endif powerpc}
 {$ifdef sparc}
@@ -1745,7 +1745,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.114  2003-11-10 17:22:28  marco
+  Revision 1.115  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.114  2003/11/10 17:22:28  marco
    * havelinuxrtl10 fixes
 
   Revision 1.113  2003/11/07 15:58:32  florian
@@ -2018,4 +2023,4 @@ end.
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 
-}
+}

compiler/i386/cpuinfo.pas

@@ -45,6 +45,7 @@ Type
    ts32real = single;
    ts64real = double;
    ts80real = extended;
+   ts128real = extended;
    ts64comp = extended;
 
    pbestreal=^bestreal;
@@ -119,7 +120,12 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.18  2003-11-07 15:58:32  florian
+  Revision 1.19  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.18  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/i386/ra386int.pas

@@ -24,1954 +24,1954 @@ Unit Ra386int;
 
 {$i fpcdefs.inc}
 
-Interface
+  interface
 
-uses
-  node;
-
-function assemble: tnode;
+    uses
+      cclasses,
+      cpubase,
+      rasm,
+      rax86;
+
+  type
+    tasmtoken = (
+      AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM,
+      AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN,
+      AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,
+      AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,
+       {------------------ Assembler directives --------------------}
+      AS_DB,AS_DW,AS_DD,AS_END,
+       {------------------ Assembler Operators  --------------------}
+      AS_BYTE,AS_WORD,AS_DWORD,AS_QWORD,AS_TBYTE,AS_NEAR,AS_FAR,
+      AS_HIGH,AS_LOW,AS_OFFSET,AS_SEG,AS_TYPE,AS_PTR,AS_MOD,AS_SHL,AS_SHR,AS_NOT,
+      AS_AND,AS_OR,AS_XOR);
+
+    type
+       ti386intreader = class(tasmreader)
+         actasmtoken : tasmtoken;
+         prevasmtoken : tasmtoken;
+         ActOpsize : topsize;
+         constructor create;override;
+         destructor destroy;override;
+         function is_asmopcode(const s: string):boolean;
+         function is_asmoperator(const s: string):boolean;
+         function is_asmdirective(const s: string):boolean;
+         function is_register(const s:string):boolean;
+         function is_locallabel(const s:string):boolean;
+         function Assemble: tlinkedlist;override;
+         procedure GetToken;
+         function consume(t : tasmtoken):boolean;
+         procedure RecoverConsume(allowcomma:boolean);
+         procedure BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
+         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 BuildConstant(maxvalue: longint);
+       end;
 
 
-Implementation
+  implementation
 
     uses
        { common }
-       cutils,cclasses,
+       cutils,
        { global }
        globtype,globals,verbose,
        systems,
        { aasm }
-       cpuinfo,cpubase,aasmbase,aasmtai,aasmcpu,
+       cpuinfo,aasmbase,aasmtai,aasmcpu,
        { symtable }
        symconst,symbase,symtype,symsym,symtable,
-       { pass 1 }
-       nbas,
        { parser }
        scanner,
        { register allocator }
-       rautils,rax86,itx86int,
+       rabase,rautils,itx86int,
        { codegen }
        cgbase,cgobj,procinfo
        ;
 
-type
-  tasmtoken = (
-    AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM,
-    AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN,
-    AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,
-    AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,
-     {------------------ Assembler directives --------------------}
-    AS_DB,AS_DW,AS_DD,AS_END,
-     {------------------ Assembler Operators  --------------------}
-    AS_BYTE,AS_WORD,AS_DWORD,AS_QWORD,AS_TBYTE,AS_NEAR,AS_FAR,
-    AS_HIGH,AS_LOW,AS_OFFSET,AS_SEG,AS_TYPE,AS_PTR,AS_MOD,AS_SHL,AS_SHR,AS_NOT,
-    AS_AND,AS_OR,AS_XOR);
-
-  tasmkeyword = string[6];
-const
-   { These tokens should be modified accordingly to the modifications }
-   { in the different enumerations.                                   }
-   firstdirective = AS_DB;
-   lastdirective  = AS_END;
-   firstoperator  = AS_BYTE;
-   lastoperator   = AS_XOR;
-
-   _count_asmdirectives = longint(lastdirective)-longint(firstdirective);
-   _count_asmoperators  = longint(lastoperator)-longint(firstoperator);
-
-   _asmdirectives : array[0.._count_asmdirectives] of tasmkeyword =
-   ('DB','DW','DD','END');
-
-   { problems with shl,shr,not,and,or and xor, they are }
-   { context sensitive.                                 }
-   _asmoperators : array[0.._count_asmoperators] of tasmkeyword = (
-    'BYTE','WORD','DWORD','QWORD','TBYTE','NEAR','FAR','HIGH',
-    'LOW','OFFSET','SEG','TYPE','PTR','MOD','SHL','SHR','NOT','AND',
-    'OR','XOR');
-
-  token2str : array[tasmtoken] of string[10] = (
-    '','Label','LLabel','String','Integer',
-    ',','[',']','(',
-    ')',':','.','+','-','*',
-    ';','identifier','register','opcode','/',
-    '','','','END',
-    '','','','','','','','',
-    '','','','type','ptr','mod','shl','shr','not',
-    'and','or','xor'
-  );
+    type
+      tasmkeyword = string[6];
+
+
+    const
+       { These tokens should be modified accordingly to the modifications }
+       { in the different enumerations.                                   }
+       firstdirective = AS_DB;
+       lastdirective  = AS_END;
+       firstoperator  = AS_BYTE;
+       lastoperator   = AS_XOR;
+
+       _count_asmdirectives = longint(lastdirective)-longint(firstdirective);
+       _count_asmoperators  = longint(lastoperator)-longint(firstoperator);
+
+       _asmdirectives : array[0.._count_asmdirectives] of tasmkeyword =
+       ('DB','DW','DD','END');
+
+       { problems with shl,shr,not,and,or and xor, they are }
+       { context sensitive.                                 }
+       _asmoperators : array[0.._count_asmoperators] of tasmkeyword = (
+        'BYTE','WORD','DWORD','QWORD','TBYTE','NEAR','FAR','HIGH',
+        'LOW','OFFSET','SEG','TYPE','PTR','MOD','SHL','SHR','NOT','AND',
+        'OR','XOR');
+
+      token2str : array[tasmtoken] of string[10] = (
+        '','Label','LLabel','String','Integer',
+        ',','[',']','(',
+        ')',':','.','+','-','*',
+        ';','identifier','register','opcode','/',
+        '','','','END',
+        '','','','','','','','',
+        '','','','type','ptr','mod','shl','shr','not',
+        'and','or','xor'
+      );
+
+    var
+      inexpression   : boolean;
+
+    constructor ti386intreader.create;
+      var
+        i : tasmop;
+        str2opentry: tstr2opentry;
+      Begin
+        inherited create;
+        { opcodes }
+        { creates uppercased symbol tables for speed access }
+        iasmops:=tdictionary.create;
+        iasmops.delete_doubles:=true;
+        for i:=firstop to lastop do
+          begin
+            str2opentry:=tstr2opentry.createname(upper(std_op2str[i]));
+            str2opentry.op:=i;
+            iasmops.insert(str2opentry);
+          end;
+      end;
 
-const
-  newline = #10;
-  firsttoken : boolean = TRUE;
-var
-  _asmsorted     : boolean;
-  inexpression   : boolean;
-  curlist        : TAAsmoutput;
-  c              : char;
-  prevasmtoken   : tasmtoken;
-  actasmtoken    : tasmtoken;
-  actasmpattern  : string;
-  actasmregister : tregister;
-  actopcode      : tasmop;
-  actopsize      : topsize;
-  actcondition   : tasmcond;
-  iasmops        : tdictionary;
-
-
-Procedure SetupTables;
-{ creates uppercased symbol tables for speed access }
-var
-  i : tasmop;
-  str2opentry: tstr2opentry;
-Begin
-  { opcodes }
-  iasmops:=tdictionary.create;
-  iasmops.delete_doubles:=true;
-  for i:=firstop to lastop do
-    begin
-      str2opentry:=tstr2opentry.createname(upper(std_op2str[i]));
-      str2opentry.op:=i;
-      iasmops.insert(str2opentry);
-    end;
-end;
 
+    destructor ti386intreader.destroy;
+      begin
+        if assigned(iasmops) then
+          iasmops.Free;
+      end;
 
-  {---------------------------------------------------------------------}
-  {                     Routines for the tokenizing                     }
-  {---------------------------------------------------------------------}
+{---------------------------------------------------------------------}
+{                     Routines for the tokenizing                     }
+{---------------------------------------------------------------------}
 
 
-   function is_asmopcode(const s: string):boolean;
-   var
-     str2opentry: tstr2opentry;
-     cond : string[4];
-     cnd : tasmcond;
-     j: longint;
-   Begin
-     is_asmopcode:=FALSE;
+     function ti386intreader.is_asmopcode(const s: string):boolean;
+       var
+         str2opentry: tstr2opentry;
+         cond : string[4];
+         cnd : tasmcond;
+         j: longint;
+       Begin
+         is_asmopcode:=FALSE;
 
-     actopcode:=A_None;
-     actcondition:=C_None;
-     actopsize:=S_NO;
+         actopcode:=A_None;
+         actcondition:=C_None;
+         actopsize:=S_NO;
 
-     str2opentry:=tstr2opentry(iasmops.search(s));
-     if assigned(str2opentry) then
-       begin
-         actopcode:=str2opentry.op;
-         actasmtoken:=AS_OPCODE;
-         is_asmopcode:=TRUE;
-         exit;
-       end;
-     { not found yet, 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,255);
-           if cond<>'' then
-            begin
-              for cnd:=low(TasmCond) to high(TasmCond) do
-               if Cond=Upper(cond2str[cnd]) then
+         str2opentry:=tstr2opentry(iasmops.search(s));
+         if assigned(str2opentry) then
+           begin
+             actopcode:=str2opentry.op;
+             actasmtoken:=AS_OPCODE;
+             is_asmopcode:=TRUE;
+             exit;
+           end;
+         { not found yet, 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,255);
+               if cond<>'' then
                 begin
-                  actopcode:=CondASmOp[j];
-                  actcondition:=cnd;
-                  is_asmopcode:=TRUE;
-                  actasmtoken:=AS_OPCODE;
-                  exit
+                  for cnd:=low(TasmCond) to high(TasmCond) do
+                   if Cond=Upper(cond2str[cnd]) then
+                    begin
+                      actopcode:=CondASmOp[j];
+                      actcondition:=cnd;
+                      is_asmopcode:=TRUE;
+                      actasmtoken:=AS_OPCODE;
+                      exit
+                    end;
                 end;
-            end;
-         end;
-        inc(j);
-      end;
-   end;
-
-
-function is_asmoperator(const s: string):boolean;
-var
-  i : longint;
-Begin
-  for i:=0 to _count_asmoperators do
-   if s=_asmoperators[i] then
-    begin
-      actasmtoken:=tasmtoken(longint(firstoperator)+i);
-      is_asmoperator:=true;
-      exit;
-    end;
-  is_asmoperator:=false;
-end;
+             end;
+            inc(j);
+          end;
+       end;
 
 
-Function is_asmdirective(const s: string):boolean;
-var
-  i : longint;
-Begin
-  for i:=0 to _count_asmdirectives do
-   if s=_asmdirectives[i] then
-    begin
-      actasmtoken:=tasmtoken(longint(firstdirective)+i);
-      is_asmdirective:=true;
-      exit;
-    end;
-  is_asmdirective:=false;
-end;
+    function ti386intreader.is_asmoperator(const s: string):boolean;
+      var
+        i : longint;
+      Begin
+        for i:=0 to _count_asmoperators do
+         if s=_asmoperators[i] then
+          begin
+            actasmtoken:=tasmtoken(longint(firstoperator)+i);
+            is_asmoperator:=true;
+            exit;
+          end;
+        is_asmoperator:=false;
+      end;
 
 
-function is_register(const s:string):boolean;
-begin
-  is_register:=false;
-  actasmregister:=masm_regnum_search(lower(s));
-  if actasmregister<>NR_NO then
-    begin
-      is_register:=true;
-      actasmtoken:=AS_REGISTER;
-    end;
-end;
+    Function ti386intreader.is_asmdirective(const s: string):boolean;
+      var
+        i : longint;
+      Begin
+        for i:=0 to _count_asmdirectives do
+         if s=_asmdirectives[i] then
+          begin
+            actasmtoken:=tasmtoken(longint(firstdirective)+i);
+            is_asmdirective:=true;
+            exit;
+          end;
+        is_asmdirective:=false;
+      end;
 
 
-function is_locallabel(const s:string):boolean;
-begin
-  is_locallabel:=(length(s)>1) and (s[1]='@');
-end;
+    function ti386intreader.is_register(const s:string):boolean;
+      begin
+        is_register:=false;
+        actasmregister:=masm_regnum_search(lower(s));
+        if actasmregister<>NR_NO then
+          begin
+            is_register:=true;
+            actasmtoken:=AS_REGISTER;
+          end;
+      end;
 
 
-Procedure GetToken;
-var
-  len : longint;
-  forcelabel : boolean;
-  srsym : tsym;
-  srsymtable : tsymtable;
-begin
-  { save old token and reset new token }
-  prevasmtoken:=actasmtoken;
-  actasmtoken:=AS_NONE;
-  { reset }
-  forcelabel:=FALSE;
-  actasmpattern:='';
-  { while space and tab , continue scan... }
-  while (c in [' ',#9]) do
-    c:=current_scanner.asmgetchar;
-  { get token pos }
-  if not (c in [newline,#13,'{',';']) then
-    current_scanner.gettokenpos;
-{ Local Label, Label, Directive, Prefix or Opcode }
-  if firsttoken and not (c in [newline,#13,'{',';']) then
-   begin
-     firsttoken:=FALSE;
-     len:=0;
-     while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
+    function ti386intreader.is_locallabel(const s:string):boolean;
       begin
-        { if there is an at_sign, then this must absolutely be a label }
-        if c = '@' then
-         forcelabel:=TRUE;
-        inc(len);
-        actasmpattern[len]:=c;
-        c:=current_scanner.asmgetchar;
+        is_locallabel:=(length(s)>1) and (s[1]='@');
       end;
-     actasmpattern[0]:=chr(len);
-     uppervar(actasmpattern);
-     { label ? }
-     if c = ':' then
+
+
+    Procedure ti386intreader.GetToken;
+      var
+        len : longint;
+        forcelabel : boolean;
+        srsym : tsym;
+        srsymtable : tsymtable;
       begin
-        if actasmpattern[1]='@' then
-          actasmtoken:=AS_LLABEL
-        else
-          actasmtoken:=AS_LABEL;
-        { let us point to the next character }
-        c:=current_scanner.asmgetchar;
-        firsttoken:=true;
-        exit;
-      end;
-     { Are we trying to create an identifier with }
-     { an at-sign...?                             }
-     if forcelabel then
-      Message(asmr_e_none_label_contain_at);
-     { opcode ? }
-     If is_asmopcode(actasmpattern) then
-      Begin
-        { check if we are in an expression  }
-        { then continue with asm directives }
-        if not inexpression then
-         exit;
-      end;
-     if is_asmdirective(actasmpattern) then
-      exit;
-     message1(asmr_e_unknown_opcode,actasmpattern);
-     actasmtoken:=AS_NONE;
-     exit;
-   end
-  else { else firsttoken }
-   begin
-     case c of
-       '@' : { possiblities : - local label reference , such as in jmp @local1 }
-             {                - @Result, @Code or @Data special variables.     }
+        { save old token and reset new token }
+        prevasmtoken:=actasmtoken;
+        actasmtoken:=AS_NONE;
+        { reset }
+        forcelabel:=FALSE;
+        actasmpattern:='';
+        { while space and tab , continue scan... }
+        while (c in [' ',#9]) do
+          c:=current_scanner.asmgetchar;
+        { get token pos }
+        if not (c in [#10,#13,'{',';']) then
+          current_scanner.gettokenpos;
+      { Local Label, Label, Directive, Prefix or Opcode }
+        if firsttoken and not (c in [#10,#13,'{',';']) then
          begin
-           actasmpattern:=c;
-           c:=current_scanner.asmgetchar;
-           while c in  ['A'..'Z','a'..'z','0'..'9','_','@'] do
+           firsttoken:=FALSE;
+           len:=0;
+           while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
             begin
-              actasmpattern:=actasmpattern + c;
+              { if there is an at_sign, then this must absolutely be a label }
+              if c = '@' then
+               forcelabel:=TRUE;
+              inc(len);
+              actasmpattern[len]:=c;
               c:=current_scanner.asmgetchar;
             end;
+           actasmpattern[0]:=chr(len);
            uppervar(actasmpattern);
-           actasmtoken:=AS_ID;
-           exit;
-         end;
-
-       'A'..'Z','a'..'z','_': { identifier, register, opcode, prefix or directive }
-         begin
-           actasmpattern:=c;
-           c:=current_scanner.asmgetchar;
-           while c in  ['A'..'Z','a'..'z','0'..'9','_'] do
+           { label ? }
+           if c = ':' then
             begin
-              actasmpattern:=actasmpattern + c;
+              if actasmpattern[1]='@' then
+                actasmtoken:=AS_LLABEL
+              else
+                actasmtoken:=AS_LABEL;
+              { let us point to the next character }
               c:=current_scanner.asmgetchar;
+              firsttoken:=true;
+              exit;
             end;
-           uppervar(actasmpattern);
-           { after prefix we allow also a new opcode }
-           If is_prefix(actopcode) and is_asmopcode(actasmpattern) then
+           { Are we trying to create an identifier with }
+           { an at-sign...?                             }
+           if forcelabel then
+            Message(asmr_e_none_label_contain_at);
+           { opcode ? }
+           If is_asmopcode(actasmpattern) then
             Begin
-              { if we are not in a constant }
-              { expression than this is an  }
-              { opcode.                     }
+              { check if we are in an expression  }
+              { then continue with asm directives }
               if not inexpression then
                exit;
             end;
-           { support st(X) for fpu registers }
-           if (actasmpattern = 'ST') and (c='(') then
-            Begin
-              actasmpattern:=actasmpattern+c;
-              c:=current_scanner.asmgetchar;
-              if c in ['0'..'7'] 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;
-               end;
-            end;
-           if is_register(actasmpattern) then
-            exit;
            if is_asmdirective(actasmpattern) then
             exit;
-           if is_asmoperator(actasmpattern) then
-            exit;
-           { if next is a '.' and this is a unitsym then we also need to
-             parse the identifier }
-           if (c='.') then
-            begin
-              searchsym(actasmpattern,srsym,srsymtable);
-              if assigned(srsym) and
-                 (srsym.typ=unitsym) and
-                 (srsym.owner.unitid=0) then
+           message1(asmr_e_unknown_opcode,actasmpattern);
+           actasmtoken:=AS_NONE;
+           exit;
+         end
+        else { else firsttoken }
+         begin
+           case c of
+             '@' : { possiblities : - local label reference , such as in jmp @local1 }
+                   {                - @Result, @Code or @Data special variables.     }
                begin
-                 { Add . to create System.Identifier }
-                 actasmpattern:=actasmpattern+c;
+                 actasmpattern:=c;
                  c:=current_scanner.asmgetchar;
-                 { Delphi allows System.@Halt, just ignore the @ }
-                 if c='@' then
-                   c:=current_scanner.asmgetchar;
-                 while c in  ['A'..'Z','a'..'z','0'..'9','_','$'] do
+                 while c in  ['A'..'Z','a'..'z','0'..'9','_','@'] do
                   begin
-                    actasmpattern:=actasmpattern + upcase(c);
+                    actasmpattern:=actasmpattern + c;
                     c:=current_scanner.asmgetchar;
                   end;
+                 uppervar(actasmpattern);
+                 actasmtoken:=AS_ID;
+                 exit;
                end;
-            end;
-           actasmtoken:=AS_ID;
-           exit;
-         end;
 
-       '''' : { string or character }
-         begin
-           actasmpattern:='';
-           current_scanner.in_asm_string:=true;
-           repeat
-             if c = '''' then
-              begin
-                c:=current_scanner.asmgetchar;
-                if c=newline then
-                 begin
-                   Message(scan_f_string_exceeds_line);
-                   break;
-                 end;
-                repeat
-                  if c='''' then
-                   begin
-                     c:=current_scanner.asmgetchar;
-                     if c='''' then
-                      begin
-                        actasmpattern:=actasmpattern+'''';
-                        c:=current_scanner.asmgetchar;
-                        if c=newline then
+             'A'..'Z','a'..'z','_': { identifier, register, opcode, prefix or directive }
+               begin
+                 actasmpattern:=c;
+                 c:=current_scanner.asmgetchar;
+                 while c in  ['A'..'Z','a'..'z','0'..'9','_'] do
+                  begin
+                    actasmpattern:=actasmpattern + c;
+                    c:=current_scanner.asmgetchar;
+                  end;
+                 uppervar(actasmpattern);
+                 { after prefix we allow also a new opcode }
+                 If is_prefix(actopcode) and is_asmopcode(actasmpattern) then
+                  Begin
+                    { if we are not in a constant }
+                    { expression than this is an  }
+                    { opcode.                     }
+                    if not inexpression then
+                     exit;
+                  end;
+                 { support st(X) for fpu registers }
+                 if (actasmpattern = 'ST') and (c='(') then
+                  Begin
+                    actasmpattern:=actasmpattern+c;
+                    c:=current_scanner.asmgetchar;
+                    if c in ['0'..'7'] 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;
+                     end;
+                  end;
+                 if is_register(actasmpattern) then
+                  exit;
+                 if is_asmdirective(actasmpattern) then
+                  exit;
+                 if is_asmoperator(actasmpattern) then
+                  exit;
+                 { if next is a '.' and this is a unitsym then we also need to
+                   parse the identifier }
+                 if (c='.') then
+                  begin
+                    searchsym(actasmpattern,srsym,srsymtable);
+                    if assigned(srsym) and
+                       (srsym.typ=unitsym) and
+                       (srsym.owner.unitid=0) then
+                     begin
+                       { Add . to create System.Identifier }
+                       actasmpattern:=actasmpattern+c;
+                       c:=current_scanner.asmgetchar;
+                       { Delphi allows System.@Halt, just ignore the @ }
+                       if c='@' then
+                         c:=current_scanner.asmgetchar;
+                       while c in  ['A'..'Z','a'..'z','0'..'9','_','$'] do
+                        begin
+                          actasmpattern:=actasmpattern + upcase(c);
+                          c:=current_scanner.asmgetchar;
+                        end;
+                     end;
+                  end;
+                 actasmtoken:=AS_ID;
+                 exit;
+               end;
+
+             '''' : { string or character }
+               begin
+                 actasmpattern:='';
+                 current_scanner.in_asm_string:=true;
+                 repeat
+                   if c = '''' then
+                    begin
+                      c:=current_scanner.asmgetchar;
+                      if c in [#10,#13] then
+                       begin
+                         Message(scan_f_string_exceeds_line);
+                         break;
+                       end;
+                      repeat
+                        if c='''' then
+                         begin
+                           c:=current_scanner.asmgetchar;
+                           if c='''' then
+                            begin
+                              actasmpattern:=actasmpattern+'''';
+                              c:=current_scanner.asmgetchar;
+                              if c in [#10,#13] then
+                               begin
+                                 Message(scan_f_string_exceeds_line);
+                                 break;
+                               end;
+                            end
+                           else
+                            break;
+                         end
+                        else
                          begin
-                           Message(scan_f_string_exceeds_line);
-                           break;
+                           actasmpattern:=actasmpattern+c;
+                           c:=current_scanner.asmgetchar;
+                           if c in [#10,#13] then
+                            begin
+                              Message(scan_f_string_exceeds_line);
+                              break
+                            end;
                          end;
-                      end
-                     else
-                      break;
-                   end
-                  else
-                   begin
-                     actasmpattern:=actasmpattern+c;
-                     c:=current_scanner.asmgetchar;
-                     if c=newline then
-                      begin
-                        Message(scan_f_string_exceeds_line);
-                        break
-                      end;
-                   end;
-                until false; { end repeat }
-              end
-             else
-              break; { end if }
-           until false;
-           current_scanner.in_asm_string:=false;
-           actasmtoken:=AS_STRING;
-           exit;
-         end;
+                      until false; { end repeat }
+                    end
+                   else
+                    break; { end if }
+                 until false;
+                 current_scanner.in_asm_string:=false;
+                 actasmtoken:=AS_STRING;
+                 exit;
+               end;
 
-       '"' : { string or character }
-         begin
-           current_scanner.in_asm_string:=true;
-           actasmpattern:='';
-           repeat
-             if c = '"' then
-              begin
-                c:=current_scanner.asmgetchar;
-                if c=newline then
-                 begin
-                   Message(scan_f_string_exceeds_line);
-                   break;
-                 end;
-                repeat
-                  if c='"' then
-                   begin
-                     c:=current_scanner.asmgetchar;
-                     if c='"' then
-                      begin
-                        actasmpattern:=actasmpattern+'"';
-                        c:=current_scanner.asmgetchar;
-                        if c=newline then
+             '"' : { string or character }
+               begin
+                 current_scanner.in_asm_string:=true;
+                 actasmpattern:='';
+                 repeat
+                   if c = '"' then
+                    begin
+                      c:=current_scanner.asmgetchar;
+                      if c in [#10,#13] then
+                       begin
+                         Message(scan_f_string_exceeds_line);
+                         break;
+                       end;
+                      repeat
+                        if c='"' then
+                         begin
+                           c:=current_scanner.asmgetchar;
+                           if c='"' then
+                            begin
+                              actasmpattern:=actasmpattern+'"';
+                              c:=current_scanner.asmgetchar;
+                              if c in [#10,#13] then
+                               begin
+                                 Message(scan_f_string_exceeds_line);
+                                 break;
+                               end;
+                            end
+                           else
+                            break;
+                         end
+                        else
                          begin
-                           Message(scan_f_string_exceeds_line);
-                           break;
+                           actasmpattern:=actasmpattern+c;
+                           c:=current_scanner.asmgetchar;
+                           if c in [#10,#13] then
+                            begin
+                              Message(scan_f_string_exceeds_line);
+                              break
+                            end;
                          end;
-                      end
-                     else
-                      break;
-                   end
-                  else
-                   begin
-                     actasmpattern:=actasmpattern+c;
-                     c:=current_scanner.asmgetchar;
-                     if c=newline then
-                      begin
-                        Message(scan_f_string_exceeds_line);
-                        break
-                      end;
-                   end;
-                until false; { end repeat }
-              end
-             else
-              break; { end if }
-           until false;
-           current_scanner.in_asm_string:=false;
-           actasmtoken:=AS_STRING;
-           exit;
-         end;
+                      until false; { end repeat }
+                    end
+                   else
+                    break; { end if }
+                 until false;
+                 current_scanner.in_asm_string:=false;
+                 actasmtoken:=AS_STRING;
+                 exit;
+               end;
 
-       '$' :
-         begin
-           c:=current_scanner.asmgetchar;
-           while c in ['0'..'9','A'..'F','a'..'f'] do
-            begin
-              actasmpattern:=actasmpattern + c;
-              c:=current_scanner.asmgetchar;
-            end;
-           actasmpattern:=tostr(ValHexaDecimal(actasmpattern));
-           actasmtoken:=AS_INTNUM;
-           exit;
-         end;
+             '$' :
+               begin
+                 c:=current_scanner.asmgetchar;
+                 while c in ['0'..'9','A'..'F','a'..'f'] do
+                  begin
+                    actasmpattern:=actasmpattern + c;
+                    c:=current_scanner.asmgetchar;
+                  end;
+                 actasmpattern:=tostr(ValHexaDecimal(actasmpattern));
+                 actasmtoken:=AS_INTNUM;
+                 exit;
+               end;
 
-       ',' :
-         begin
-           actasmtoken:=AS_COMMA;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             ',' :
+               begin
+                 actasmtoken:=AS_COMMA;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       '[' :
-         begin
-           actasmtoken:=AS_LBRACKET;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             '[' :
+               begin
+                 actasmtoken:=AS_LBRACKET;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       ']' :
-         begin
-           actasmtoken:=AS_RBRACKET;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             ']' :
+               begin
+                 actasmtoken:=AS_RBRACKET;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       '(' :
-         begin
-           actasmtoken:=AS_LPAREN;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             '(' :
+               begin
+                 actasmtoken:=AS_LPAREN;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       ')' :
-         begin
-           actasmtoken:=AS_RPAREN;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             ')' :
+               begin
+                 actasmtoken:=AS_RPAREN;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       ':' :
-         begin
-           actasmtoken:=AS_COLON;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             ':' :
+               begin
+                 actasmtoken:=AS_COLON;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       '.' :
-         begin
-           actasmtoken:=AS_DOT;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             '.' :
+               begin
+                 actasmtoken:=AS_DOT;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       '+' :
-         begin
-           actasmtoken:=AS_PLUS;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             '+' :
+               begin
+                 actasmtoken:=AS_PLUS;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       '-' :
-         begin
-           actasmtoken:=AS_MINUS;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             '-' :
+               begin
+                 actasmtoken:=AS_MINUS;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       '*' :
-         begin
-           actasmtoken:=AS_STAR;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             '*' :
+               begin
+                 actasmtoken:=AS_STAR;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       '/' :
-         begin
-           actasmtoken:=AS_SLASH;
-           c:=current_scanner.asmgetchar;
-           exit;
-         end;
+             '/' :
+               begin
+                 actasmtoken:=AS_SLASH;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
 
-       '0'..'9':
-         begin
-           actasmpattern:=c;
-           c:=current_scanner.asmgetchar;
-           { Get the possible characters }
-           while c in ['0'..'9','A'..'F','a'..'f'] do
-            begin
-              actasmpattern:=actasmpattern + c;
-              c:=current_scanner.asmgetchar;
-            end;
-           { Get ending character }
-           uppervar(actasmpattern);
-           c:=upcase(c);
-           { possibly a binary number. }
-           if (actasmpattern[length(actasmpattern)] = 'B') and (c <> 'H') then
-            Begin
-              { Delete the last binary specifier }
-              delete(actasmpattern,length(actasmpattern),1);
-              actasmpattern:=tostr(ValBinary(actasmpattern));
-              actasmtoken:=AS_INTNUM;
-              exit;
-            end
-           else
-            Begin
-              case c of
-                'O' :
-                  Begin
-                    actasmpattern:=tostr(ValOctal(actasmpattern));
-                    actasmtoken:=AS_INTNUM;
+             '0'..'9':
+               begin
+                 actasmpattern:=c;
+                 c:=current_scanner.asmgetchar;
+                 { Get the possible characters }
+                 while c in ['0'..'9','A'..'F','a'..'f'] do
+                  begin
+                    actasmpattern:=actasmpattern + c;
                     c:=current_scanner.asmgetchar;
-                    exit;
                   end;
-                'H' :
+                 { Get ending character }
+                 uppervar(actasmpattern);
+                 c:=upcase(c);
+                 { possibly a binary number. }
+                 if (actasmpattern[length(actasmpattern)] = 'B') and (c <> 'H') then
                   Begin
-                    actasmpattern:=tostr(ValHexaDecimal(actasmpattern));
-                    actasmtoken:=AS_INTNUM;
-                    c:=current_scanner.asmgetchar;
-                    exit;
-                  end;
-                else { must be an integer number }
-                  begin
-                    actasmpattern:=tostr(ValDecimal(actasmpattern));
+                    { Delete the last binary specifier }
+                    delete(actasmpattern,length(actasmpattern),1);
+                    actasmpattern:=tostr(ValBinary(actasmpattern));
                     actasmtoken:=AS_INTNUM;
                     exit;
+                  end
+                 else
+                  Begin
+                    case c of
+                      'O' :
+                        Begin
+                          actasmpattern:=tostr(ValOctal(actasmpattern));
+                          actasmtoken:=AS_INTNUM;
+                          c:=current_scanner.asmgetchar;
+                          exit;
+                        end;
+                      'H' :
+                        Begin
+                          actasmpattern:=tostr(ValHexaDecimal(actasmpattern));
+                          actasmtoken:=AS_INTNUM;
+                          c:=current_scanner.asmgetchar;
+                          exit;
+                        end;
+                      else { must be an integer number }
+                        begin
+                          actasmpattern:=tostr(ValDecimal(actasmpattern));
+                          actasmtoken:=AS_INTNUM;
+                          exit;
+                        end;
+                    end;
                   end;
-              end;
-            end;
-         end;
-
-       ';','{',#13,newline :
-         begin
-           c:=current_scanner.asmgetchar;
-           firsttoken:=TRUE;
-           actasmtoken:=AS_SEPARATOR;
-           exit;
+               end;
+             ';','{',#13,#10 :
+               begin
+                 c:=current_scanner.asmgetchar;
+                 firsttoken:=TRUE;
+                 actasmtoken:=AS_SEPARATOR;
+                 exit;
+               end;
+
+              else
+                 current_scanner.illegal_char(c);
+           end;
          end;
+      end;
 
-        else
-           current_scanner.illegal_char(c);
-     end;
-   end;
-end;
 
+  function ti386intreader.consume(t : tasmtoken):boolean;
+    begin
+      Consume:=true;
+      if t<>actasmtoken then
+       begin
+         Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
+         Consume:=false;
+       end;
+      repeat
+        gettoken;
+      until actasmtoken<>AS_NONE;
+    end;
 
-function consume(t : tasmtoken):boolean;
-begin
-  Consume:=true;
-  if t<>actasmtoken then
-   begin
-     Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
-     Consume:=false;
-   end;
-  repeat
-    gettoken;
-  until actasmtoken<>AS_NONE;
-end;
-
-
-procedure RecoverConsume(allowcomma:boolean);
-begin
-  While not (actasmtoken in [AS_SEPARATOR,AS_END]) do
-   begin
-     if allowcomma and (actasmtoken=AS_COMMA) then
-      break;
-     Consume(actasmtoken);
-   end;
-end;
+
+  procedure ti386intreader.RecoverConsume(allowcomma:boolean);
+    begin
+      While not (actasmtoken in [AS_SEPARATOR,AS_END]) do
+       begin
+         if allowcomma and (actasmtoken=AS_COMMA) then
+          break;
+         Consume(actasmtoken);
+       end;
+    end;
 
 
 {*****************************************************************************
-                               Parsing Helpers
+                                 Parsing Helpers
 *****************************************************************************}
 
-Procedure BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
-{ Description: This routine builds up a record offset after a AS_DOT }
-{ token is encountered.                                              }
-{ On entry actasmtoken should be equal to AS_DOT                     }
-var
-  s : string;
-Begin
-  offset:=0;
-  size:=0;
-  s:=expr;
-  while (actasmtoken=AS_DOT) do
-   begin
-     Consume(AS_DOT);
-     if actasmtoken=AS_ID then
-      s:=s+'.'+actasmpattern;
-     if not Consume(AS_ID) then
-      begin
-        RecoverConsume(true);
-        break;
+    { This routine builds up a record offset after a AS_DOT
+      token is encountered.
+      On entry actasmtoken should be equal to AS_DOT                     }
+    Procedure ti386intreader.BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
+      var
+        s : string;
+      Begin
+        offset:=0;
+        size:=0;
+        s:=expr;
+        while (actasmtoken=AS_DOT) do
+         begin
+           Consume(AS_DOT);
+           if actasmtoken=AS_ID then
+            s:=s+'.'+actasmpattern;
+           if not Consume(AS_ID) then
+            begin
+              RecoverConsume(true);
+              break;
+            end;
+         end;
+        if not GetRecordOffsetSize(s,offset,size) then
+         Message(asmr_e_building_record_offset);
       end;
-   end;
-  if not GetRecordOffsetSize(s,offset,size) then
-   Message(asmr_e_building_record_offset);
-end;
-
-
-Procedure BuildConstSymbolExpression(needofs,isref:boolean;var value:longint;var asmsym:string);
-var
-  tempstr,expr,hs : string;
-  parenlevel,l,k : longint;
-  errorflag : boolean;
-  prevtok : tasmtoken;
-  hl : tasmlabel;
-  sym : tsym;
-  srsymtable : tsymtable;
-Begin
-  { reset }
-  value:=0;
-  asmsym:='';
-  errorflag:=FALSE;
-  tempstr:='';
-  expr:='';
-  inexpression:=TRUE;
-  parenlevel:=0;
-  Repeat
-    Case actasmtoken of
-      AS_LPAREN:
-        Begin
-          Consume(AS_LPAREN);
-          expr:=expr + '(';
-          inc(parenlevel);
-        end;
-      AS_RPAREN:
-        Begin
-          Consume(AS_RPAREN);
-          expr:=expr + ')';
-          dec(parenlevel);
-        end;
-      AS_SHL:
-        Begin
-          Consume(AS_SHL);
-          expr:=expr + '<';
-        end;
-      AS_SHR:
-        Begin
-          Consume(AS_SHR);
-          expr:=expr + '>';
-        end;
-      AS_SLASH:
-        Begin
-          Consume(AS_SLASH);
-          expr:=expr + '/';
-        end;
-      AS_MOD:
-        Begin
-          Consume(AS_MOD);
-          expr:=expr + '%';
-        end;
-      AS_STAR:
-        Begin
-          Consume(AS_STAR);
-          if isref and (actasmtoken=AS_REGISTER) then
-           break;
-          expr:=expr + '*';
-        end;
-      AS_PLUS:
-        Begin
-          Consume(AS_PLUS);
-          if isref and (actasmtoken=AS_REGISTER) then
-           break;
-          expr:=expr + '+';
-        end;
-      AS_LBRACKET:
-        begin
-          { Support ugly delphi constructs like: [ECX].1+2[EDX] }
-          if isref then
-            break;
-        end;
-      AS_MINUS:
-        Begin
-          Consume(AS_MINUS);
-          expr:=expr + '-';
-        end;
-      AS_AND:
-        Begin
-          Consume(AS_AND);
-          expr:=expr + '&';
-        end;
-      AS_NOT:
-        Begin
-          Consume(AS_NOT);
-          expr:=expr + '~';
-        end;
-      AS_XOR:
-        Begin
-          Consume(AS_XOR);
-          expr:=expr + '^';
-        end;
-      AS_OR:
-        Begin
-          Consume(AS_OR);
-          expr:=expr + '|';
-        end;
-      AS_INTNUM:
-        Begin
-          expr:=expr + actasmpattern;
-          Consume(AS_INTNUM);
-        end;
-      AS_OFFSET:
-        begin
-          Consume(AS_OFFSET);
-          if actasmtoken<>AS_ID then
-           Message(asmr_e_offset_without_identifier);
-        end;
-      AS_TYPE:
-        begin
-          l:=0;
-          Consume(AS_TYPE);
-          if actasmtoken<>AS_ID then
-           Message(asmr_e_type_without_identifier)
-          else
-           begin
-             tempstr:=actasmpattern;
-             Consume(AS_ID);
-             if actasmtoken=AS_DOT then
-              BuildRecordOffsetSize(tempstr,k,l)
-             else
+
+
+    Procedure ti386intreader.BuildConstSymbolExpression(needofs,isref:boolean;var value:longint;var asmsym:string);
+      var
+        tempstr,expr,hs : string;
+        parenlevel,l,k : longint;
+        errorflag : boolean;
+        prevtok : tasmtoken;
+        hl : tasmlabel;
+        sym : tsym;
+        srsymtable : tsymtable;
+      Begin
+        { reset }
+        value:=0;
+        asmsym:='';
+        errorflag:=FALSE;
+        tempstr:='';
+        expr:='';
+        inexpression:=TRUE;
+        parenlevel:=0;
+        Repeat
+          Case actasmtoken of
+            AS_LPAREN:
+              Begin
+                Consume(AS_LPAREN);
+                expr:=expr + '(';
+                inc(parenlevel);
+              end;
+            AS_RPAREN:
+              Begin
+                Consume(AS_RPAREN);
+                expr:=expr + ')';
+                dec(parenlevel);
+              end;
+            AS_SHL:
+              Begin
+                Consume(AS_SHL);
+                expr:=expr + '<';
+              end;
+            AS_SHR:
+              Begin
+                Consume(AS_SHR);
+                expr:=expr + '>';
+              end;
+            AS_SLASH:
+              Begin
+                Consume(AS_SLASH);
+                expr:=expr + '/';
+              end;
+            AS_MOD:
+              Begin
+                Consume(AS_MOD);
+                expr:=expr + '%';
+              end;
+            AS_STAR:
+              Begin
+                Consume(AS_STAR);
+                if isref and (actasmtoken=AS_REGISTER) then
+                 break;
+                expr:=expr + '*';
+              end;
+            AS_PLUS:
+              Begin
+                Consume(AS_PLUS);
+                if isref and (actasmtoken=AS_REGISTER) then
+                 break;
+                expr:=expr + '+';
+              end;
+            AS_LBRACKET:
               begin
-                searchsym(tempstr,sym,srsymtable);
-                if assigned(sym) then
-                 begin
-                   case sym.typ of
-                     varsym :
-                       l:=tvarsym(sym).getsize;
-                     typedconstsym :
-                       l:=ttypedconstsym(sym).getsize;
-                     typesym :
-                       l:=ttypesym(sym).restype.def.size;
-                     else
-                       Message(asmr_e_wrong_sym_type);
-                   end;
-                 end
-                else
-                 Message1(sym_e_unknown_id,tempstr);
+                { Support ugly delphi constructs like: [ECX].1+2[EDX] }
+                if isref then
+                  break;
               end;
-           end;
-          str(l, tempstr);
-          expr:=expr + tempstr;
-        end;
-      AS_STRING:
-        Begin
-          l:=0;
-          case Length(actasmpattern) of
-           1 :
-            l:=ord(actasmpattern[1]);
-           2 :
-            l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8;
-           3 :
-            l:=ord(actasmpattern[3]) +
-               Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16;
-           4 :
-            l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
-               Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
-          else
-            Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
-          end;
-          str(l, tempstr);
-          expr:=expr + tempstr;
-          Consume(AS_STRING);
-        end;
-      AS_ID:
-        Begin
-          hs:='';
-          tempstr:=actasmpattern;
-          prevtok:=prevasmtoken;
-          consume(AS_ID);
-          if SearchIConstant(tempstr,l) then
-           begin
-             str(l, tempstr);
-             expr:=expr + tempstr;
-           end
-          else
-           begin
-             if is_locallabel(tempstr) then
+            AS_MINUS:
+              Begin
+                Consume(AS_MINUS);
+                expr:=expr + '-';
+              end;
+            AS_AND:
+              Begin
+                Consume(AS_AND);
+                expr:=expr + '&';
+              end;
+            AS_NOT:
+              Begin
+                Consume(AS_NOT);
+                expr:=expr + '~';
+              end;
+            AS_XOR:
+              Begin
+                Consume(AS_XOR);
+                expr:=expr + '^';
+              end;
+            AS_OR:
+              Begin
+                Consume(AS_OR);
+                expr:=expr + '|';
+              end;
+            AS_INTNUM:
+              Begin
+                expr:=expr + actasmpattern;
+                Consume(AS_INTNUM);
+              end;
+            AS_OFFSET:
               begin
-                CreateLocalLabel(tempstr,hl,false);
-                hs:=hl.name
-              end
-             else
-              if SearchLabel(tempstr,hl,false) then
-               hs:=hl.name
-             else
+                Consume(AS_OFFSET);
+                if actasmtoken<>AS_ID then
+                 Message(asmr_e_offset_without_identifier);
+              end;
+            AS_TYPE:
               begin
-                searchsym(tempstr,sym,srsymtable);
-                if assigned(sym) then
+                l:=0;
+                Consume(AS_TYPE);
+                if actasmtoken<>AS_ID then
+                 Message(asmr_e_type_without_identifier)
+                else
                  begin
-                   case sym.typ of
-                     varsym :
-                       begin
-                         if sym.owner.symtabletype in [localsymtable,parasymtable] then
-                          Message(asmr_e_no_local_or_para_allowed);
-                         hs:=tvarsym(sym).mangledname;
-                       end;
-                     typedconstsym :
-                       hs:=ttypedconstsym(sym).mangledname;
-                     procsym :
-                       begin
-                         if Tprocsym(sym).procdef_count>1 then
-                          Message(asmr_w_calling_overload_func);
-                         hs:=tprocsym(sym).first_procdef.mangledname;
-                       end;
-                     typesym :
+                   tempstr:=actasmpattern;
+                   Consume(AS_ID);
+                   if actasmtoken=AS_DOT then
+                    BuildRecordOffsetSize(tempstr,k,l)
+                   else
+                    begin
+                      searchsym(tempstr,sym,srsymtable);
+                      if assigned(sym) then
                        begin
-                         if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then
-                          Message(asmr_e_wrong_sym_type);
-                       end;
-                     else
-                       Message(asmr_e_wrong_sym_type);
-                   end;
-                 end
-                else
-                 Message1(sym_e_unknown_id,tempstr);
+                         case sym.typ of
+                           varsym :
+                             l:=tvarsym(sym).getsize;
+                           typedconstsym :
+                             l:=ttypedconstsym(sym).getsize;
+                           typesym :
+                             l:=ttypesym(sym).restype.def.size;
+                           else
+                             Message(asmr_e_wrong_sym_type);
+                         end;
+                       end
+                      else
+                       Message1(sym_e_unknown_id,tempstr);
+                    end;
+                 end;
+                str(l, tempstr);
+                expr:=expr + tempstr;
               end;
-             { symbol found? }
-             if hs<>'' then
-              begin
-                if needofs and (prevtok<>AS_OFFSET) then
-                 Message(asmr_e_need_offset);
-                if asmsym='' then
-                 asmsym:=hs
+            AS_STRING:
+              Begin
+                l:=0;
+                case Length(actasmpattern) of
+                 1 :
+                  l:=ord(actasmpattern[1]);
+                 2 :
+                  l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8;
+                 3 :
+                  l:=ord(actasmpattern[3]) +
+                     Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16;
+                 4 :
+                  l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
+                     Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
                 else
-                 Message(asmr_e_cant_have_multiple_relocatable_symbols);
-                if (expr='') or (expr[length(expr)]='+') then
+                  Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
+                end;
+                str(l, tempstr);
+                expr:=expr + tempstr;
+                Consume(AS_STRING);
+              end;
+            AS_ID:
+              Begin
+                hs:='';
+                tempstr:=actasmpattern;
+                prevtok:=prevasmtoken;
+                consume(AS_ID);
+                if SearchIConstant(tempstr,l) then
                  begin
-                   { don't remove the + if there could be a record field }
-                   if actasmtoken<>AS_DOT then
-                    delete(expr,length(expr),1);
+                   str(l, tempstr);
+                   expr:=expr + tempstr;
                  end
                 else
+                 begin
+                   if is_locallabel(tempstr) then
+                    begin
+                      CreateLocalLabel(tempstr,hl,false);
+                      hs:=hl.name
+                    end
+                   else
+                    if SearchLabel(tempstr,hl,false) then
+                     hs:=hl.name
+                   else
+                    begin
+                      searchsym(tempstr,sym,srsymtable);
+                      if assigned(sym) then
+                       begin
+                         case sym.typ of
+                           varsym :
+                             begin
+                               if sym.owner.symtabletype in [localsymtable,parasymtable] then
+                                Message(asmr_e_no_local_or_para_allowed);
+                               hs:=tvarsym(sym).mangledname;
+                             end;
+                           typedconstsym :
+                             hs:=ttypedconstsym(sym).mangledname;
+                           procsym :
+                             begin
+                               if Tprocsym(sym).procdef_count>1 then
+                                Message(asmr_w_calling_overload_func);
+                               hs:=tprocsym(sym).first_procdef.mangledname;
+                             end;
+                           typesym :
+                             begin
+                               if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then
+                                Message(asmr_e_wrong_sym_type);
+                             end;
+                           else
+                             Message(asmr_e_wrong_sym_type);
+                         end;
+                       end
+                      else
+                       Message1(sym_e_unknown_id,tempstr);
+                    end;
+                   { symbol found? }
+                   if hs<>'' then
+                    begin
+                      if needofs and (prevtok<>AS_OFFSET) then
+                       Message(asmr_e_need_offset);
+                      if asmsym='' then
+                       asmsym:=hs
+                      else
+                       Message(asmr_e_cant_have_multiple_relocatable_symbols);
+                      if (expr='') or (expr[length(expr)]='+') then
+                       begin
+                         { don't remove the + if there could be a record field }
+                         if actasmtoken<>AS_DOT then
+                          delete(expr,length(expr),1);
+                       end
+                      else
+                       Message(asmr_e_only_add_relocatable_symbol);
+                    end;
+                   if actasmtoken=AS_DOT then
+                    begin
+                      BuildRecordOffsetSize(tempstr,l,k);
+                      str(l, tempstr);
+                      expr:=expr + tempstr;
+                    end
+                   else
+                    begin
+                      if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then
+                       delete(expr,length(expr),1);
+                    end;
+                 end;
+                { check if there are wrong operator used like / or mod etc. }
+                if (hs<>'') and not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_END,AS_RBRACKET]) then
                  Message(asmr_e_only_add_relocatable_symbol);
               end;
-             if actasmtoken=AS_DOT then
-              begin
-                BuildRecordOffsetSize(tempstr,l,k);
-                str(l, tempstr);
-                expr:=expr + tempstr;
-              end
-             else
-              begin
-                if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then
-                 delete(expr,length(expr),1);
+            AS_END,
+            AS_RBRACKET,
+            AS_SEPARATOR,
+            AS_COMMA:
+              Begin
+                break;
               end;
-           end;
-          { check if there are wrong operator used like / or mod etc. }
-          if (hs<>'') and not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_END,AS_RBRACKET]) then
-           Message(asmr_e_only_add_relocatable_symbol);
-        end;
-      AS_END,
-      AS_RBRACKET,
-      AS_SEPARATOR,
-      AS_COMMA:
-        Begin
-          break;
-        end;
-    else
-      Begin
-        { write error only once. }
-        if not errorflag then
-          Message(asmr_e_invalid_constant_expression);
-        { consume tokens until we find COMMA or SEPARATOR }
-        Consume(actasmtoken);
-        errorflag:=TRUE;
+          else
+            Begin
+              { write error only once. }
+              if not errorflag then
+                Message(asmr_e_invalid_constant_expression);
+              { consume tokens until we find COMMA or SEPARATOR }
+              Consume(actasmtoken);
+              errorflag:=TRUE;
+            end;
+          end;
+        Until false;
+        { calculate expression }
+        if not ErrorFlag then
+          value:=CalculateExpression(expr)
+        else
+          value:=0;
+        { no longer in an expression }
+        inexpression:=FALSE;
       end;
-    end;
-  Until false;
-  { calculate expression }
-  if not ErrorFlag then
-    value:=CalculateExpression(expr)
-  else
-    value:=0;
-  { no longer in an expression }
-  inexpression:=FALSE;
-end;
-
-
-
-Function BuildConstExpression:longint;
-var
-  l : longint;
-  hs : string;
-begin
-  BuildConstSymbolExpression(false,false,l,hs);
-  if hs<>'' then
-   Message(asmr_e_relocatable_symbol_not_allowed);
-  BuildConstExpression:=l;
-end;
 
 
-Function BuildRefConstExpression:longint;
-var
-  l : longint;
-  hs : string;
-begin
-  BuildConstSymbolExpression(false,true,l,hs);
-  if hs<>'' then
-   Message(asmr_e_relocatable_symbol_not_allowed);
-  BuildRefConstExpression:=l;
-end;
-
-
-{****************************************************************************
-                               T386IntelOperand
-****************************************************************************}
-
-type
-  T386IntelOperand=class(T386Operand)
-    Procedure BuildOperand;override;
-  private
-    Procedure BuildReference;
-    Procedure BuildConstant;
-  end;
-
-
-
-Procedure T386IntelOperand.BuildReference;
-
-var
-  k,l,scale : longint;
-  tempstr,hs : string;
-  typesize : longint;
-  code : integer;
-  hreg : tregister;
-  GotStar,GotOffset,HadVar,
-  GotPlus,Negative : boolean;
-Begin
-  Consume(AS_LBRACKET);
-  if not(opr.typ in [OPR_LOCAL,OPR_REFERENCE]) then
-    InitRef;
-  GotStar:=false;
-  GotPlus:=true;
-  GotOffset:=false;
-  Negative:=false;
-  Scale:=0;
-  repeat
-    if GotOffset and (actasmtoken<>AS_ID) then
-      Message(asmr_e_invalid_reference_syntax);
-
-    Case actasmtoken of
-
-      AS_ID: { Constant reference expression OR variable reference expression }
-        Begin
-          if not GotPlus then
+    Function ti386intreader.BuildConstExpression:longint;
+      var
+        l : longint;
+        hs : string;
+      begin
+        BuildConstSymbolExpression(false,false,l,hs);
+        if hs<>'' then
+         Message(asmr_e_relocatable_symbol_not_allowed);
+        BuildConstExpression:=l;
+      end;
+
+
+    Function ti386intreader.BuildRefConstExpression:longint;
+      var
+        l : longint;
+        hs : string;
+      begin
+        BuildConstSymbolExpression(false,true,l,hs);
+        if hs<>'' then
+         Message(asmr_e_relocatable_symbol_not_allowed);
+        BuildRefConstExpression:=l;
+      end;
+
+
+    procedure ti386intreader.BuildReference(oper : t386operand);
+      var
+        k,l,scale : longint;
+        tempstr,hs : string;
+        typesize : longint;
+        code : integer;
+        hreg : tregister;
+        GotStar,GotOffset,HadVar,
+        GotPlus,Negative : boolean;
+      Begin
+        Consume(AS_LBRACKET);
+        if not(oper.opr.typ in [OPR_LOCAL,OPR_REFERENCE]) then
+          oper.InitRef;
+        GotStar:=false;
+        GotPlus:=true;
+        GotOffset:=false;
+        Negative:=false;
+        Scale:=0;
+        repeat
+          if GotOffset and (actasmtoken<>AS_ID) then
             Message(asmr_e_invalid_reference_syntax);
-          if actasmpattern[1] = '@' then
-           Message(asmr_e_local_label_not_allowed_as_ref);
-          GotStar:=false;
-          GotPlus:=false;
-          if SearchIConstant(actasmpattern,l) or
-             SearchRecordType(actasmpattern) then
-           begin
-             l:=BuildRefConstExpression;
-             GotPlus:=(prevasmtoken=AS_PLUS);
-             GotStar:=(prevasmtoken=AS_STAR);
-             case opr.typ of
-               OPR_LOCAL :
+
+          Case actasmtoken of
+
+            AS_ID: { Constant reference expression OR variable reference expression }
+              Begin
+                if not GotPlus then
+                  Message(asmr_e_invalid_reference_syntax);
+                if actasmpattern[1] = '@' then
+                 Message(asmr_e_local_label_not_allowed_as_ref);
+                GotStar:=false;
+                GotPlus:=false;
+                if SearchIConstant(actasmpattern,l) or
+                   SearchRecordType(actasmpattern) then
                  begin
-                   if GotStar then
-                     Message(asmr_e_invalid_reference_syntax);
+                   l:=BuildRefConstExpression;
+                   GotPlus:=(prevasmtoken=AS_PLUS);
+                   GotStar:=(prevasmtoken=AS_STAR);
+                   case oper.opr.typ of
+                     OPR_LOCAL :
+                       begin
+                         if GotStar then
+                           Message(asmr_e_invalid_reference_syntax);
+                         if negative then
+                           Dec(oper.opr.localsymofs,l)
+                         else
+                           Inc(oper.opr.localsymofs,l);
+                       end;
+                     OPR_REFERENCE :
+                       begin
+                         if GotStar then
+                          oper.opr.ref.scalefactor:=l
+                         else
+                          begin
+                            if negative then
+                              Dec(oper.opr.ref.offset,l)
+                            else
+                              Inc(oper.opr.ref.offset,l);
+                          end;
+                        end;
+                   end;
+                 end
+                else
+                 Begin
+                   if oper.hasvar and not GotOffset then
+                     Message(asmr_e_cant_have_multiple_relocatable_symbols);
+                   HadVar:=oper.hasvar and GotOffset;
                    if negative then
-                     Dec(opr.localsymofs,l)
-                   else
-                     Inc(opr.localsymofs,l);
-                 end;
-               OPR_REFERENCE :
-                 begin
-                   if GotStar then
-                    opr.ref.scalefactor:=l
+                     Message(asmr_e_only_add_relocatable_symbol);
+                   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,GotOffset) then
+                     Message1(sym_e_unknown_id,tempstr);
+                   { record.field ? }
+                   if actasmtoken=AS_DOT then
+                    begin
+                      BuildRecordOffsetSize(tempstr,l,k);
+                      case oper.opr.typ of
+                        OPR_LOCAL :
+                          inc(oper.opr.localsymofs,l);
+                        OPR_REFERENCE :
+                          inc(oper.opr.ref.offset,l);
+                      end;
+                    end;
+                   if GotOffset then
                     begin
-                      if negative then
-                        Dec(opr.ref.offset,l)
+                      if oper.hasvar and (oper.opr.ref.base=current_procinfo.framepointer) then
+                       begin
+                         if (oper.opr.typ=OPR_REFERENCE) then
+                           oper.opr.ref.base:=NR_NO;
+                         oper.hasvar:=hadvar;
+                       end
                       else
-                        Inc(opr.ref.offset,l);
+                       begin
+                         if oper.hasvar and hadvar then
+                          Message(asmr_e_cant_have_multiple_relocatable_symbols);
+                         { should we allow ?? }
+                       end;
                     end;
-                  end;
-             end;
-           end
-          else
-           Begin
-             if hasvar and not GotOffset then
-               Message(asmr_e_cant_have_multiple_relocatable_symbols);
-             HadVar:=hasvar and GotOffset;
-             if negative then
-               Message(asmr_e_only_add_relocatable_symbol);
-             tempstr:=actasmpattern;
-             Consume(AS_ID);
-             { typecasting? }
-             if (actasmtoken=AS_LPAREN) and
-                SearchType(tempstr,typesize) then
-              begin
-                hastype:=true;
-                Consume(AS_LPAREN);
-                BuildOperand;
-                Consume(AS_RPAREN);
-                if opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                  SetSize(typesize,true);
-              end
-             else
-              if not SetupVar(tempstr,GotOffset) then
-               Message1(sym_e_unknown_id,tempstr);
-             { record.field ? }
-             if actasmtoken=AS_DOT then
-              begin
-                BuildRecordOffsetSize(tempstr,l,k);
-                case opr.typ of
-                  OPR_LOCAL :
-                    inc(opr.localsymofs,l);
-                  OPR_REFERENCE :
-                    inc(opr.ref.offset,l);
-                end;
-              end;
-             if GotOffset then
-              begin
-                if hasvar and (opr.ref.base=current_procinfo.framepointer) then
-                 begin
-                   if (opr.typ=OPR_REFERENCE) then
-                     opr.ref.base:=NR_NO;
-                   hasvar:=hadvar;
-                 end
-                else
-                 begin
-                   if hasvar and hadvar then
-                    Message(asmr_e_cant_have_multiple_relocatable_symbols);
-                   { should we allow ?? }
                  end;
+                GotOffset:=false;
               end;
-           end;
-          GotOffset:=false;
-        end;
 
-      AS_PLUS :
-        Begin
-          Consume(AS_PLUS);
-          Negative:=false;
-          GotPlus:=true;
-          GotStar:=false;
-          Scale:=0;
-        end;
+            AS_PLUS :
+              Begin
+                Consume(AS_PLUS);
+                Negative:=false;
+                GotPlus:=true;
+                GotStar:=false;
+                Scale:=0;
+              end;
 
-      AS_MINUS :
-        begin
-          Consume(AS_MINUS);
-          Negative:=true;
-          GotPlus:=true;
-          GotStar:=false;
-          Scale:=0;
-        end;
+            AS_MINUS :
+              begin
+                Consume(AS_MINUS);
+                Negative:=true;
+                GotPlus:=true;
+                GotStar:=false;
+                Scale:=0;
+              end;
 
-      AS_STAR : { Scaling, with eax*4 order }
-        begin
-          Consume(AS_STAR);
-          hs:='';
-          l:=0;
-          case actasmtoken of
-            AS_LPAREN :
-              l:=BuildConstExpression;
-            AS_INTNUM:
-              Begin
-                hs:=actasmpattern;
-                Consume(AS_INTNUM);
+            AS_STAR : { Scaling, with eax*4 order }
+              begin
+                Consume(AS_STAR);
+                hs:='';
+                l:=0;
+                case actasmtoken of
+                  AS_LPAREN :
+                    l:=BuildConstExpression;
+                  AS_INTNUM:
+                    Begin
+                      hs:=actasmpattern;
+                      Consume(AS_INTNUM);
+                    end;
+                  AS_REGISTER :
+                    begin
+                      case oper.opr.typ of
+                        OPR_REFERENCE :
+                          begin
+                            if oper.opr.ref.scalefactor=0 then
+                              begin
+                                if scale<>0 then
+                                  begin
+                                    oper.opr.ref.scalefactor:=scale;
+                                    scale:=0;
+                                  end
+                                else
+                                 Message(asmr_e_wrong_scale_factor);
+                              end
+                            else
+                              Message(asmr_e_invalid_reference_syntax);
+                          end;
+                        OPR_LOCAL :
+                          begin
+                            if oper.opr.localscale=0 then
+                              begin
+                                if scale<>0 then
+                                  begin
+                                    oper.opr.localscale:=scale;
+                                    scale:=0;
+                                  end
+                                else
+                                 Message(asmr_e_wrong_scale_factor);
+                              end
+                            else
+                              Message(asmr_e_invalid_reference_syntax);
+                          end;
+                      end;
+                    end;
+                  else
+                    Message(asmr_e_invalid_reference_syntax);
+                end;
+                if actasmtoken<>AS_REGISTER then
+                  begin
+                    if hs<>'' then
+                      val(hs,l,code);
+                    case oper.opr.typ of
+                      OPR_REFERENCE :
+                        oper.opr.ref.scalefactor:=l;
+                      OPR_LOCAL :
+                        oper.opr.localscale:=l;
+                    end;
+                    if l>9 then
+                      Message(asmr_e_wrong_scale_factor);
+                  end;
+                GotPlus:=false;
+                GotStar:=false;
               end;
+
             AS_REGISTER :
               begin
-                case opr.typ of
-                  OPR_REFERENCE :
+                if not((GotPlus and (not Negative)) or
+                       GotStar) then
+                  Message(asmr_e_invalid_reference_syntax);
+                hreg:=actasmregister;
+                Consume(AS_REGISTER);
+                { this register will be the index:
+                   1. just read a *
+                   2. next token is a *
+                   3. base register is already used }
+                case oper.opr.typ of
+                  OPR_LOCAL :
                     begin
-                      if opr.ref.scalefactor=0 then
+                      if (oper.opr.localindexreg<>NR_NO) then
+                        Message(asmr_e_multiple_index);
+                      oper.opr.localindexreg:=hreg;
+                      if scale<>0 then
                         begin
-                          if scale<>0 then
-                            begin
-                              opr.ref.scalefactor:=scale;
-                              scale:=0;
-                            end
-                          else
-                           Message(asmr_e_wrong_scale_factor);
-                        end
-                      else
-                        Message(asmr_e_invalid_reference_syntax);
+                          oper.opr.localscale:=scale;
+                          scale:=0;
+                        end;
                     end;
-                  OPR_LOCAL :
+                  OPR_REFERENCE :
                     begin
-                      if opr.localscale=0 then
-                        begin
-                          if scale<>0 then
-                            begin
-                              opr.localscale:=scale;
-                              scale:=0;
-                            end
-                          else
-                           Message(asmr_e_wrong_scale_factor);
-                        end
+                      if (GotStar) or
+                         (actasmtoken=AS_STAR) or
+                         (oper.opr.ref.base<>NR_NO) then
+                       begin
+                         if (oper.opr.ref.index<>NR_NO) then
+                          Message(asmr_e_multiple_index);
+                         oper.opr.ref.index:=hreg;
+                         if scale<>0 then
+                           begin
+                             oper.opr.ref.scalefactor:=scale;
+                             scale:=0;
+                           end;
+                       end
                       else
-                        Message(asmr_e_invalid_reference_syntax);
+                       oper.opr.ref.base:=hreg;
                     end;
                 end;
+                GotPlus:=false;
+                GotStar:=false;
               end;
-            else
-              Message(asmr_e_invalid_reference_syntax);
-          end;
-          if actasmtoken<>AS_REGISTER then
-            begin
-              if hs<>'' then
-                val(hs,l,code);
-              case opr.typ of
-                OPR_REFERENCE :
-                  opr.ref.scalefactor:=l;
-                OPR_LOCAL :
-                  opr.localscale:=l;
-              end;
-              if l>9 then
-                Message(asmr_e_wrong_scale_factor);
-            end;
-          GotPlus:=false;
-          GotStar:=false;
-        end;
 
-      AS_REGISTER :
-        begin
-          if not((GotPlus and (not Negative)) or
-                 GotStar) then
-            Message(asmr_e_invalid_reference_syntax);
-          hreg:=actasmregister;
-          Consume(AS_REGISTER);
-          { this register will be the index:
-             1. just read a *
-             2. next token is a *
-             3. base register is already used }
-          case opr.typ of
-            OPR_LOCAL :
-              begin
-                if (opr.localindexreg<>NR_NO) then
-                  Message(asmr_e_multiple_index);
-                opr.localindexreg:=hreg;
-                if scale<>0 then
-                  begin
-                    opr.localscale:=scale;
-                    scale:=0;
-                  end;
-              end;
-            OPR_REFERENCE :
+            AS_OFFSET :
               begin
-                if (GotStar) or
-                   (actasmtoken=AS_STAR) or
-                   (opr.ref.base<>NR_NO) then
-                 begin
-                   if (opr.ref.index<>NR_NO) then
-                    Message(asmr_e_multiple_index);
-                   opr.ref.index:=hreg;
-                   if scale<>0 then
-                     begin
-                       opr.ref.scalefactor:=scale;
-                       scale:=0;
-                     end;
-                 end
-                else
-                 opr.ref.base:=hreg;
+                Consume(AS_OFFSET);
+                GotOffset:=true;
               end;
-          end;
-          GotPlus:=false;
-          GotStar:=false;
-        end;
 
-      AS_OFFSET :
-        begin
-          Consume(AS_OFFSET);
-          GotOffset:=true;
-        end;
-
-      AS_TYPE,
-      AS_NOT,
-      AS_STRING,
-      AS_INTNUM,
-      AS_LPAREN : { Constant reference expression }
-        begin
-          if not GotPlus and not GotStar then
-            Message(asmr_e_invalid_reference_syntax);
-          BuildConstSymbolExpression(true,true,l,tempstr);
-
-          if tempstr<>'' then
-           begin
-             if GotStar then
-              Message(asmr_e_only_add_relocatable_symbol);
-             if not assigned(opr.ref.symbol) then
-              opr.ref.symbol:=objectlibrary.newasmsymbol(tempstr)
-             else
-              Message(asmr_e_cant_have_multiple_relocatable_symbols);
-           end;
-          case opr.typ of
-            OPR_REFERENCE :
+            AS_TYPE,
+            AS_NOT,
+            AS_STRING,
+            AS_INTNUM,
+            AS_LPAREN : { Constant reference expression }
               begin
-                if GotStar then
-                 opr.ref.scalefactor:=l
-                else if (prevasmtoken = AS_STAR) then
-                 begin
-                   if scale<>0 then
-                     scale:=l*scale
-                   else
-                     scale:=l;
-                 end
-                else
+                if not GotPlus and not GotStar then
+                  Message(asmr_e_invalid_reference_syntax);
+                BuildConstSymbolExpression(true,true,l,tempstr);
+
+                if tempstr<>'' then
                  begin
-                   if negative then
-                     Dec(opr.ref.offset,l)
+                   if GotStar then
+                    Message(asmr_e_only_add_relocatable_symbol);
+                   if not assigned(oper.opr.ref.symbol) then
+                    oper.opr.ref.symbol:=objectlibrary.newasmsymbol(tempstr)
                    else
-                     Inc(opr.ref.offset,l);
+                    Message(asmr_e_cant_have_multiple_relocatable_symbols);
                  end;
+                case oper.opr.typ of
+                  OPR_REFERENCE :
+                    begin
+                      if GotStar then
+                       oper.opr.ref.scalefactor:=l
+                      else if (prevasmtoken = AS_STAR) then
+                       begin
+                         if scale<>0 then
+                           scale:=l*scale
+                         else
+                           scale:=l;
+                       end
+                      else
+                       begin
+                         if negative then
+                           Dec(oper.opr.ref.offset,l)
+                         else
+                           Inc(oper.opr.ref.offset,l);
+                       end;
+                    end;
+                  OPR_LOCAL :
+                    begin
+                      if GotStar then
+                       oper.opr.localscale:=l
+                      else if (prevasmtoken = AS_STAR) then
+                       begin
+                         if scale<>0 then
+                           scale:=l*scale
+                         else
+                           scale:=l;
+                       end
+                      else
+                       begin
+                         if negative then
+                           Dec(oper.opr.localsymofs,l)
+                         else
+                           Inc(oper.opr.localsymofs,l);
+                       end;
+                    end;
+                end;
+                GotPlus:=(prevasmtoken=AS_PLUS) or
+                         (prevasmtoken=AS_MINUS);
+                if GotPlus then
+                  negative := prevasmtoken = AS_MINUS;
+                GotStar:=(prevasmtoken=AS_STAR);
               end;
-            OPR_LOCAL :
+
+            AS_RBRACKET :
               begin
-                if GotStar then
-                 opr.localscale:=l
-                else if (prevasmtoken = AS_STAR) then
-                 begin
-                   if scale<>0 then
-                     scale:=l*scale
-                   else
-                     scale:=l;
-                 end
-                else
-                 begin
-                   if negative then
-                     Dec(opr.localsymofs,l)
-                   else
-                     Inc(opr.localsymofs,l);
-                 end;
+                if GotPlus or GotStar then
+                  Message(asmr_e_invalid_reference_syntax);
+                Consume(AS_RBRACKET);
+                break;
               end;
-          end;
-          GotPlus:=(prevasmtoken=AS_PLUS) or
-                   (prevasmtoken=AS_MINUS);
-          if GotPlus then
-            negative := prevasmtoken = AS_MINUS;
-          GotStar:=(prevasmtoken=AS_STAR);
-        end;
-
-      AS_RBRACKET :
-        begin
-          if GotPlus or GotStar then
-            Message(asmr_e_invalid_reference_syntax);
-          Consume(AS_RBRACKET);
-          break;
-        end;
 
-      else
-        Begin
-          Message(asmr_e_invalid_reference_syntax);
-          RecoverConsume(true);
-          break;
-        end;
-    end;
-  until false;
-end;
+            else
+              Begin
+                Message(asmr_e_invalid_reference_syntax);
+                RecoverConsume(true);
+                break;
+              end;
+          end;
+        until false;
+      end;
 
 
-Procedure T386IntelOperand.BuildConstant;
-var
-  l : longint;
-  tempstr : string;
-begin
-  if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then
-    Message(asmr_e_invalid_operand_type);
-  BuildConstSymbolExpression(true,false,l,tempstr);
-  if tempstr<>'' then
-   begin
-     opr.typ:=OPR_SYMBOL;
-     opr.symofs:=l;
-     opr.symbol:=objectlibrary.newasmsymbol(tempstr);
-   end
-  else
-   begin
-     if opr.typ=OPR_NONE then
-       begin
-         opr.typ:=OPR_CONSTANT;
-         opr.val:=l;
-       end
-     else
-       inc(opr.val,l);
-   end;
-end;
-
-
-Procedure T386IntelOperand.BuildOperand;
-
-  procedure AddLabelOperand(hl:tasmlabel);
-  begin
-    if is_calljmp(actopcode) then
-     begin
-       opr.typ:=OPR_SYMBOL;
-       opr.symbol:=hl;
-     end
-    else
-     begin
-       InitRef;
-       opr.ref.symbol:=hl;
-     end;
-  end;
-
-var
-  expr    : string;
-  tempreg : tregister;
-  typesize,
-  l       : longint;
-  hl      : tasmlabel;
-  toffset,
-  tsize   : longint;
-Begin
-  expr:='';
-  repeat
-    if actasmtoken=AS_DOT then
+    Procedure ti386intreader.BuildConstantOperand(oper: t386operand);
+      var
+        l : longint;
+        tempstr : string;
       begin
-        if expr<>'' then
-          begin
-            BuildRecordOffsetSize(expr,toffset,tsize);
-            SetSize(tsize,true);
-            case opr.typ of
-              OPR_LOCAL :
-                begin
-                  { don't allow direct access to fields of parameters, becuase that
-                    will generate buggy code. Allow it only for explicit typecasting
-                    and when the parameter is in a register (delphi compatible) }
-                  if (not hastype) and
-                     (tvarsym(opr.localsym).owner.symtabletype=parasymtable) and
-                     (current_procinfo.procdef.proccalloption<>pocall_register) then
-                    Message(asmr_e_cannot_access_field_directly_for_parameters);
-                  inc(opr.localsymofs,toffset)
-                end;
-              OPR_CONSTANT :
-                inc(opr.val,toffset);
-              OPR_REFERENCE :
-                inc(opr.ref.offset,toffset);
-              OPR_NONE :
-                begin
-                  opr.typ:=OPR_CONSTANT;
-                  opr.val:=toffset;
-                end;
-              else
-                internalerror(200309222);
-            end;
-            expr:='';
-          end
+        if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
+          Message(asmr_e_invalid_operand_type);
+        BuildConstSymbolExpression(true,false,l,tempstr);
+        if tempstr<>'' then
+         begin
+           oper.opr.typ:=OPR_SYMBOL;
+           oper.opr.symofs:=l;
+           oper.opr.symbol:=objectlibrary.newasmsymbol(tempstr);
+         end
         else
-          begin
-            { See it as a separator }
-            Consume(AS_DOT);
-          end;
-     end;
+         begin
+           if oper.opr.typ=OPR_NONE then
+             begin
+               oper.opr.typ:=OPR_CONSTANT;
+               oper.opr.val:=l;
+             end
+           else
+             inc(oper.opr.val,l);
+         end;
+      end;
 
-    case actasmtoken of
 
-      AS_OFFSET,
-      AS_TYPE,
-      AS_NOT,
-      AS_STRING :
-        Begin
-          BuildConstant;
-        end;
+    Procedure ti386intreader.BuildOperand(oper: t386operand);
 
-      AS_PLUS,
-      AS_MINUS,
-      AS_LPAREN,
-      AS_INTNUM :
+        procedure AddLabelOperand(hl:tasmlabel);
         begin
-          case opr.typ of
-            OPR_REFERENCE :
-              inc(opr.ref.offset,BuildRefConstExpression);
-            OPR_LOCAL :
-              inc(opr.localsymofs,BuildConstExpression);
-            OPR_NONE,
-            OPR_CONSTANT :
-              BuildConstant;
-            else
-              Message(asmr_e_invalid_operand_type);
-          end;
-        end;
-
-      AS_ID : { A constant expression, or a Variable ref. }
-        Begin
-          { Label or Special symbol reference? }
-          if actasmpattern[1] = '@' then
-           Begin
-             if actasmpattern = '@RESULT' then
-              Begin
-                SetupResult;
-                Consume(AS_ID);
-              end
-             else
-              if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
-               begin
-                 Message(asmr_w_CODE_and_DATA_not_supported);
-                 Consume(AS_ID);
-               end
-             else
-              { Local Label }
-              begin
-                CreateLocalLabel(actasmpattern,hl,false);
-                Consume(AS_ID);
-                AddLabelOperand(hl);
-                if not (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
-                 Message(asmr_e_syntax_error);
-              end;
+          if is_calljmp(actopcode) then
+           begin
+             oper.opr.typ:=OPR_SYMBOL;
+             oper.opr.symbol:=hl;
            end
           else
-          { support result for delphi modes }
-           if (m_objpas in aktmodeswitches) and (actasmpattern='RESULT') then
+           begin
+             oper.InitRef;
+             oper.opr.ref.symbol:=hl;
+           end;
+        end;
+
+      var
+        expr    : string;
+        tempreg : tregister;
+        typesize,
+        l       : longint;
+        hl      : tasmlabel;
+        toffset,
+        tsize   : longint;
+      Begin
+        expr:='';
+        repeat
+          if actasmtoken=AS_DOT then
             begin
-              SetUpResult;
-              Consume(AS_ID);
-            end
-          { probably a variable or normal expression }
-          { or a procedure (such as in CALL ID)      }
-          else
-           Begin
-             { is it a constant ? }
-             if SearchIConstant(actasmpattern,l) then
+              if expr<>'' then
+                begin
+                  BuildRecordOffsetSize(expr,toffset,tsize);
+                  oper.SetSize(tsize,true);
+                  case oper.opr.typ of
+                    OPR_LOCAL :
+                      begin
+                        { don't allow direct access to fields of parameters, becuase that
+                          will generate buggy code. Allow it only for explicit typecasting
+                          and when the parameter is in a register (delphi compatible) }
+                        if (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,toffset)
+                      end;
+                    OPR_CONSTANT :
+                      inc(oper.opr.val,toffset);
+                    OPR_REFERENCE :
+                      inc(oper.opr.ref.offset,toffset);
+                    OPR_NONE :
+                      begin
+                        oper.opr.typ:=OPR_CONSTANT;
+                        oper.opr.val:=toffset;
+                      end;
+                    else
+                      internalerror(200309222);
+                  end;
+                  expr:='';
+                end
+              else
+                begin
+                  { See it as a separator }
+                  Consume(AS_DOT);
+                end;
+           end;
+
+          case actasmtoken of
+
+            AS_OFFSET,
+            AS_TYPE,
+            AS_NOT,
+            AS_STRING :
               Begin
-                case opr.typ of
+                BuildConstantOperand(oper);
+              end;
+
+            AS_PLUS,
+            AS_MINUS,
+            AS_LPAREN,
+            AS_INTNUM :
+              begin
+                case oper.opr.typ of
                   OPR_REFERENCE :
-                    inc(opr.ref.offset,BuildRefConstExpression);
+                    inc(oper.opr.ref.offset,BuildRefConstExpression);
                   OPR_LOCAL :
-                    inc(opr.localsymofs,BuildRefConstExpression);
+                    inc(oper.opr.localsymofs,BuildConstExpression);
                   OPR_NONE,
                   OPR_CONSTANT :
-                    BuildConstant;
+                    BuildConstantOperand(oper);
                   else
                     Message(asmr_e_invalid_operand_type);
                 end;
-              end
-             else
-              { Check for pascal label }
-              if SearchLabel(actasmpattern,hl,false) then
-               begin
-                 Consume(AS_ID);
-                 AddLabelOperand(hl);
-                 if not (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
-                  Message(asmr_e_syntax_error);
-               end
-              else
-              { is it a normal variable ? }
-               Begin
-                 expr:=actasmpattern;
-                 Consume(AS_ID);
-                 { typecasting? }
-                 if SearchType(expr,typesize) then
+              end;
+
+            AS_ID : { A constant expression, or a Variable ref. }
+              Begin
+                { Label or Special symbol reference? }
+                if actasmpattern[1] = '@' then
+                 Begin
+                   if actasmpattern = '@RESULT' then
+                    Begin
+                      oper.SetupResult;
+                      Consume(AS_ID);
+                    end
+                   else
+                    if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then
+                     begin
+                       Message(asmr_w_CODE_and_DATA_not_supported);
+                       Consume(AS_ID);
+                     end
+                   else
+                    { Local Label }
+                    begin
+                      CreateLocalLabel(actasmpattern,hl,false);
+                      Consume(AS_ID);
+                      AddLabelOperand(hl);
+                      if not (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
+                       Message(asmr_e_syntax_error);
+                    end;
+                 end
+                else
+                { support result for delphi modes }
+                 if (m_objpas in aktmodeswitches) and (actasmpattern='RESULT') then
                   begin
-                    hastype:=true;
-                    if (actasmtoken=AS_LPAREN) then
-                      begin
-                        Consume(AS_LPAREN);
-                        BuildOperand;
-                        Consume(AS_RPAREN);
-                        if opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                          SetSize(typesize,true);
-                      end;
+                    oper.SetUpResult;
+                    Consume(AS_ID);
                   end
-                 else
-                  begin
-                    if not SetupVar(expr,false) then
-                      Begin
-                        { not a variable, check special variables.. }
-                        if expr = 'SELF' then
-                          SetupSelf
+                { probably a variable or normal expression }
+                { or a procedure (such as in CALL ID)      }
+                else
+                 Begin
+                   { is it a constant ? }
+                   if SearchIConstant(actasmpattern,l) then
+                    Begin
+                      case oper.opr.typ of
+                        OPR_REFERENCE :
+                          inc(oper.opr.ref.offset,BuildRefConstExpression);
+                        OPR_LOCAL :
+                          inc(oper.opr.localsymofs,BuildRefConstExpression);
+                        OPR_NONE,
+                        OPR_CONSTANT :
+                          BuildConstantOperand(oper);
                         else
-                          Message1(sym_e_unknown_id,expr);
-                        expr:='';
+                          Message(asmr_e_invalid_operand_type);
                       end;
-                   end;
-               end;
-           end;
-        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);
-             InitRef;
-             opr.ref.segment:=tempreg;
-             BuildReference;
-           end
-          else
-          { Simple register }
-           begin
-             if not (opr.typ in [OPR_NONE,OPR_REGISTER]) then
-              Message(asmr_e_invalid_operand_type);
-             opr.typ:=OPR_REGISTER;
-             opr.reg:=tempreg;
-             SetSize(tcgsize2size[cg.reg_cgsize(opr.reg)],true);
-           end;
-        end;
-
-      AS_LBRACKET: { a variable reference, register ref. or a constant reference }
-        Begin
-          BuildReference;
-        end;
-
-      AS_SEG :
-        Begin
-          Message(asmr_e_seg_not_supported);
-          Consume(actasmtoken);
-        end;
+                    end
+                   else
+                    { Check for pascal label }
+                    if SearchLabel(actasmpattern,hl,false) then
+                     begin
+                       Consume(AS_ID);
+                       AddLabelOperand(hl);
+                       if not (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
+                        Message(asmr_e_syntax_error);
+                     end
+                    else
+                    { is it a normal variable ? }
+                     Begin
+                       expr:=actasmpattern;
+                       Consume(AS_ID);
+                       { typecasting? }
+                       if SearchType(expr,typesize) then
+                        begin
+                          oper.hastype:=true;
+                          if (actasmtoken=AS_LPAREN) then
+                            begin
+                              Consume(AS_LPAREN);
+                              BuildOperand(oper);
+                              Consume(AS_RPAREN);
+                              if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
+                                oper.SetSize(typesize,true);
+                            end;
+                        end
+                       else
+                        begin
+                          if not oper.SetupVar(expr,false) then
+                            Begin
+                              { not a variable, check special variables.. }
+                              if expr = 'SELF' then
+                                oper.SetupSelf
+                              else
+                                Message1(sym_e_unknown_id,expr);
+                              expr:='';
+                            end;
+                         end;
+                     end;
+                 end;
+              end;
 
-      AS_SEPARATOR,
-      AS_END,
-      AS_COMMA:
-        break;
+            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;
+                   BuildReference(oper);
+                 end
+                else
+                { Simple register }
+                 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;
+              end;
 
-      else
-        Message(asmr_e_syn_operand);
-    end;
-  until not(actasmtoken in [AS_DOT,AS_PLUS,AS_LBRACKET]);
-  if not((actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) or
-         (hastype and (actasmtoken=AS_RPAREN))) then
-   begin
-     Message(asmr_e_syntax_error);
-     RecoverConsume(true);
-   end;
-end;
+            AS_LBRACKET: { a variable reference, register ref. or a constant reference }
+              Begin
+                BuildReference(oper);
+              end;
 
+            AS_SEG :
+              Begin
+                Message(asmr_e_seg_not_supported);
+                Consume(actasmtoken);
+              end;
 
-{*****************************************************************************
-                                T386IntelInstruction
-*****************************************************************************}
+            AS_SEPARATOR,
+            AS_END,
+            AS_COMMA:
+              break;
 
-type
-  T386IntelInstruction=class(T386Instruction)
-    procedure InitOperands;override;
-    procedure BuildOpcode;override;
-  end;
+            else
+              Message(asmr_e_syn_operand);
+          end;
+        until not(actasmtoken in [AS_DOT,AS_PLUS,AS_LBRACKET]);
+        if not((actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) or
+               (oper.hastype and (actasmtoken=AS_RPAREN))) then
+         begin
+           Message(asmr_e_syntax_error);
+           RecoverConsume(true);
+         end;
+      end;
 
-procedure T386IntelInstruction.InitOperands;
-var
-  i : longint;
-begin
-  for i:=1 to 3 do
-   Operands[i]:=T386IntelOperand.Create;
-end;
-
-
-Procedure T386IntelInstruction.BuildOpCode;
-var
-  PrefixOp,OverrideOp: tasmop;
-  size,
-  operandnum : longint;
-Begin
-  PrefixOp:=A_None;
-  OverrideOp:=A_None;
-  { prefix seg opcode / prefix opcode }
-  repeat
-    if is_prefix(actopcode) then
-     begin
-       OpOrder:=op_intel;
-       PrefixOp:=ActOpcode;
-       opcode:=ActOpcode;
-       condition:=ActCondition;
-       opsize:=ActOpsize;
-       ConcatInstruction(curlist);
-       Consume(AS_OPCODE);
-     end
-    else
-     if is_override(actopcode) then
-      begin
-        OpOrder:=op_intel;
-        OverrideOp:=ActOpcode;
-        opcode:=ActOpcode;
-        condition:=ActCondition;
-        opsize:=ActOpsize;
-        ConcatInstruction(curlist);
-        Consume(AS_OPCODE);
-      end
-    else
-     break;
-    { allow for newline after prefix or override }
-    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(false);
-     exit;
-   end;
-  { Fill the instr object with the current state }
-  OpOrder:=op_intel;
-  Opcode:=ActOpcode;
-  condition:=ActCondition;
-  opsize:=ActOpsize;
-  { 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 Operands }
-  repeat
-    case actasmtoken of
-
-      { End of asm operands for this opcode }
-      AS_END,
-      AS_SEPARATOR :
-        break;
-
-      { Operand delimiter }
-      AS_COMMA :
-        Begin
-          if operandnum > Max_Operands then
-            Message(asmr_e_too_many_operands)
-          else
-            Inc(operandnum);
-          Consume(AS_COMMA);
-        end;
 
-      { Typecast, Constant Expression, Type Specifier }
-      AS_DWORD,
-      AS_BYTE,
-      AS_WORD,
-      AS_TBYTE,
-      AS_QWORD :
-        Begin
-          { load the size in a temp variable, so it can be set when the
-            operand is read }
-          size:=0;
-          Case actasmtoken of
-            AS_DWORD : size:=4;
-            AS_WORD  : size:=2;
-            AS_BYTE  : size:=1;
-            AS_QWORD : size:=8;
-            AS_TBYTE : size:=extended_size;
-          end;
-          Consume(actasmtoken);
-          if actasmtoken=AS_PTR then
+    Procedure ti386intreader.BuildOpCode(instr : t386instruction);
+      var
+        PrefixOp,OverrideOp: tasmop;
+        size,
+        operandnum : longint;
+      Begin
+        PrefixOp:=A_None;
+        OverrideOp:=A_None;
+        { prefix seg opcode / prefix opcode }
+        repeat
+          if is_prefix(actopcode) then
            begin
-             Consume(AS_PTR);
-             Operands[operandnum].InitRef;
-           end;
-          Operands[operandnum].BuildOperand;
-          { now set the size which was specified by the override }
-          Operands[operandnum].setsize(size,true);
-        end;
-
-      { Type specifier }
-      AS_NEAR,
-      AS_FAR :
-        Begin
-          if actasmtoken = AS_NEAR then
+             with instr do
+               begin
+                 OpOrder:=op_intel;
+                 PrefixOp:=ActOpcode;
+                 opcode:=ActOpcode;
+                 condition:=ActCondition;
+                 opsize:=ActOpsize;
+                 ConcatInstruction(curlist);
+               end;
+             Consume(AS_OPCODE);
+           end
+          else
+           if is_override(actopcode) then
             begin
-              Message(asmr_w_near_ignored);
-              opsize:=S_NEAR;
+              with instr do
+                begin
+                  OpOrder:=op_intel;
+                  OverrideOp:=ActOpcode;
+                  opcode:=ActOpcode;
+                  condition:=ActCondition;
+                  opsize:=ActOpsize;
+                  ConcatInstruction(curlist);
+                end;
+              Consume(AS_OPCODE);
             end
           else
-            begin
-              Message(asmr_w_far_ignored);
-              opsize:=S_FAR;
-            end;
-          Consume(actasmtoken);
-          if actasmtoken=AS_PTR then
-           begin
-             Consume(AS_PTR);
-             Operands[operandnum].InitRef;
-           end;
-          Operands[operandnum].BuildOperand;
-        end;
+           break;
+          { allow for newline after prefix or override }
+          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(false);
+           exit;
+         end;
+        { Fill the instr object with the current state }
+        with instr do
+          begin
+            OpOrder:=op_intel;
+            Opcode:=ActOpcode;
+            condition:=ActCondition;
+            opsize:=ActOpsize;
+
+            { 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);
+          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 Operands }
+        repeat
+          case actasmtoken of
 
-      else
-        Operands[operandnum].BuildOperand;
-    end; { end case }
-  until false;
-  Ops:=operandnum;
-end;
-
-
-Procedure BuildConstant(maxvalue: longint);
-var
- strlength: byte;
- asmsym,
- expr: string;
- value : longint;
-Begin
-  strlength:=0; { assume it is a DB }
-  Repeat
-    Case actasmtoken of
-      AS_STRING:
-        Begin
-          if maxvalue = $ffff then
-            strlength:=2
-          else
-            if maxvalue = longint($ffffffff) then
-              strlength:=4;
-          { DD and DW cases }
-          if strlength <> 0 then
-           Begin
-             if Not PadZero(actasmpattern,strlength) then
-              Message(scan_f_string_exceeds_line);
-           end;
-          expr:=actasmpattern;
-          Consume(AS_STRING);
+            { End of asm operands for this opcode }
+            AS_END,
+            AS_SEPARATOR :
+              break;
+
+            { Operand delimiter }
+            AS_COMMA :
+              Begin
+                if operandnum > Max_Operands then
+                  Message(asmr_e_too_many_operands)
+                else
+                  Inc(operandnum);
+                Consume(AS_COMMA);
+              end;
+
+            { Typecast, Constant Expression, Type Specifier }
+            AS_DWORD,
+            AS_BYTE,
+            AS_WORD,
+            AS_TBYTE,
+            AS_QWORD :
+              Begin
+                { load the size in a temp variable, so it can be set when the
+                  operand is read }
+                size:=0;
+                Case actasmtoken of
+                  AS_DWORD : size:=4;
+                  AS_WORD  : size:=2;
+                  AS_BYTE  : size:=1;
+                  AS_QWORD : size:=8;
+                  AS_TBYTE : size:=extended_size;
+                end;
+                Consume(actasmtoken);
+                if actasmtoken=AS_PTR then
+                 begin
+                   Consume(AS_PTR);
+                   instr.Operands[operandnum].InitRef;
+                 end;
+                BuildOperand(instr.Operands[operandnum] as t386operand);
+                { now set the size which was specified by the override }
+                instr.Operands[operandnum].setsize(size,true);
+              end;
+
+            { Type specifier }
+            AS_NEAR,
+            AS_FAR :
+              Begin
+                if actasmtoken = AS_NEAR then
+                  begin
+                    Message(asmr_w_near_ignored);
+                    instr.opsize:=S_NEAR;
+                  end
+                else
+                  begin
+                    Message(asmr_w_far_ignored);
+                    instr.opsize:=S_FAR;
+                  end;
+                Consume(actasmtoken);
+                if actasmtoken=AS_PTR then
+                 begin
+                   Consume(AS_PTR);
+                   instr.Operands[operandnum].InitRef;
+                 end;
+                BuildOperand(instr.Operands[operandnum] as t386operand);
+              end;
+            else
+              BuildOperand(instr.Operands[operandnum] as t386operand);
+          end; { end case }
+        until false;
+        instr.Ops:=operandnum;
+      end;
+
+
+    Procedure ti386intreader.BuildConstant(maxvalue: longint);
+      var
+       strlength: byte;
+       asmsym,
+       expr: string;
+       value : longint;
+      Begin
+        strlength:=0; { assume it is a DB }
+        Repeat
           Case actasmtoken of
+            AS_STRING:
+              Begin
+                if maxvalue = $ffff then
+                  strlength:=2
+                else
+                  if maxvalue = longint($ffffffff) then
+                    strlength:=4;
+                { DD and DW cases }
+                if strlength <> 0 then
+                 Begin
+                   if Not PadZero(actasmpattern,strlength) then
+                    Message(scan_f_string_exceeds_line);
+                 end;
+                expr:=actasmpattern;
+                Consume(AS_STRING);
+                Case actasmtoken of
+                  AS_COMMA:
+                    Consume(AS_COMMA);
+                  AS_END,
+                  AS_SEPARATOR: ;
+                  else
+                    Message(asmr_e_invalid_string_expression);
+                end;
+                ConcatString(curlist,expr);
+              end;
+            AS_PLUS,
+            AS_MINUS,
+            AS_LPAREN,
+            AS_NOT,
+            AS_INTNUM,
+            AS_ID :
+              Begin
+                BuildConstSymbolExpression(false,false,value,asmsym);
+                if asmsym<>'' then
+                 begin
+                   if maxvalue<>longint($ffffffff) then
+                     Message1(asmr_w_const32bit_for_address,asmsym);
+                   ConcatConstSymbol(curlist,asmsym,value)
+                 end
+                else
+                 ConcatConstant(curlist,value,maxvalue);
+              end;
             AS_COMMA:
               Consume(AS_COMMA);
             AS_END,
-            AS_SEPARATOR: ;
+            AS_SEPARATOR:
+              break;
             else
-              Message(asmr_e_invalid_string_expression);
+              begin
+                Message(asmr_e_syn_constant);
+                RecoverConsume(false);
+              end
           end;
-          ConcatString(curlist,expr);
-        end;
-      AS_PLUS,
-      AS_MINUS,
-      AS_LPAREN,
-      AS_NOT,
-      AS_INTNUM,
-      AS_ID :
-        Begin
-          BuildConstSymbolExpression(false,false,value,asmsym);
-          if asmsym<>'' then
-           begin
-             if maxvalue<>longint($ffffffff) then
-               Message1(asmr_w_const32bit_for_address,asmsym);
-             ConcatConstSymbol(curlist,asmsym,value)
-           end
-          else
-           ConcatConstant(curlist,value,maxvalue);
-        end;
-      AS_COMMA:
-        Consume(AS_COMMA);
-      AS_END,
-      AS_SEPARATOR:
-        break;
-      else
-        begin
-          Message(asmr_e_syn_constant);
-          RecoverConsume(false);
-        end
-    end;
-  Until false;
-end;
-
-
-Function Assemble: tnode;
-Var
-  hl : tasmlabel;
-  instr : T386IntelInstruction;
-Begin
-  Message1(asmr_d_start_reading,'intel');
-  inexpression:=FALSE;
-  firsttoken:=TRUE;
- { sets up all opcode and register tables in uppercase }
-  if not _asmsorted then
-   Begin
-     SetupTables;
-     _asmsorted:=TRUE;
-   end;
-  curlist:=TAAsmoutput.Create;
-  { setup label linked list }
-  LocalLabelList:=TLocalLabelList.Create;
-  { start tokenizer }
-  c:=current_scanner.asmgetcharstart;
-  gettoken;
-  { main loop }
-  repeat
-    case actasmtoken of
-      AS_LLABEL:
-        Begin
-          if CreateLocalLabel(actasmpattern,hl,true) then
-            ConcatLabel(curlist,hl);
-          Consume(AS_LLABEL);
-        end;
+        Until false;
+      end;
 
-      AS_LABEL:
-        Begin
-          if SearchLabel(upper(actasmpattern),hl,true) then
-           ConcatLabel(curlist,hl)
-          else
-           Message1(asmr_e_unknown_label_identifier,actasmpattern);
-          Consume(AS_LABEL);
-        end;
 
-      AS_DW :
-        Begin
-          inexpression:=true;
-          Consume(AS_DW);
-          BuildConstant($ffff);
-          inexpression:=false;
-        end;
+  function ti386intreader.Assemble: tlinkedlist;
+    Var
+      hl : tasmlabel;
+      instr : T386Instruction;
+    Begin
+      Message1(asmr_d_start_reading,'intel');
+      inexpression:=FALSE;
+      firsttoken:=TRUE;
+     { sets up all opcode and register tables in uppercase
+       done in the construtor now
+      if not _asmsorted then
+       Begin
+         SetupTables;
+         _asmsorted:=TRUE;
+       end;
+      }
+      curlist:=TAAsmoutput.Create;
+      { setup label linked list }
+      LocalLabelList:=TLocalLabelList.Create;
+      { start tokenizer }
+      c:=current_scanner.asmgetcharstart;
+      gettoken;
+      { main loop }
+      repeat
+        case actasmtoken of
+          AS_LLABEL:
+            Begin
+              if CreateLocalLabel(actasmpattern,hl,true) then
+                ConcatLabel(curlist,hl);
+              Consume(AS_LLABEL);
+            end;
 
-      AS_DB :
-        Begin
-          inexpression:=true;
-          Consume(AS_DB);
-          BuildConstant($ff);
-          inexpression:=false;
-        end;
+          AS_LABEL:
+            Begin
+              if SearchLabel(upper(actasmpattern),hl,true) then
+               ConcatLabel(curlist,hl)
+              else
+               Message1(asmr_e_unknown_label_identifier,actasmpattern);
+              Consume(AS_LABEL);
+            end;
 
-      AS_DD :
-        Begin
-          inexpression:=true;
-          Consume(AS_DD);
-          BuildConstant(longint($ffffffff));
-          inexpression:=false;
-        end;
+          AS_DW :
+            Begin
+              inexpression:=true;
+              Consume(AS_DW);
+              BuildConstant($ffff);
+              inexpression:=false;
+            end;
 
-      AS_OPCODE :
-        Begin
-          instr:=T386IntelInstruction.Create;
-          instr.BuildOpcode;
-          { We need AT&T style operands }
-          instr.Swapoperands;
-          { Must be done with args in ATT order }
-          instr.CheckNonCommutativeOpcodes;
-          instr.AddReferenceSizes;
-          instr.SetInstructionOpsize;
-          instr.CheckOperandSizes;
-          instr.ConcatInstruction(curlist);
-          instr.Free;
-        end;
+          AS_DB :
+            Begin
+              inexpression:=true;
+              Consume(AS_DB);
+              BuildConstant($ff);
+              inexpression:=false;
+            end;
 
-      AS_SEPARATOR :
-        Begin
-          Consume(AS_SEPARATOR);
-        end;
+          AS_DD :
+            Begin
+              inexpression:=true;
+              Consume(AS_DD);
+              BuildConstant(longint($ffffffff));
+              inexpression:=false;
+            end;
+
+          AS_OPCODE :
+            Begin
+              instr:=T386Instruction.Create(T386Operand);
+              BuildOpcode(instr);
+              with instr do
+                begin
+                  { We need AT&T style operands }
+                  Swapoperands;
+                  { Must be done with args in ATT order }
+                  CheckNonCommutativeOpcodes;
+                  AddReferenceSizes;
+                  SetInstructionOpsize;
+                  CheckOperandSizes;
+                  ConcatInstruction(curlist);
+                end;
+              instr.Free;
+            end;
 
-      AS_END :
-        break; { end assembly block }
+          AS_SEPARATOR :
+            Begin
+              Consume(AS_SEPARATOR);
+            end;
 
-      else
-        Begin
-          Message(asmr_e_syntax_error);
-          RecoverConsume(false);
-        end;
-    end; { end case }
-  until false;
-  { Check LocalLabelList }
-  LocalLabelList.CheckEmitted;
-  LocalLabelList.Free;
-  { Return the list in an asmnode }
-  assemble:=casmnode.create(curlist);
-  Message1(asmr_d_finish_reading,'intel');
-end;
+          AS_END :
+            break; { end assembly block }
+
+          else
+            Begin
+              Message(asmr_e_syntax_error);
+              RecoverConsume(false);
+            end;
+        end; { end case }
+      until false;
+      { Check LocalLabelList }
+      LocalLabelList.CheckEmitted;
+      LocalLabelList.Free;
+      { Return the list in an asmnode }
+      assemble:=curlist;
+      Message1(asmr_d_finish_reading,'intel');
+    end;
 
 
 {*****************************************************************************
-                                     Initialize
+                               Initialize
 *****************************************************************************}
 
 const
   asmmode_i386_intel_info : tasmmodeinfo =
           (
             id    : asmmode_i386_intel;
-            idtxt : 'INTEL'
+            idtxt : 'INTEL';
+            casmreader : ti386intreader;
           );
 
-initialization
+begin
   RegisterAsmMode(asmmode_i386_intel_info);
-
-finalization
-  if assigned(iasmops) then
-    iasmops.Free;
-
 end.
 {
   $Log$
-  Revision 1.64  2003-11-10 19:08:32  peter
+  Revision 1.65  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.64  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
 

compiler/msg/errore.msg

@@ -257,7 +257,7 @@ scan_n_only_exe_version=02048_N_VERSION only for exes or DLLs
 scan_w_wrong_version_ignored=02049_W_Wrong format for VERSION directive "$1"
 % The \var{\{\$VERSION\}} directive format is majorversion.minorversion
 % where majorversion and minorversion are words.
-scan_w_unsupported_asmmode_specifier=02050_W_Unsupported assembler style specified "$1"
+scan_e_illegal_asmmode_specifier=02050_E_Illegal assembler style specified "$1"
 % When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}}
 % the compiler didn't recognize the mode you specified.
 scan_w_no_asm_reader_switch_inside_asm=02051_W_ASM reader switch is not possible inside asm statement, "$1" will be effective only for next

compiler/msgidx.inc

@@ -63,7 +63,7 @@ const
   scan_n_version_not_support=02047;
   scan_n_only_exe_version=02048;
   scan_w_wrong_version_ignored=02049;
-  scan_w_unsupported_asmmode_specifier=02050;
+  scan_e_illegal_asmmode_specifier=02050;
   scan_w_no_asm_reader_switch_inside_asm=02051;
   scan_e_wrong_switch_toggle=02052;
   scan_e_resourcefiles_not_supported=02053;
@@ -631,7 +631,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 35814;
+  MsgTxtSize = 35810;
 
   MsgIdxMax : array[1..20] of longint=(
     17,63,196,53,57,44,98,20,35,60,

compiler/msgtxt.inc

@@ -67,515 +67,515 @@ const msgtxt : array[0..000149,1..240] of char=(
   '02047_N_VERSION is ','not supported by target OS'#000+
   '02048_N_VERSION only for exes or DLLs'#000+
   '02049_W_Wrong format for VERSION directive "$1"'#000+
-  '02050_W_Unsupported assembler style specified "$1"'#000+
+  '02050_E_Illegal assembler style specified "$1"'#000+
   '02051_W_ASM reader switch is not possible inside asm statement, "$1" w'+
-  'ill be',' effective only for next'#000+
+  'ill be eff','ective only for next'#000+
   '02052_E_Wrong switch toggle, use ON/OFF or +/-'#000+
   '02053_E_Resource files are not supported for this target'#000+
   '02054_W_Include environment "$1" not found in environment'#000+
   '02055_E_Illegal value for FPU register limit'#000+
-  '02056_W_','Only one resource file is supported for this target'#000+
+  '02056_W_Only',' one resource file is supported for this target'#000+
   '02057_W_Macro support has been turned off'#000+
   '02058_E_Illegal interface type specified. Valids are COM, CORBA or DEF'+
   'AULT.'#000+
   '02059_W_APPID is only supported for PalmOS'#000+
-  '02060_W_APPNAME is only sup','ported for PalmOS'#000+
+  '02060_W_APPNAME is only support','ed for PalmOS'#000+
   '02061_E_Constant strings can'#039't be longer than 255 chars'#000+
   '02062_F_Including include files exceeds a depth of 16.'#000+
   '03000_E_Parser - Syntax Error'#000+
   '03004_E_INTERRUPT procedure can'#039't be nested'#000+
   '03005_W_Procedure type "$1" ignored'#000+
-  '0','3006_E_Not all declarations of "$1" are declared with OVERLOAD'#000+
+  '03006','_E_Not all declarations of "$1" are declared with OVERLOAD'#000+
   '03008_E_Duplicate exported function name "$1"'#000+
   '03009_E_Duplicate exported function index $1'#000+
   '03010_E_Invalid index for exported function'#000+
-  '03011_W_Relocatable DLL or executable $1 d','ebug info does not work, d'+
+  '03011_W_Relocatable DLL or executable $1 debug',' info does not work, d'+
   'isabled.'#000+
   '03012_W_To allow debugging for win32 code you need to disable relocati'+
   'on with -WN option'#000+
   '03013_E_Constructor name must be INIT'#000+
   '03014_E_Destructor name must be DONE'#000+
-  '03016_E_Procedure type INLINE not support','ed'#000+
-  '03018_W_Constructor should be public'#000+
+  '03016_E_Procedure type INLINE not supported'#000+
+  '0','3018_W_Constructor should be public'#000+
   '03019_W_Destructor should be public'#000+
   '03020_N_Class should have one destructor only'#000+
   '03021_E_Local class definitions are not allowed'#000+
   '03022_F_Anonym class definitions are not allowed'#000+
-  '03023_N_The object "$','1" has no VMT'#000+
+  '03023_N_The object "$1" h','as no VMT'#000+
   '03024_E_Illegal parameter list'#000+
   '03026_E_Wrong number of parameters specified'#000+
   '03027_E_overloaded identifier "$1" isn'#039't a function'#000+
   '03028_E_overloaded functions have the same parameter list'#000+
-  '03029_E_function header doesn'#039't match th','e forward declaration "$'+
+  '03029_E_function header doesn'#039't match the fo','rward declaration "$'+
   '1"'#000+
   '03030_E_function header "$1" doesn'#039't match forward : var name chan'+
   'ges $2 => $3'#000+
   '03031_N_Values in enumeration types have to be ascending'#000+
   '03033_E_With can not be used for variables in a different segment'#000+
-  '03034_E_fun','ction nesting > 31'#000+
+  '03034_E_functio','n nesting > 31'#000+
   '03035_E_range check error while evaluating constants'#000+
   '03036_W_range check error while evaluating constants'#000+
   '03037_E_duplicate case label'#000+
   '03038_E_Upper bound of case range is less than lower bound'#000+
-  '03039_E_typed constants of ','classes are not allowed'#000+
+  '03039_E_typed constants of clas','ses are not allowed'#000+
   '03040_E_functions variables of overloaded functions are not allowed'#000+
   '03041_E_string length must be a value from 1 to 255'#000+
   '03042_W_use extended syntax of NEW and DISPOSE for instances of object'+
   's'#000+
-  '03043_W_use of NEW or DI','SPOSE for untyped pointers is meaningless'#000+
+  '03043_W_use of NEW or DISPOS','E for untyped pointers is meaningless'#000+
   '03044_E_use of NEW or DISPOSE is not possible for untyped pointers'#000+
   '03045_E_class identifier expected'#000+
   '03046_E_type identifier not allowed here'#000+
   '03047_E_method identifier expected'#000+
-  '03048_E_function head','er doesn'#039't match any method of this class "'+
+  '03048_E_function header d','oesn'#039't match any method of this class "'+
   '$1"'#000+
   '03049_DL_procedure/function $1'#000+
   '03050_E_Illegal floating point constant'#000+
   '03051_E_FAIL can be used in constructors only'#000+
   '03052_E_Destructors can'#039't have parameters'#000+
-  '03053_E_Only class methods can be ','referred with class references'#000+
+  '03053_E_Only class methods can be refe','rred with class references'#000+
   '03054_E_Only class methods can be accessed in class methods'#000+
   '03055_E_Constant and CASE types do not match'#000+
   '03056_E_The symbol can'#039't be exported from a library'#000+
   '03057_W_An inherited method is hidden by "$1"'#000+
-  '03058_','E_There is no method in an ancestor class to be overridden: "$'+
+  '03058_E_Th','ere is no method in an ancestor class to be overridden: "$'+
   '1"'#000+
   '03059_E_No member is provided to access property'#000+
   '03060_W_Stored prorperty directive is not yet implemented'#000+
   '03061_E_Illegal symbol for property access'#000+
-  '03062_E_Cannot access a p','rotected field of an object here'#000+
+  '03062_E_Cannot access a prote','cted field of an object here'#000+
   '03063_E_Cannot access a private field of an object here'#000+
   '03066_E_overridden methods must have the same return type: "$2" is ove'+
   'rriden by "$1" which has another return type'#000+
-  '03067_E_EXPORT declared functions ca','n'#039't be nested'#000+
+  '03067_E_EXPORT declared functions can'#039't ','be nested'#000+
   '03068_E_methods can'#039't be EXPORTed'#000+
   '03069_E_call by var parameters have to match exactly: Got "$1" expecte'+
   'd "$2"'#000+
   '03070_E_Class isn'#039't a parent class of the current class'#000+
   '03071_E_SELF is only allowed in methods'#000+
-  '03072_E_methods can',' be only in other methods called direct with type'+
+  '03072_E_methods can be ','only in other methods called direct with type'+
   ' identifier of the class'#000+
   '03073_E_Illegal use of '#039':'#039#000+
   '03074_E_range check error in set constructor or duplicate set element'#000+
   '03075_E_Pointer to object expected'#000+
-  '03076_E_Expression must be constru','ctor call'#000+
+  '03076_E_Expression must be constructor',' call'#000+
   '03077_E_Expression must be destructor call'#000+
   '03078_E_Illegal order of record elements'#000+
   '03079_E_Expression type must be class or record type'#000+
   '03080_E_Procedures can'#039't return a value'#000+
-  '03081_E_constructors and destructors must be methods'#000,
-  '03082_E_Operator is not overloaded'#000+
+  '03081_E_constructors and destructors must be methods'#000+
+  '0308','2_E_Operator is not overloaded'#000+
   '03083_E_Impossible to overload assignment for equal types'#000+
   '03084_E_Impossible operator overload'#000+
   '03085_E_Re-raise isn'#039't possible there'#000+
   '03086_E_The extended syntax of new or dispose isn'#039't allowed for a '+
-  'class'#000,
-  '03088_E_Procedure overloading is switched off'#000+
+  'class'#000+
+  '0308','8_E_Procedure overloading is switched off'#000+
   '03089_E_It is not possible to overload this operator (overload = inste'+
   'ad)'#000+
   '03090_E_Comparative operator must return a boolean value'#000+
   '03091_E_Only virtual methods can be abstract'#000+
-  '03092_F_Use of uns','upported feature!'#000+
+  '03092_F_Use of unsuppo','rted feature!'#000+
   '03093_E_The mix of different kind of objects (class, object, interface'+
   ', etc) isn'#039't allowed'#000+
   '03094_W_Unknown procedure directive had to be ignored: "$1"'#000+
   '03095_E_absolute can only be associated to one variable'#000+
-  '03096_E_absolut','e can only be associated with a var or const'#000+
+  '03096_E_absolute ca','n only be associated with a var or const'#000+
   '03097_E_Only one variable can be initialized'#000+
   '03098_E_Abstract methods shouldn'#039't have any definition (with funct'+
   'ion body)'#000+
   '03099_E_This overloaded function can'#039't be local (must be exported)'+
   #000+
-  '03100_W','_Virtual methods are used without a constructor in "$1"'#000+
+  '03100_W_Vir','tual methods are used without a constructor in "$1"'#000+
   '03101_CL_Macro defined: $1'#000+
   '03102_CL_Macro undefined: $1'#000+
   '03103_CL_Macro $1 set to $2'#000+
   '03104_I_Compiling $1'#000+
   '03105_UL_Parsing interface of unit $1'#000+
   '03106_UL_Parsing implementation of $1'#000+
-  '031','07_DL_Compiling $1 for the second time'#000+
+  '03107_D','L_Compiling $1 for the second time'#000+
   '03109_E_No property found to override'#000+
   '03110_E_Only one default property is allowed, found inherited default '+
   'property in class "$1"'#000+
   '03111_E_The default property must be an array property'#000+
-  '03112_E_Virtual',' constructors are only supported in class object mode'+
+  '03112_E_Virtual con','structors are only supported in class object mode'+
   'l'#000+
   '03113_E_No default property available'#000+
   '03114_E_The class can'#039't have a published section, use the {$M+} sw'+
   'itch'#000+
   '03115_E_Forward declaration of class "$1" must be resolved here to use'+
-  ' the c','lass as ancestor'#000+
+  ' the class',' as ancestor'#000+
   '03116_E_Local operators not supported'#000+
   '03117_E_Procedure directive "$1" not allowed in interface section'#000+
   '03118_E_Procedure directive "$1" not allowed in implementation section'+
   #000+
-  '03119_E_Procedure directive "$1" not allowed in ','procvar declaration'#000+
+  '03119_E_Procedure directive "$1" not allowed in proc','var declaration'#000+
   '03120_E_Function is already declared Public/Forward "$1"'#000+
   '03121_E_Can'#039't use both EXPORT and EXTERNAL'#000+
   '03123_W_"$1" not yet supported inside inline procedure/function'#000+
   '03124_W_Inlining disabled'#000+
-  '03125_I_Writing Browser log $1',#000+
-  '03126_H_may be pointer dereference is missing'#000+
+  '03125_I_Writing Browser log $1'#000+
+  '031','26_H_may be pointer dereference is missing'#000+
   '03127_F_Selected assembler reader not supported'#000+
   '03128_E_Procedure directive "$1" has conflicts with other directives'#000+
   '03129_E_Calling convention doesn'#039't match forward'#000+
-  '03131_E_Property can'#039't have',' a default value'#000+
+  '03131_E_Property can'#039't have a d','efault value'#000+
   '03132_E_The default value of a property must be constant'#000+
   '03133_E_Symbol can'#039't be published, can be only a class'#000+
   '03134_E_That kind of property can'#039't be published'#000+
   '03136_W_An import name is required'#000+
   '03138_E_Division by zero'#000+
-  '03','139_E_Invalid floating point operation'#000+
+  '03139_','E_Invalid floating point operation'#000+
   '03140_E_Upper bound of range is less than lower bound'#000+
   '03141_W_string "$1" is longer than "$2"'#000+
   '03142_E_string length is larger than array of char length'#000+
-  '03143_E_Illegal expression after message directiv','e'#000+
-  '03144_E_Message handlers can take only one call by ref. parameter'#000+
+  '03143_E_Illegal expression after message directive'#000+
+  '03','144_E_Message handlers can take only one call by ref. parameter'#000+
   '03145_E_Duplicate message label: "$1"'#000+
   '03146_E_Self can only be an explicit parameter in methods which are me'+
   'ssage handlers'#000+
   '03147_E_Threadvars can be only static or global'#000+
-  '0','3148_F_Direct assembler not supported for binary output format'#000+
+  '03148','_F_Direct assembler not supported for binary output format'#000+
   '03149_W_Don'#039't load OBJPAS unit manually, use {$mode objfpc} or {$m'+
   'ode delphi} instead'#000+
   '03150_E_OVERRIDE can'#039't be used in objects'#000+
-  '03151_E_Data types which require initialization/f','inalization can'#039+
+  '03151_E_Data types which require initialization/final','ization can'#039+
   't be used in variant records'#000+
   '03152_E_Resourcestrings can be only static or global'#000+
   '03153_E_Exit with argument can'#039't be used here'#000+
   '03154_E_The type of the storage symbol must be boolean'#000+
-  '03155_E_This symbol isn'#039't allowed as stor','age symbol'#000+
+  '03155_E_This symbol isn'#039't allowed as storage ','symbol'#000+
   '03156_E_Only class which are compiled in $M+ mode can be published'#000+
   '03157_E_Procedure directive expected'#000+
   '03158_E_The value for a property index must be of an ordinal type'#000+
   '03159_E_Procedure name to short to be exported'#000+
-  '03160_E_No D','EFFILE entry can be generated for unit global vars'#000+
+  '03160_E_No DEFFI','LE entry can be generated for unit global vars'#000+
   '03161_E_Compile without -WD option'#000+
   '03162_F_You need ObjFpc (-S2) or Delphi (-Sd) mode to compile this mod'+
   'ule'#000+
   '03163_E_Can'#039't export with index under $1'#000+
-  '03164_E_Exporting of variables is not s','upported under $1'#000+
+  '03164_E_Exporting of variables is not suppo','rted under $1'#000+
   '03165_E_Improper GUID syntax'#000+
   '03168_W_Procedure named "$1" not found that is suitable for implementi'+
   'ng the $2.$3'#000+
   '03169_E_interface identifier expected'#000+
   '03170_E_Type "$1" can'#039't be used as array index type'#000+
-  '03171_E_Con- and des','tructors aren'#039't allowed in interfaces'#000+
+  '03171_E_Con- and destruc','tors aren'#039't allowed in interfaces'#000+
   '03172_E_Access specifiers can'#039't be used in INTERFACES'#000+
   '03173_E_An interface can'#039't contain fields'#000+
   '03174_E_Can'#039't declare local procedure as EXTERNAL'#000+
-  '03175_W_Some fields coming before "$1" weren'#039't initializ','ed'#000+
-  '03176_E_Some fields coming before "$1" weren'#039't initialized'#000+
+  '03175_W_Some fields coming before "$1" weren'#039't initialized'#000+
+  '0','3176_E_Some fields coming before "$1" weren'#039't initialized'#000+
   '03177_W_Some fields coming after "$1" weren'#039't initialized'#000+
   '03178_E_VarArgs directive without CDecl and External'#000+
   '03179_E_Self must be a normal (call-by-value) parameter'#000+
-  '03180_E_Int','erface "$1" has no interface identification'#000+
+  '03180_E_Interfa','ce "$1" has no interface identification'#000+
   '03181_E_Unknown class field or method identifier "$1"'#000+
   '03182_W_Overriding calling convention "$1" with "$2"'#000+
   '03183_E_Typed constants of the type "procedure of object" can only be '+
-  'initialized with NI','L'#000+
-  '03184_E_Default value can only be assigned to one parameter'#000+
+  'initialized with NIL'#000+
+  '03','184_E_Default value can only be assigned to one parameter'#000+
   '03185_E_Default parameter required for "$1"'#000+
   '03186_W_Use of unsupported feature!'#000+
   '03187_H_C arrays are passed by reference'#000+
   '03188_E_C array of const must be the last argument'#000+
-  '03189_','H_Type "$1" redefinition'#000+
+  '03189_H_Ty','pe "$1" redefinition'#000+
   '03190_W_cdecl'#039'ared functions have no high parameter'#000+
   '03191_W_cdecl'#039'ared functions do not support open strings'#000+
   '03192_E_Cannot initialize variables declared as threadvar'#000+
-  '03193_E_Message directive is only allowed in Cla','sses'#000+
+  '03193_E_Message directive is only allowed in Classes',#000+
   '03194_E_Procedure or Function expected'#000+
   '03195_E_This calling convention isn'#039't supported by the current CPU'+
   ' target: "$1"'#000+
   '04000_E_Type mismatch'#000+
   '04001_E_Incompatible types: got "$1" expected "$2"'#000+
-  '04002_E_Type mismatch between "$1" and "$2"',#000+
-  '04003_E_Type identifier expected'#000+
+  '04002_E_Type mismatch between "$1" and "$2"'#000+
+  '040','03_E_Type identifier expected'#000+
   '04004_E_Variable identifier expected'#000+
   '04005_E_Integer expression expected, but got "$1"'#000+
   '04006_E_Boolean expression expected, but got "$1"'#000+
   '04007_E_Ordinal expression expected'#000+
-  '04008_E_pointer type expected, bu','t got "$1"'#000+
+  '04008_E_pointer type expected, but go','t "$1"'#000+
   '04009_E_class type expected, but got "$1"'#000+
   '04011_E_Can'#039't evaluate constant expression'#000+
   '04012_E_Set elements are not compatible'#000+
   '04013_E_Operation not implemented for sets'#000+
-  '04014_W_Automatic type conversion from floating type to COMP ','which i'+
+  '04014_W_Automatic type conversion from floating type to COMP whic','h i'+
   's an integer type'#000+
   '04015_H_use DIV instead to get an integer result'#000+
   '04016_E_string types doesn'#039't match, because of $V+ mode'#000+
   '04017_E_succ or pred on enums with assignments not possible'#000+
-  '04018_E_Can'#039't read or write variables of this type',#000+
-  '04019_E_Can'#039't use readln or writeln on typed file'#000+
+  '04018_E_Can'#039't read or write variables of this type'#000+
+  '040','19_E_Can'#039't use readln or writeln on typed file'#000+
   '04020_E_Can'#039't use read or write on untyped file.'#000+
   '04021_E_Type conflict between set elements'#000+
   '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+
-  '04023_E_Integer or real expression ','expected'#000+
+  '04023_E_Integer or real expression expe','cted'#000+
   '04024_E_Wrong type "$1" in array constructor'#000+
   '04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+
   '04026_E_Method (variable) and Procedure (variable) are not compatible'#000+
-  '04027_E_Illegal constant passed to internal math f','unction'#000+
+  '04027_E_Illegal constant passed to internal math funct','ion'#000+
   '04028_E_Can'#039't get the address of constants'#000+
   '04029_E_Argument can'#039't be assigned to'#000+
   '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
   'e'#000+
   '04031_E_Can'#039't assign values to an address'#000+
-  '04032_E_Can'#039't assign values to const vari','able'#000+
+  '04032_E_Can'#039't assign values to const variable',#000+
   '04033_E_Array type required'#000+
   '04034_E_interface type expected, but got "$1"'#000+
   '04035_W_Mixing signed expressions and longwords gives a 64bit result'#000+
   '04036_W_Mixing signed expressions and cardinals here may cause a range'+
   ' check error'#000+
-  '04037_E_T','ypecast has different size ($1 -> $2) in assignment'#000+
+  '04037_E_Typec','ast has different size ($1 -> $2) in assignment'#000+
   '04038_E_enums with assignments can'#039't be used as array index'#000+
   '04039_E_Class or Object types "$1" and "$2" are not related'#000+
   '04040_W_Class types "$1" and "$2" are not related'#000+
-  '04041_E_Class or i','nterface type expected, but got "$1"'#000+
+  '04041_E_Class or inter','face type expected, but got "$1"'#000+
   '04042_E_Type "$1" is not completely defined'#000+
   '04043_W_String literal has more characters than short string length'#000+
   '04044_W_Comparison is always false due to range of values'#000+
-  '04045_W_Comparison is always true',' due to range of values'#000+
+  '04045_W_Comparison is always true due',' to range of values'#000+
   '04046_W_Constructing a class "$1" with abstract methods'#000+
   '04047_H_The left operand of the IN operator should be byte sized'#000+
   '04048_W_Type size mismatch, possible loss of data / range check error'#000+
-  '04049_H_Type size mismatc','h, possible loss of data / range check erro'+
+  '04049_H_Type size mismatch, p','ossible loss of data / range check erro'+
   'r'#000+
   '04050_E_The address of an abstract method can'#039't be taken'#000+
   '04051_E_The operator is not applicable for the operand type'#000+
   '04052_E_Constant Expression expected'#000+
   '05000_E_Identifier not found "$1"'#000+
-  '05001_F','_Internal Error in SymTableStack()'#000+
+  '05001_F_Int','ernal Error in SymTableStack()'#000+
   '05002_E_Duplicate identifier "$1"'#000+
   '05003_H_Identifier already defined in $1 at line $2'#000+
   '05004_E_Unknown identifier "$1"'#000+
   '05005_E_Forward declaration not solved "$1"'#000+
   '05007_E_Error in type definition'#000+
-  '05009_E_Fo','rward type not resolved "$1"'#000+
+  '05009_E_Forwar','d type not resolved "$1"'#000+
   '05010_E_Only static variables can be used in static methods or outside'+
   ' methods'#000+
   '05012_F_record or class type expected'#000+
   '05013_E_Instances of classes or objects with an abstract method are no'+
   't allowed'#000+
-  '05014_W_Label ','not defined "$1"'#000+
+  '05014_W_Label not ','defined "$1"'#000+
   '05015_E_Label used but not defined "$1"'#000+
   '05016_E_Illegal label declaration'#000+
   '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+
   '05018_E_Label not found'#000+
   '05019_E_identifier isn'#039't a label'#000+
   '05020_E_label already defined'#000+
-  '0502','1_E_illegal type declaration of set elements'#000+
+  '05021_E_','illegal type declaration of set elements'#000+
   '05022_E_Forward class definition not resolved "$1"'#000+
   '05023_H_Unit "$1" not used in $2'#000+
   '05024_H_Parameter "$1" not used'#000+
   '05025_N_Local variable "$1" not used'#000+
-  '05026_H_Value parameter "$1" is assigned b','ut never used'#000+
+  '05026_H_Value parameter "$1" is assigned but n','ever used'#000+
   '05027_N_Local variable "$1" is assigned but never used'#000+
   '05028_H_Local $1 "$2" is not used'#000+
   '05029_N_Private field "$1.$2" is never used'#000+
   '05030_N_Private field "$1.$2" is assigned but never used'#000+
-  '05031_N_Private method "$1.$2" never',' used'#000+
+  '05031_N_Private method "$1.$2" never use','d'#000+
   '05032_E_Set type expected'#000+
   '05033_W_Function result does not seem to be set'#000+
   '05034_W_Type "$1" is not aligned correctly in current record for C'#000+
   '05035_E_Unknown record field identifier "$1"'#000+
-  '05036_W_Local variable "$1" does not seem to be ','initialized'#000+
+  '05036_W_Local variable "$1" does not seem to be init','ialized'#000+
   '05037_W_Variable "$1" does not seem to be initialized'#000+
   '05038_E_identifier idents no member "$1"'#000+
   '05039_H_Found declaration: $1'#000+
   '05040_E_Data element too large'#000+
   '05042_E_No matching implementation for interface method "$1" found'#000+
-  '05043','_W_Symbol "$1" is deprecated'#000+
+  '05043_W_S','ymbol "$1" is deprecated'#000+
   '05044_W_Symbol "$1" is not portable'#000+
   '05055_W_Symbol "$1" is not implemented'#000+
   '05056_E_Can'#039't create unique type from this type'#000+
   '06000_E_BREAK not allowed'#000+
   '06001_E_CONTINUE not allowed'#000+
-  '06002_E_Expression too complicate','d - FPU stack overflow'#000+
+  '06002_E_Expression too complicated - ','FPU stack overflow'#000+
   '06003_E_Illegal expression'#000+
   '06004_E_Invalid integer expression'#000+
   '06005_E_Illegal qualifier'#000+
   '06006_E_High range limit < low range limit'#000+
   '06007_E_Illegal counter variable'#000+
-  '06008_E_Can'#039't determine which overloaded function to ','call'#000+
+  '06008_E_Can'#039't determine which overloaded function to call',#000+
   '06009_E_Parameter list size exceeds 65535 bytes'#000+
   '06010_E_Illegal type conversion'#000+
   '06011_H_Conversion between ordinals and pointers are not portable'#000+
   '06012_E_File types must be var parameters'#000+
-  '06013_E_The use of a far pointer isn'#039't allowed ','there'#000+
+  '06013_E_The use of a far pointer isn'#039't allowed ther','e'#000+
   '06014_E_illegal call by reference parameters'#000+
   '06015_E_EXPORT declared functions can'#039't be called'#000+
   '06016_W_Possible illegal call of constructor or destructor'#000+
   '06017_N_Inefficient code'#000+
   '06018_W_unreachable code'#000+
-  '06020_E_Abstract methods can'#039't',' be called directly'#000+
+  '06020_E_Abstract methods can'#039't be ','called directly'#000+
   '06027_DL_Register $1 weight $2 $3'#000+
   '06029_DL_Stack frame is omitted'#000+
   '06031_E_Object or class methods can'#039't be inline.'#000+
   '06032_E_Procvar calls cannot be inline.'#000+
   '06033_E_No code for inline procedure stored'#000+
-  '06035_E_Element zero ','of an ansi/wide- or longstring can'#039't be acc'+
+  '06035_E_Element zero of a','n ansi/wide- or longstring can'#039't be acc'+
   'essed, use (set)length instead'#000+
   '06037_E_Constructors or destructors can not be called inside a '#039'wi'+
   'th'#039' clause'#000+
   '06038_E_Cannot call message handler methods directly'#000+
-  '06039_E_Jump in or outside of an exc','eption block'#000+
+  '06039_E_Jump in or outside of an excepti','on block'#000+
   '06040_E_Control flow statements aren'#039't allowed in a finally block'#000+
   '06041_W_Parameters size exceeds limit for certain cpu'#039's'#000+
   '06042_W_Local variable size exceed limit for certain cpu'#039's'#000+
-  '06043_E_Local variables size exceeds supported',' limit'#000+
+  '06043_E_Local variables size exceeds supported lim','it'#000+
   '07000_DL_Starting $1 styled assembler parsing'#000+
   '07001_DL_Finished $1 styled assembler parsing'#000+
   '07002_E_Non-label pattern contains @'#000+
   '07004_E_Error building record offset'#000+
   '07005_E_OFFSET used without identifier'#000+
-  '07006_E_TYPE used without id','entifier'#000+
+  '07006_E_TYPE used without identi','fier'#000+
   '07007_E_Cannot use local variable or parameters here'#000+
   '07008_E_need to use OFFSET here'#000+
   '07009_E_need to use $ here'#000+
   '07010_E_Cannot use multiple relocatable symbols'#000+
   '07011_E_Relocatable symbol can only be added'#000+
-  '07012_E_Invalid constant e','xpression'#000+
+  '07012_E_Invalid constant expre','ssion'#000+
   '07013_E_Relocatable symbol is not allowed'#000+
   '07014_E_Invalid reference syntax'#000+
   '07015_E_You can not reach $1 from that code'#000+
   '07016_E_Local symbols/labels aren'#039't allowed as references'#000+
   '07017_E_Invalid base and index register usage'#000+
-  '07018_W','_Possible error in object field handling'#000+
+  '07018_W_Pos','sible error in object field handling'#000+
   '07019_E_Wrong scale factor specified'#000+
   '07020_E_Multiple index register usage'#000+
   '07021_E_Invalid operand type'#000+
   '07022_E_Invalid string as opcode operand: $1'#000+
   '07023_W_@CODE and @DATA not supported'#000+
-  '07024_E_Null',' label references are not allowed'#000+
+  '07024_E_Null lab','el references are not allowed'#000+
   '07025_E_Divide by zero in asm evaluator'#000+
   '07026_E_Illegal expression'#000+
   '07027_E_escape sequence ignored: $1'#000+
   '07028_E_Invalid symbol reference'#000+
   '07029_W_Fwait can cause emulation problems with emu387'#000+
-  '07030_W_$1 with','out operand translated into $1P'#000+
+  '07030_W_$1 without ','operand translated into $1P'#000+
   '07031_W_ENTER instruction is not supported by Linux kernel'#000+
   '07032_W_Calling an overload function in assembler'#000+
   '07033_E_Unsupported symbol type for operand'#000+
   '07034_E_Constant value out of bounds'#000+
-  '07035_E_Error conv','erting decimal $1'#000+
+  '07035_E_Error converti','ng decimal $1'#000+
   '07036_E_Error converting octal $1'#000+
   '07037_E_Error converting binary $1'#000+
   '07038_E_Error converting hexadecimal $1'#000+
   '07039_H_$1 translated to $2'#000+
   '07040_W_$1 is associated to an overloaded function'#000+
-  '07041_E_Cannot use SELF outside a ','method'#000+
+  '07041_E_Cannot use SELF outside a meth','od'#000+
   '07042_E_Cannot use OLDEBP outside a nested procedure'#000+
   '07043_W_Procedures can'#039't return any value in asm code'#000+
   '07044_E_SEG not supported'#000+
   '07045_E_Size suffix and destination or source size do not match'#000+
-  '07046_W_Size suffix and destination ','or source size do not match'#000+
+  '07046_W_Size suffix and destination or s','ource size do not match'#000+
   '07047_E_Assembler syntax error'#000+
   '07048_E_Invalid combination of opcode and operands'#000+
   '07049_E_Assembler syntax error in operand'#000+
   '07050_E_Assembler syntax error in constant'#000+
   '07051_E_Invalid String expression'#000+
-  '07052_W_con','stant with symbol $1 for address which is not on a pointe'+
+  '07052_W_constan','t with symbol $1 for address which is not on a pointe'+
   'r'#000+
   '07053_E_Unrecognized opcode $1'#000+
   '07054_E_Invalid or missing opcode'#000+
   '07055_E_Invalid combination of prefix and opcode: $1'#000+
   '07056_E_Invalid combination of override and opcode: $1'#000+
-  '07057_E_','Too many operands on line'#000+
+  '07057_E_Too ','many operands on line'#000+
   '07058_W_NEAR ignored'#000+
   '07059_W_FAR ignored'#000+
   '07060_E_Duplicate local symbol $1'#000+
   '07061_E_Undefined local symbol $1'#000+
   '07062_E_Unknown label identifier $1'#000+
   '07063_E_Invalid register name'#000+
-  '07064_E_Invalid floating point register',' name'#000+
+  '07064_E_Invalid floating point register nam','e'#000+
   '07066_W_Modulo not supported'#000+
   '07067_E_Invalid floating point constant $1'#000+
   '07068_E_Invalid floating point expression'#000+
   '07069_E_Wrong symbol type'#000+
   '07070_E_Cannot index a local var or parameter with a register'#000+
-  '07071_E_Invalid segment override',' expression'#000+
+  '07071_E_Invalid segment override exp','ression'#000+
   '07072_W_Identifier $1 supposed external'#000+
   '07073_E_Strings not allowed as constants'#000+
   '07074_No type of variable specified'#000+
   '07075_E_assembler code not returned to text section'#000+
   '07076_E_Not a directive or local symbol $1'#000+
-  '07077_E_Using a ','defined name as a local label'#000+
+  '07077_E_Using a defi','ned name as a local label'#000+
   '07078_E_Dollar token is used without an identifier'#000+
   '07079_W_32bit constant created for address'#000+
   '07080_N_.align is target specific, use .balign or .p2align'#000+
   '07081_E_Can'#039't access fields directly for parameters'#000+
-  '07082','_E_Can'#039't access fields of objects/classes directly'#000+
+  '07082_E_C','an'#039't access fields of objects/classes directly'#000+
   '07083_E_No size specified and unable to determine the size of the oper'+
   'ands'#000+
   '07084_E_Cannot use RESULT in this function'#000+
   '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+
-  '07087_W_"$','1 %st(n)" translated into "$1 %st,%st(n)"'#000+
+  '07087_W_"$1 %s','t(n)" translated into "$1 %st,%st(n)"'#000+
   '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+
   '07089_E_Char < not allowed here'#000+
   '07090_E_Char > not allowed here'#000+
   '07093_W_ALIGN not supported'#000+
   '07094_E_Inc and Dec cannot be together'#000+
-  '07095_E_Invalid',' reglist for movem'#000+
+  '07095_E_Invalid reg','list for movem'#000+
   '07096_E_Reglist invalid for opcode'#000+
   '07097_E_Higher cpu mode required ($1)'#000+
   '08000_F_Too many assembler files'#000+
   '08001_F_Selected assembler output not supported'#000+
   '08002_F_Comp not supported'#000+
-  '08003_F_Direct not support for binary wr','iters'#000+
+  '08003_F_Direct not support for binary writer','s'#000+
   '08004_E_Allocating of data is only allowed in bss section'#000+
   '08005_F_No binary writer selected'#000+
   '08006_E_Asm: Opcode $1 not in table'#000+
   '08007_E_Asm: $1 invalid combination of opcode and operands'#000+
   '08008_E_Asm: 16 Bit references not supported'#000+
-  '08','009_E_Asm: Invalid effective address'#000+
+  '08009_','E_Asm: Invalid effective address'#000+
   '08010_E_Asm: Immediate or reference expected'#000+
   '08011_E_Asm: $1 value exceeds bounds $2'#000+
   '08012_E_Asm: Short jump is out of range $1'#000+
   '08013_E_Asm: Undefined label $1'#000+
-  '08014_E_Asm: Comp type not supported for th','is target'#000+
+  '08014_E_Asm: Comp type not supported for this t','arget'#000+
   '08015_E_Asm: Extended type not supported for this target'#000+
   '08016_E_Asm: Duplicate label $1'#000+
   '08017_E_Asm: Redefined label $1'#000+
   '08018_E_Asm: First defined here'#000+
   '08019_E_Asm: Invalid register $1'#000+
   '09000_W_Source operating system redefined'#000+
-  '09','001_I_Assembling (pipe) $1'#000+
+  '09001_','I_Assembling (pipe) $1'#000+
   '09002_E_Can'#039't create assember file: $1'#000+
   '09003_E_Can'#039't create object file: $1'#000+
   '09004_E_Can'#039't create archive file: $1'#000+
   '09005_E_Assembler $1 not found, switching to external assembling'#000+
   '09006_T_Using assembler: $1'#000+
-  '09007_','E_Error while assembling exitcode $1'#000+
+  '09007_E_Er','ror while assembling exitcode $1'#000+
   '09008_E_Can'#039't call the assembler, error $1 switching to external a'+
   'ssembling'#000+
   '09009_I_Assembling $1'#000+
   '09010_I_Assembling with smartlinking $1'#000+
   '09011_W_Object $1 not found, Linking may fail !'#000+
-  '09012_W_Library $','1 not found, Linking may fail !'#000+
+  '09012_W_Library $1 no','t found, Linking may fail !'#000+
   '09013_E_Error while linking'#000+
   '09014_E_Can'#039't call the linker, switching to external linking'#000+
   '09015_I_Linking $1'#000+
   '09016_E_Util $1 not found, switching to external linking'#000+
   '09017_T_Using util $1'#000+
-  '09018_E_Creation of E','xecutables not supported'#000+
+  '09018_E_Creation of Execu','tables not supported'#000+
   '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+
   '09020_I_Closing script $1'#000+
   '09021_E_resource compiler not found, switching to external mode'#000+
   '09022_I_Compiling resource $1'#000+
-  '09023_T_unit $1 can'#039't be statically ','linked, switching to smart l'+
+  '09023_T_unit $1 can'#039't be statically link','ed, switching to smart l'+
   'inking'#000+
   '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
   #000+
   '09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+
   'g'#000+
   '09026_E_unit $1 can'#039't be smart or static linked'#000+
-  '09027_E_unit $1 can'#039't ','be shared or static linked'#000+
+  '09027_E_unit $1 can'#039't be s','hared or static linked'#000+
   '09028_F_Can'#039't post process executable $1'#000+
   '09029_F_Can'#039't open executable $1'#000+
   '09030_X_Size of Code: $1 bytes'#000+
   '09031_X_Size of initialized data: $1 bytes'#000+
   '09032_X_Size of uninitialized data: $1 bytes'#000+
-  '09033_X_Stack space ','reserved: $1 bytes'#000+
+  '09033_X_Stack space rese','rved: $1 bytes'#000+
   '09034_X_Stack space commited: $1 bytes'#000+
   '10000_T_Unitsearch: $1'#000+
   '10001_T_PPU Loading $1'#000+
@@ -584,104 +584,104 @@ const msgtxt : array[0..000149,1..240] of char=(
   '10004_U_PPU Crc: $1'#000+
   '10005_U_PPU Time: $1'#000+
   '10006_U_PPU File too short'#000+
-  '10007_U_PPU Invalid Heade','r (no PPU at the begin)'#000+
+  '10007_U_PPU Invalid Header (n','o PPU at the begin)'#000+
   '10008_U_PPU Invalid Version $1'#000+
   '10009_U_PPU is compiled for another processor'#000+
   '10010_U_PPU is compiled for an other target'#000+
   '10011_U_PPU Source: $1'#000+
   '10012_U_Writing $1'#000+
   '10013_F_Can'#039't Write PPU-File'#000+
-  '10014_F_Error reading PP','U-File'#000+
+  '10014_F_Error reading PPU-Fi','le'#000+
   '10015_F_unexpected end of PPU-File'#000+
   '10016_F_Invalid PPU-File entry: $1'#000+
   '10017_F_PPU Dbx count problem'#000+
   '10018_E_Illegal unit name: $1'#000+
   '10019_F_Too much units'#000+
   '10020_F_Circular unit reference between $1 and $2'#000+
-  '10021_F_Can'#039't compile unit $1,',' no sources available'#000+
+  '10021_F_Can'#039't compile unit $1, no ','sources available'#000+
   '10022_F_Can'#039't find unit $1'#000+
   '10023_W_Unit $1 was not found but $2 exists'#000+
   '10024_F_Unit $1 searched but $2 found'#000+
   '10025_W_Compiling the system unit requires the -Us switch'#000+
-  '10026_F_There were $1 errors compiling module, stop','ping'#000+
+  '10026_F_There were $1 errors compiling module, stopping',#000+
   '10027_U_Load from $1 ($2) unit $3'#000+
   '10028_U_Recompiling $1, checksum changed for $2'#000+
   '10029_U_Recompiling $1, source found only'#000+
   '10030_U_Recompiling unit, static lib is older than ppufile'#000+
-  '10031_U_Recompiling unit, shared lib is older than p','pufile'#000+
+  '10031_U_Recompiling unit, shared lib is older than ppufi','le'#000+
   '10032_U_Recompiling unit, obj and asm are older than ppufile'#000+
   '10033_U_Recompiling unit, obj is older than asm'#000+
   '10034_U_Parsing interface of $1'#000+
   '10035_U_Parsing implementation of $1'#000+
   '10036_U_Second load for unit $1'#000+
-  '10037_U_PPU Check file ','$1 time $2'#000+
+  '10037_U_PPU Check file $1 t','ime $2'#000+
   '10038_H_Conditional $1 was not set at startup in last compilation of $'+
   '2'#000+
   '10039_H_Conditional $1 was set at startup in last compilation of $2'#000+
   '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
-  '10041_H_File $1 is newer',' than Release PPU file $2'#000+
+  '10041_H_File $1 is newer tha','n Release PPU file $2'#000+
   '10042_U_Using a unit which was not compiled with correct FPU mode'#000+
   '10043_U_Loading interface units from $1'#000+
   '10044_U_Loading implementation units from $1'#000+
   '10045_U_Interface CRC changed for unit $1'#000+
-  '10046_U_Implementatio','n CRC changed for unit $1'#000+
+  '10046_U_Implementation CR','C changed for unit $1'#000+
   '10047_U_Finished compiling unit $1'#000+
   '10048_U_Add dependency of $1 to $2'#000+
   '10049_U_No reload, is caller: $1'#000+
   '10050_U_No reload, already in second compile: $1'#000+
   '10051_U_Flag for reload: $1'#000+
   '10052_U_Forced reloading'#000+
-  '10053_U_P','revious state of $1: $2'#000+
+  '10053_U_Previ','ous state of $1: $2'#000+
   '10054_U_Already compiling $1, setting second compile'#000+
   '10055_U_Loading unit $1'#000+
   '10056_U_Finished loading unit $1'#000+
   '10057_U_Registering new unit $1'#000+
   '10058_U_Re-resolving unit $1'#000+
-  '10059_U_Skipping re-resolving unit $1, still ','loading used units'#000+
+  '10059_U_Skipping re-resolving unit $1, still load','ing used units'#000+
   '11000_$1 [options] <inputfile> [options]'#000+
   '11001_W_Only one source file supported'#000+
   '11002_W_DEF file can be created only for OS/2'#000+
   '11003_E_nested response files are not supported'#000+
   '11004_F_No source file name in command line'#000+
-  '110','05_N_No option inside $1 config file'#000+
+  '11005_N','_No option inside $1 config file'#000+
   '11006_E_Illegal parameter: $1'#000+
   '11007_H_-? writes help pages'#000+
   '11008_F_Too many config files nested'#000+
   '11009_F_Unable to open file $1'#000+
   '11010_D_Reading further options from $1'#000+
-  '11011_W_Target is already set to: $1',#000+
-  '11012_W_Shared libs not supported on DOS platform, reverting to static'+
-  #000+
+  '11011_W_Target is already set to: $1'#000+
+  '110','12_W_Shared libs not supported on DOS platform, reverting to stat'+
+  'ic'#000+
   '11013_F_too many IF(N)DEFs'#000+
   '11014_F_too many ENDIFs'#000+
   '11015_F_open conditional at the end of the file'#000+
-  '11016_W_Debug information generation is not supported by this executa',
-  'ble'#000+
+  '11016_W_Debug information generation is not supported by this executab'+
+  'le'#000,
   '11017_H_Try recompiling with -dGDB'#000+
   '11018_E_You are using the obsolete switch $1'#000+
   '11019_E_You are using the obsolete switch $1, please use $2'#000+
   '11020_N_Switching assembler to default source writing assembler'#000+
-  '11021_W_Assembler output selecte','d "$1" is not compatible with "$2"'#000+
+  '11021_W_Assembler output selected "$','1" is not compatible with "$2"'#000+
   '11022_W_"$1" assembler use forced'#000+
   '11026_T_Reading options from file $1'#000+
   '11027_T_Reading options from environment $1'#000+
   '11028_D_Handling option "$1"'#000+
   '11029__*** press enter ***'#000+
-  '11030_H_Start of reading config fi','le $1'#000+
+  '11030_H_Start of reading config file $','1'#000+
   '11031_H_End of reading config file $1'#000+
   '11032_D_interpreting option "$1"'#000+
   '11036_D_interpreting firstpass option "$1"'#000+
   '11033_D_interpreting file option "$1"'#000+
   '11034_D_Reading config file "$1"'#000+
   '11035_D_found source file name "$1"'#000+
-  '11037_D_Defin','ing symbol $1'#000+
+  '11037_D_Defining ','symbol $1'#000+
   '11038_D_Undefining symbol $1'#000+
   '11039_E_Unknown code page'#000+
   '11023_Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#010+
   'Copyright (c) 1993-2002 by Florian Klaempfl'#000+
   '11024_Free Pascal Compiler version $FPCVER'#010+
   #010+
-  'Compiler Date ',' : $FPCDATE'#010+
+  'Compiler Date  : $','FPCDATE'#010+
   'Compiler Target: $FPCTARGET'#010+
   #010+
   'Supported targets:'#010+
@@ -691,25 +691,25 @@ const msgtxt : array[0..000149,1..240] of char=(
   'For more information read COPYING.FPC'#010+
   #010+
   'Report bugs,suggestions etc to:'#010+
-  '                 [email protected]'#000,
-  '11025_**0*_put + after a boolean switch option to enable it, - to disa'+
-  'ble it'#010+
+  '                 [email protected]'#000+
+  '1102','5_**0*_put + after a boolean switch option to enable it, - to di'+
+  'sable it'#010+
   '**1a_the compiler doesn'#039't delete the generated assembler file'#010+
   '**2al_list sourcecode lines in assembler file'#010+
-  '**2ar_list register allocation/release info in assemble','r file'#010+
+  '**2ar_list register allocation/release info in assembler fi','le'#010+
   '**2at_list temp allocation/release info in assembler file'#010+
   '**1b_generate browser info'#010+
   '**2bl_generate local symbol info'#010+
   '**1B_build all modules'#010+
   '**1C<x>_code generation options:'#010+
   '**2CD_create also dynamic library (not supported)'#010+
-  '**2Ce_Com','pilation with emulated floating point opcodes'#010+
+  '**2Ce_Compila','tion with emulated floating point opcodes'#010+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
   '**2Ci_IO-checking'#010+
   '**2Cn_omit linking stage'#010+
   '**2Co_check overflow of integer operations'#010+
   '**2Cr_range checking'#010+
-  '**2CR_verify object method call val','idity'#010+
+  '**2CR_verify object method call validit','y'#010+
   '**2Cs<n>_set stack size to <n>'#010+
   '**2Ct_stack checking'#010+
   '**2CX_create also smartlinked library'#010+
@@ -718,19 +718,19 @@ const msgtxt : array[0..000149,1..240] of char=(
   '*O2Dd<x>_set description to <x>'#010+
   '*O2Dw_PM application'#010+
   '**1e<x>_set path to executable'#010+
-  '**1E','_same as -Cn'#010+
+  '**1E_sam','e as -Cn'#010+
   '**1F<x>_set file names and paths:'#010+
   '**2FD<x>_sets the directory where to search for compiler utilities'#010+
   '**2Fe<x>_redirect error output to <x>'#010+
   '**2FE<x>_set exe/unit output path to <x>'#010+
   '**2Fi<x>_adds <x> to include path'#010+
-  '**2Fl<x>_adds',' <x> to library path'#010+
+  '**2Fl<x>_adds <x>',' to library path'#010+
   '*L2FL<x>_uses <x> as dynamic linker'#010+
   '**2Fo<x>_adds <x> to object path'#010+
   '**2Fr<x>_load error message file <x>'#010+
   '**2Fu<x>_adds <x> to unit path'#010+
   '**2FU<x>_set unit output path to <x>, overrides -FE'#010+
-  '*g1g_generate debugger informa','tion:'#010+
+  '*g1g_generate debugger information',':'#010+
   '*g2gg_use gsym'#010+
   '*g2gd_use dbx'#010+
   '*g2gh_use heap trace unit (for memory leak debugging)'#010+
@@ -738,7 +738,7 @@ const msgtxt : array[0..000149,1..240] of char=(
   '*g2gc_generate checks for pointers'#010+
   '**1i_information'#010+
   '**2iD_return compiler date'#010+
-  '**2iV_return c','ompiler version'#010+
+  '**2iV_return compi','ler version'#010+
   '**2iSO_return compiler OS'#010+
   '**2iSP_return compiler processor'#010+
   '**2iTO_return target OS'#010+
@@ -746,105 +746,105 @@ const msgtxt : array[0..000149,1..240] of char=(
   '**1I<x>_adds <x> to include path'#010+
   '**1k<x>_Pass <x> to the linker'#010+
   '**1l_write logo'#010+
-  '**1M<x>_set language mode to <','x>'#010+
-  '**2Mfpc_free pascal dialect (default)'#010+
+  '**1M<x>_set language mode to <x>'#010+
+  '*','*2Mfpc_free pascal dialect (default)'#010+
   '**2Mobjfpc_switch some Delphi 2 extensions on'#010+
   '**2Mdelphi_tries to be Delphi compatible'#010+
   '**2Mtp_tries to be TP/BP 7.0 compatible'#010+
   '**2Mgpc_tries to be gpc compatible'#010+
-  '**2Mmac_tries to be compatible to the',' macintosh pascal dialects'#010+
+  '**2Mmac_tries to be compatible to the mac','intosh pascal dialects'#010+
   '**1n_don'#039't read the default config file'#010+
   '**1o<x>_change the name of the executable produced to <x>'#010+
   '**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+
-  '*L1P_use pipes instead of creating temporary assembler ','files'#010+
+  '*L1P_use pipes instead of creating temporary assembler file','s'#010+
   '**1S<x>_syntax options:'#010+
   '**2S2_same as -Mobjfpc'#010+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#010+
   '**2Sa_include assertion code.'#010+
   '**2Sd_same as -Mdelphi'#010+
   '**2Se<x>_compiler stops after the <x> errors (default is 1)'#010+
-  '**2Sg_allow LABEL and GO','TO'#010+
-  '**2Sh_Use ansistrings'#010+
+  '**2Sg_allow LABEL and GOTO'#010+
+  '*','*2Sh_Use ansistrings'#010+
   '**2Si_support C++ styled INLINE'#010+
   '**2Sm_support macros like C (global)'#010+
   '**2So_same as -Mtp'#010+
   '**2Sp_same as -Mgpc'#010+
   '**2Ss_constructor name must be init (destructor must be done)'#010+
   '**2St_allow static keyword in objects'#010+
-  '**1s_do','n'#039't call assembler and linker (only with -a)'#010+
+  '**1s_don'#039't ','call assembler and linker (only with -a)'#010+
   '**2sh_Generate script to link on host'#010+
   '**2sr_Skip register allocation phase (optimizations will be disabled)'#010+
   '**2st_Generate script to link on target'#010+
   '**1u<x>_undefines the symbol <x>'#010+
-  '**1U_unit opti','ons:'#010+
+  '**1U_unit options:',#010+
   '**2Un_don'#039't check the unit name'#010+
   '**2Ur_generate release unit files'#010+
   '**2Us_compile a system unit'#010+
   '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
   '**2*_e : Show errors (default)       d : Show debug info'#010+
-  '**2*_w : Show war','nings               u : Show unit info'#010+
+  '**2*_w : Show warning','s               u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
   '**2*_h : Show hints                  m : Show defined macros'#010+
   '**2*_i : Show general info           p : Show compiled procedures'#010+
-  '**2*_l : Sh','ow linenumbers            c : Show conditionals'#010+
+  '**2*_l : Show l','inenumbers            c : Show conditionals'#010+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#010+
   '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#010+
-  '**2*_    declarations if an error    x : Executable ','info (Win32 only'+
+  '**2*_    declarations if an error    x : Executable info',' (Win32 only'+
   ')'#010+
   '**2*_    occurs'#010+
   '**1V_write fpcdebug.txt file with lots of debugging info'#010+
   '**1X_executable options:'#010+
   '*L2Xc_link with the c library'#010+
   '**2Xs_strip all symbols from executable'#010+
-  '**2XD_try to link dynamic          (defines FPC_LINK_D','YNAMIC)'#010+
+  '**2XD_try to link dynamic          (defines FPC_LINK_DYNAM','IC)'#010+
   '**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#010+
   '**2XX_try to link smart            (defines FPC_LINK_SMART)'#010+
   '**0*_Processor specific options:'#010+
   '3*1A<x>_output format:'#010+
   '3*2Aas_assemble using GNU AS'#010+
-  '3*2Anasmcoff_coff (Go32v2)',' file using Nasm'#010+
+  '3*2Anasmcoff_coff (Go32v2) fil','e using Nasm'#010+
   '3*2Anasmelf_elf32 (Linux) file using Nasm'#010+
   '3*2Awasm_obj file using Wasm (Watcom)'#010+
   '3*2Anasmobj_obj file using Nasm'#010+
   '3*2Amasm_obj file using Masm (Microsoft)'#010+
   '3*2Atasm_obj file using Tasm (Borland)'#010+
-  '3*2Acoff_coff (Go32v2) using in','ternal writer'#010+
+  '3*2Acoff_coff (Go32v2) using intern','al writer'#010+
   '3*2Apecoff_pecoff (Win32) using internal writer'#010+
   '3*1R<x>_assembler reading style:'#010+
   '3*2Ratt_read AT&T style assembler'#010+
   '3*2Rintel_read Intel style assembler'#010+
   '3*2Rdirect_copy assembler text directly to assembler file'#010+
-  '3*1O<x>_optimiza','tions:'#010+
+  '3*1O<x>_optimization','s:'#010+
   '3*2Og_generate smaller code'#010+
   '3*2OG_generate faster code (default)'#010+
   '3*2Or_keep certain variables in registers'#010+
   '3*2Ou_enable uncertain optimizations (see docs)'#010+
   '3*2O1_level 1 optimizations (quick optimizations)'#010+
-  '3*2O2_level 2 optimizations ','(-O1 + slower optimizations)'#010+
+  '3*2O2_level 2 optimizations (-O1',' + slower optimizations)'#010+
   '3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010+
   '3*2Op<x>_target processor:'#010+
   '3*3Op1_set target processor to 386/486'#010+
   '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
-  '3*3Op3_set target processor to P','Pro/PII/c6x86/K6 (tm)'#010+
+  '3*3Op3_set target processor to PPro/','PII/c6x86/K6 (tm)'#010+
   '3*1T<x>_Target operating system:'#010+
   '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
   '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
   '3*2Tlinux_Linux'#010+
   '3*2Tnetware_Novell Netware Module (clib)'#010+
   '3*2Tos2_OS/2 / eComStation'#010+
-  '3*2','Tsunos_SunOS/Solaris'#010+
+  '3*2Tsun','os_SunOS/Solaris'#010+
   '3*2Twatcom_Watcom compatible DOS extender'#010+
   '3*2Twdosx_WDOSX DOS extender'#010+
   '3*2Twin32_Windows 32 Bit'#010+
   '3*1W<x>_Win32-like target options'#010+
   '3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
   '3*2WC_Specify console type application'#010+
-  '3','*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
+  '3*2WD','_Use DEFFILE to export functions of DLL or EXE'#010+
   '3*2WF_Specify full-screen type application (OS/2 only)'#010+
   '3*2WG_Specify graphic type application'#010+
   '3*2WN_Do not generate relocation code (necessary for debugging)'#010+
-  '3*2WR_Generate relocation code'#010,
-  '6*1A<x>_output format'#010+
+  '3*2WR_Generate relocation code'#010+
+  '6*1A','<x>_output format'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
   '6*2Agas_GNU Motorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
@@ -852,13 +852,13 @@ const msgtxt : array[0..000149,1..240] of char=(
   '6*1O_optimizations:'#010+
   '6*2Oa_turn on the optimizer'#010+
   '6*2Og_generate smaller code'#010+
-  '6*2OG_generate',' faster code (default)'#010+
+  '6*2OG_generate fas','ter code (default)'#010+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#010+
   '6*2O0_set target processor to a MC68000'#010+
   '6*2O2_set target processor to a MC68020+ (default)'#010+
   '6*1R<x>_assembler reading style:'#010+
   '6*2RMOT_read motorola style assembler'#010+
-  '6*1T<x>_Target ','operating system:'#010+
+  '6*1T<x>_Target oper','ating system:'#010+
   '6*2Tamiga_Commodore Amiga'#010+
   '6*2Tatari_Atari ST/STe/TT'#010+
   '6*2Tlinux_Linux-68k'#010+
@@ -868,6 +868,6 @@ const msgtxt : array[0..000149,1..240] of char=(
   'P*2Tlinux_Linux on PowerPC'#010+
   'P*2Tmacos_MacOS (classic) on PowerPC'#010+
   '**1*_'#010+
-  '**1?','_shows this help'#010+
+  '**1?_sho','ws this help'#010+
   '**1h_shows this help without waiting'#000
 );

compiler/powerpc/agppcgas.pas

@@ -48,7 +48,7 @@ unit agppcgas;
        cutils,globals,verbose,
        cgbase,systems,
        assemble,
-       itppcgas,
+       itcpugas,
        aasmcpu;
 
     procedure TPPCGNUAssembler.WriteExtraHeader;
@@ -244,6 +244,10 @@ unit agppcgas;
               { case tempstr := 'tw';}
             end;
       end;
+      case c.dirhint of
+        DH_Minus:
+          cond2str:=cond2str+'-';
+      end;
     end;
 
     Procedure TPPCGNUAssembler.WriteInstruction(hp : tai);
@@ -298,7 +302,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.32  2003-10-25 10:37:26  florian
+  Revision 1.33  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.32  2003/10/25 10:37:26  florian
     * fixed compilation of ppc compiler
 
   Revision 1.31  2003/10/01 20:34:49  peter

compiler/powerpc/agppcmpw.pas

@@ -60,7 +60,7 @@ interface
       cutils,globtype,systems,cclasses,
       verbose,finput,fmodule,script,cpuinfo,
       cgbase,
-      itppcgas
+      itcpugas
       ;
 
     const
@@ -1337,7 +1337,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.27  2003-10-25 10:37:26  florian
+  Revision 1.28  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.27  2003/10/25 10:37:26  florian
     * fixed compilation of ppc compiler
 
   Revision 1.26  2003/10/01 20:34:49  peter

compiler/powerpc/cpubase.pas

@@ -46,7 +46,7 @@ uses
         a_ba, a_bl, a_bla, a_bc, a_bca, a_bcl, a_bcla, a_bcctr, a_bcctrl, a_bclr,
         a_bclrl, a_cmp, a_cmpi, a_cmpl, a_cmpli, a_cntlzw, a_cntlzw_, a_crand,
         a_crandc, a_creqv, a_crnand, a_crnor, a_cror, a_crorc, a_crxor, a_dcba,
-        a_dcbf, a_dcbi, a_dcbst, a_dcbt, a_divw, a_divw_, a_divwo, a_divwo_,
+        a_dcbf, a_dcbi, a_dcbst, a_dcbt, a_dcbtst, a_dcbz, a_divw, a_divw_, a_divwo, a_divwo_,
         a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_eciwx, a_ecowx, a_eieio, a_eqv,
         a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd,
         a_fadd_, a_fadds, a_fadds_, a_fcmpo, a_fcmpu, a_fctiw, a_fctw_, a_fctwz,
@@ -70,7 +70,7 @@ uses
         a_srawi, a_srawi_,a_srw, a_srw_, a_stb, a_stbu, a_stbux, a_stbx, a_stfd,
         a_stfdu, a_stfdux, a_stfdx, a_stfiwx, a_stfs, a_stfsu, a_stfsux, a_stfsx,
         a_sth, a_sthbrx, a_sthu, a_sthux, a_sthx, a_stmw, a_stswi, a_stswx, a_stw,
-        a_stwbrx, a_stwx_, a_stwu, a_stwux, a_stwx, a_subf, a_subf_, a_subfo,
+        a_stwbrx, a_stwcx_, a_stwu, a_stwux, a_stwx, a_subf, a_subf_, a_subfo,
         a_subfo_, a_subfc, a_subfc_, a_subfco, a_subfco_, a_subfe, a_subfe_,
         a_subfeo, a_subfeo_, a_subfic, a_subfme, a_subfme_, a_subfmeo, a_subfmeo_,
         a_subfze, a_subfze_, a_subfzeo, a_subfzeo_, a_sync, a_tlbia, a_tlbie,
@@ -154,6 +154,8 @@ uses
         { conditions when using ctr decrement etc }
         C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF);
 
+      TDirHint = (DH_None,DH_Minus);
+
     const
       { these are in the XER, but when moved to CR_x they correspond with the }
       { bits below (still needs to be verified!!!)                            }
@@ -165,6 +167,7 @@ uses
                    case simple: boolean of
                      false: (BO, BI: byte);
                      true: (
+                       dirhint : tdirhint;
                        cond: TAsmCondFlag;
                        case byte of
                          0: ();
@@ -190,7 +193,12 @@ uses
       AsmCondFlag2Str: Array[TAsmCondFlag] of string[4] = ({cf_none}'',
         { conditions when not using ctr decrement etc}
         'lt','le','eq','ge','gt','nl','ne','ng','so','ns','un','nu',
-        't','f','dnz','dzt','dnzf','dz','dzt','dzf');
+        't','f','dnz','dnzt','dnzf','dz','dzt','dzf');
+
+      UpperAsmCondFlag2Str: Array[TAsmCondFlag] of string[4] = ({cf_none}'',
+        { conditions when not using ctr decrement etc}
+        'LT','LE','EQ','GE','GT','NL','NE','NG','SO','NS','UN','NU',
+        'T','F','DNZ','DNZT','DNZF','DZ','DZT','DZF');
 
     const
       CondAsmOps=3;
@@ -637,6 +645,10 @@ implementation
         end;
       end;
 
+    function is_condreg(r : tregister):boolean;
+      begin
+        result:=(r>=NR_CR0) and (r<=NR_CR0);
+      end;
 
     function cgsize2subreg(s:Tcgsize):Tsubregister;
       begin
@@ -682,7 +694,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.75  2003-10-31 08:42:28  mazen
+  Revision 1.76  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.75  2003/10/31 08:42:28  mazen
   * rgHelper renamed to rgBase
   * using findreg_by_<name|number>_table directly to decrease heap overheading
 

compiler/powerpc/cpuinfo.pas

@@ -17,6 +17,9 @@ Unit CPUInfo;
 
 Interface
 
+  uses
+    globtype;
+
 Type
    { Architecture word - Native unsigned type }
    AWord  = Longword;
@@ -35,6 +38,7 @@ Type
    ts32real = single;
    ts64real = double;
    ts80real = extended;
+   ts128real = extended;
    ts64comp = comp;
 
    pbestreal=^bestreal;
@@ -81,12 +85,27 @@ Const
      pocall_cppdecl
    ];
 
+   processorsstr : array[tprocessors] of string[10] = ('',
+     '603',
+     '604'
+   );
+
+   fputypestr : array[tfputype] of string[6] = ('',
+     'SOFT',
+     'STANDARD'
+   );
+
 Implementation
 
 end.
 {
   $Log$
-  Revision 1.15  2003-11-07 15:58:33  florian
+  Revision 1.16  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.15  2003/11/07 15:58:33  florian
     * Florian's culmutative nr. 1; contains:
       - invalid calling conventions for a certain cpu are rejected
       - arm softfloat calling conventions

compiler/powerpc/itppcgas.pas → compiler/powerpc/itcpugas.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-unit itppcgas;
+unit itcpugas;
 
 {$i fpcdefs.inc}
 
@@ -38,11 +38,11 @@ interface
         'ba','bl','bla','bc','bca','bcl','bcla','bcctr','bcctrl','bclr',
         'bclrl','cmp','cmpi','cmpl','cmpli','cntlzw','cntlzw.','crand',
         'crandc','creqv','crnand','crnor','cror','crorc','crxor','dcba',
-        'dcbf','dcbi','dcbst','dcbt','divw','divw.','divwo','divwo.',
+        'dcbf','dcbi','dcbst','dcbt','dcbtst','dcbz','divw','divw.','divwo','divwo.',
         'divwu','divwu.','divwuo','divwuo.','eciwx','ecowx','eieio','eqv',
         'eqv.','extsb','extsb.','extsh','extsh.','fabs','fabs.','fadd',
-        'fadd.','fadds','fadds.','fcmpo','fcmpu','fctiw','fctw.','fctwz',
-        'fctwz.','fdiv','fdiv.','fdivs','fdivs.','fmadd','fmadd.','fmadds',
+        'fadd.','fadds','fadds.','fcmpo','fcmpu','fctiw','fctiw.','fctiwz',
+        'fctiwz.','fdiv','fdiv.','fdivs','fdivs.','fmadd','fmadd.','fmadds',
         'fmadds.','fmr','fmsub','fmsub.','fmsubs','fmsubs.','fmul','fmul.',
         'fmuls','fmuls.','fnabs','fnabs.','fneg','fneg.','fnmadd',
         'fnmadd.','fnmadds','fnmadds.','fnmsub','fnmsub.','fnmsubs',
@@ -62,7 +62,7 @@ interface
         'srawi', 'srawi.','srw', 'srw.', 'stb', 'stbu', 'stbux','stbx','stfd',
         'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx',
         'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw',
-        'stwbrx', 'stwx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo',
+        'stwbrx', 'stwcx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo',
         'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.',
         'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo.',
         'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie',
@@ -135,7 +135,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2003-10-01 20:34:49  peter
+  Revision 1.1  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.2  2003/10/01 20:34:49  peter
     * procinfo unit contains tprocinfo
     * cginfo renamed to cgbase
     * moved cgmessage to verbose

compiler/powerpc/radirect.pas

@@ -1,416 +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 PowerPC 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 }
-       cpubase,
-       itppcgas
-       ;
-
-    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_STACK_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_ppc_direct_info : tasmmodeinfo =
-          (
-            id    : asmmode_direct;
-            idtxt : 'DIRECT'
-          );
-
-initialization
-  RegisterAsmMode(asmmode_ppc_direct_info);
-
-end.
-{
-  $Log$
-  Revision 1.19  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.18  2003/09/04 00:15:29  florian
-    * first bunch of adaptions of arm compiler for new register type
-
-  Revision 1.17  2003/09/03 19:35:24  peter
-    * powerpc compiles again
-
-  Revision 1.16  2003/06/13 21:19:32  peter
-    * current_procdef removed, use current_procinfo.procdef instead
-
-  Revision 1.15  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.14  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.13  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.12  2003/04/27 07:48:05  peter
-    * updated for removed lexlevel
-
-  Revision 1.11  2003/04/25 21:05:22  florian
-    * fixed tfuncretsym stuff in powerpc specific part
-
-  Revision 1.10  2003/04/24 12:05:53  florian
-    * symbols which are register identifiers aren't resolved anymore
-
-  Revision 1.9  2003/04/23 22:18:01  peter
-    * fixes to get rtl compiled
-
-  Revision 1.8  2003/03/22 18:00:27  jonas
-    * fixes for new regallocator
-
-  Revision 1.7  2003/01/08 18:43:58  daniel
-   * Tregister changed into a record
-
-  Revision 1.6  2002/11/25 17:43:28  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.5  2002/09/03 19:04:18  daniel
-    * Fixed PowerPC & M68000 compilation
-
-  Revision 1.4  2002/09/03 16:26:28  daniel
-    * Make Tprocdef.defs protected
-
-  Revision 1.3  2002/08/31 15:59:31  florian
-    + HEAP* stuff must be generated for Linux/PPC as well
-    + direct assembler reader searches now global and static symtables as well
-
-  Revision 1.2  2002/08/18 21:36:42  florian
-    + handling of local variables in direct reader implemented
-
-  Revision 1.1  2002/08/10 14:52:52  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.2  2002/07/28 20:45:23  florian
-    + added direct assembler reader for PowerPC
-
-  Revision 1.1  2002/07/11 14:41:34  florian
-    * start of the new generic parameter handling
-}

compiler/powerpc/rappc.pas

@@ -1,8 +1,8 @@
 {
     $Id$
-    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
+    Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman
 
-    Handles the common i386 assembler reader routines
+    Handles the common ppc assembler reader routines
 
     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
@@ -20,662 +20,30 @@
 
  ****************************************************************************
 }
-unit Rasm;
+unit rappc;
 
 {$i fpcdefs.inc}
 
-interface
+  interface
 
-uses
-  aasmbase,aasmtai,aasmcpu,
-  cpubase,rautils,cclasses;
+    uses
+      aasmbase,aasmtai,aasmcpu,
+      cpubase,rautils,cclasses;
 
-{ Parser helpers }
-function is_prefix(t:tasmop):boolean;
-function is_override(t:tasmop):boolean;
-Function CheckPrefix(prefixop,op:tasmop): Boolean;
-Function CheckOverride(overrideop,op:tasmop): Boolean;
-Procedure FWaitWarning;
-
-type
-  T386Operand=class(TOperand)
-    Procedure SetCorrectSize(opcode:tasmop);override;
-  end;
-
-  T386Instruction=class(TInstruction)
-    { Operand sizes }
-    procedure AddReferenceSizes;
-    procedure SetInstructionOpsize;
-    procedure CheckOperandSizes;
-    procedure CheckNonCommutativeOpcodes;
-    { opcode adding }
-    procedure ConcatInstruction(p : taasmoutput);override;
-  end;
-
-  tstr2opentry = class(Tnamedindexitem)
-    op: TAsmOp;
-  end;
-
-const
-  AsmPrefixes = 6;
-  AsmPrefix : array[0..AsmPrefixes-1] of TasmOP =(
-    A_LOCK,A_REP,A_REPE,A_REPNE,A_REPNZ,A_REPZ
-  );
-
-  AsmOverrides = 6;
-  AsmOverride : array[0..AsmOverrides-1] of TasmOP =(
-    A_SEGCS,A_SEGES,A_SEGDS,A_SEGFS,A_SEGGS,A_SEGSS
-  );
-
-  CondAsmOps=3;
-  CondAsmOp:array[0..CondAsmOps-1] of TasmOp=(
-    A_CMOVcc, A_Jcc, A_SETcc
-  );
-  CondAsmOpStr:array[0..CondAsmOps-1] of string[4]=(
-    'CMOV','J','SET'
-  );
-
-  { Convert reg to opsize }
-  reg_2_opsize:array[firstreg..lastreg] of topsize = (S_NO,
-    S_L,S_L,S_L,S_L,S_L,S_L,S_L,S_L,
-    S_W,S_W,S_W,S_W,S_W,S_W,S_W,S_W,
-    S_B,S_B,S_B,S_B,S_B,S_B,S_B,S_B,
-    S_W,S_W,S_W,S_W,S_W,S_W,
-    S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,
-    S_L,S_L,S_L,S_L,S_L,S_L,
-    S_L,S_L,S_L,S_L,
-    S_L,S_L,S_L,S_L,S_L,
-    S_D,S_D,S_D,S_D,S_D,S_D,S_D,S_D,
-    S_D,S_D,S_D,S_D,S_D,S_D,S_D,S_D
-  );
-
-implementation
-
-uses
-  globtype,globals,systems,verbose,
-  cpuinfo,ag386att;
-
-{$define ATTOP}
-{$define INTELOP}
-
-{$ifdef NORA386INT}
-  {$ifdef NOAG386NSM}
-    {$ifdef NOAG386INT}
-      {$undef INTELOP}
-    {$endif}
-  {$endif}
-{$endif}
-
-{$ifdef NORA386ATT}
-  {$ifdef NOAG386ATT}
-    {$undef ATTOP}
-  {$endif}
-{$endif}
-
-
-
-{*****************************************************************************
-                              Parser Helpers
-*****************************************************************************}
-
-function is_prefix(t:tasmop):boolean;
-var
-  i : longint;
-Begin
-  is_prefix:=false;
-  for i:=1 to AsmPrefixes do
-   if t=AsmPrefix[i-1] then
-    begin
-      is_prefix:=true;
-      exit;
-    end;
-end;
-
-
-function is_override(t:tasmop):boolean;
-var
-  i : longint;
-Begin
-  is_override:=false;
-  for i:=1 to AsmOverrides do
-   if t=AsmOverride[i-1] then
-    begin
-      is_override:=true;
-      exit;
-    end;
-end;
-
-
-Function CheckPrefix(prefixop,op:tasmop): Boolean;
-{ Checks if the prefix is valid with the following opcode }
-{ return false if not, otherwise true                          }
-Begin
-  CheckPrefix := TRUE;
-(*  Case prefix of
-    A_REP,A_REPNE,A_REPE:
-      Case opcode Of
-        A_SCASB,A_SCASW,A_SCASD,
-        A_INS,A_OUTS,A_MOVS,A_CMPS,A_LODS,A_STOS:;
-        Else
-          Begin
-            CheckPrefix := FALSE;
-            exit;
-          end;
-      end; { case }
-    A_LOCK:
-      Case opcode Of
-        A_BT,A_BTS,A_BTR,A_BTC,A_XCHG,A_ADD,A_OR,A_ADC,A_SBB,A_AND,A_SUB,
-        A_XOR,A_NOT,A_NEG,A_INC,A_DEC:;
-        Else
-          Begin
-            CheckPrefix := FALSE;
-            Exit;
-          end;
-      end; { case }
-    A_NONE: exit; { no prefix here }
-    else
-      CheckPrefix := FALSE;
-   end; { end case } *)
-end;
-
-
-Function CheckOverride(overrideop,op:tasmop): Boolean;
-{ Check if the override is valid, and if so then }
-{ update the instr variable accordingly.         }
-Begin
-  CheckOverride := true;
-{     Case instr.getinstruction of
-    A_MOVS,A_XLAT,A_CMPS:
-      Begin
-        CheckOverride := TRUE;
-        Message(assem_e_segment_override_not_supported);
-      end
-  end }
-end;
-
-
-Procedure FWaitWarning;
-begin
-  if (target_info.target=target_i386_GO32V2) and (cs_fp_emulation in aktmoduleswitches) then
-   Message(asmr_w_fwait_emu_prob);
-end;
-
-{*****************************************************************************
-                              T386Operand
-*****************************************************************************}
-
-Procedure T386Operand.SetCorrectSize(opcode:tasmop);
-begin
-  if gas_needsuffix[opcode]=attsufFPU then
-    begin
-     case size of
-      S_L : size:=S_FS;
-      S_IQ : size:=S_FL;
-     end;
-    end
-  else if gas_needsuffix[opcode]=attsufFPUint then
-    begin
-      case size of
-      S_W : size:=S_IS;
-      S_L : size:=S_IL;
-      end;
-    end;
-end;
-
-
-{*****************************************************************************
-                              T386Instruction
-*****************************************************************************}
-
-procedure T386Instruction.AddReferenceSizes;
-{ this will add the sizes for references like [esi] which do not
-  have the size set yet, it will take only the size if the other
-  operand is a register }
-var
-  operand2,i : longint;
-  s : tasmsymbol;
-  so : longint;
-begin
-  for i:=1to ops do
-   begin
-   operands[i].SetCorrectSize(opcode);
-   if (operands[i].size=S_NO) then
-    begin
-      case operands[i].Opr.Typ of
-        OPR_REFERENCE :
-          begin
-            if i=2 then
-             operand2:=1
-            else
-             operand2:=2;
-            if operand2<ops then
-             begin
-               { Only allow register as operand to take the size from }
-               if operands[operand2].opr.typ=OPR_REGISTER then
-                 begin
-                   if ((opcode<>A_MOVD) and
-                       (opcode<>A_CVTSI2SS)) then
-                     operands[i].size:=operands[operand2].size;
-                 end
-               else
-                begin
-                  { if no register then take the opsize (which is available with ATT),
-                    if not availble then give an error }
-                  if opsize<>S_NO then
-                    operands[i].size:=opsize
-                  else
-                   begin
-                     Message(asmr_e_unable_to_determine_reference_size);
-                     { recovery }
-                     operands[i].size:=S_L;
-                   end;
-                end;
-             end
-            else
-             begin
-               if opsize<>S_NO then
-                 operands[i].size:=opsize
-             end;
-          end;
-        OPR_SYMBOL :
-          begin
-            { Fix lea which need a reference }
-            if opcode=A_LEA then
-             begin
-               s:=operands[i].opr.symbol;
-               so:=operands[i].opr.symofs;
-               operands[i].opr.typ:=OPR_REFERENCE;
-               Fillchar(operands[i].opr.ref,sizeof(treference),0);
-               operands[i].opr.ref.symbol:=s;
-               operands[i].opr.ref.offset:=so;
-             end;
-            operands[i].size:=S_L;
-          end;
+    type
+      TPPCOperand=class(TOperand)
       end;
-    end;
-   end;
-end;
 
-
-procedure T386Instruction.SetInstructionOpsize;
-begin
-  if opsize<>S_NO then
-   exit;
-  case ops of
-    0 : ;
-    1 :
-      { "push es" must be stored as a long PM }
-      if ((opcode=A_PUSH) or
-          (opcode=A_POP)) and
-         (operands[1].opr.typ=OPR_REGISTER) and
-         ((operands[1].opr.reg>=firstsreg) and
-          (operands[1].opr.reg<=lastsreg)) then
-        opsize:=S_L
-      else
-        opsize:=operands[1].size;
-    2 :
-      begin
-        case opcode of
-          A_MOVZX,A_MOVSX :
-            begin
-              case operands[1].size of
-                S_W :
-                  case operands[2].size of
-                    S_L :
-                      opsize:=S_WL;
-                  end;
-                S_B :
-                  case operands[2].size of
-                    S_W :
-                      opsize:=S_BW;
-                    S_L :
-                      opsize:=S_BL;
-                  end;
-              end;
-            end;
-          A_MOVD : { movd is a move from a mmx register to a
-                     32 bit register or memory, so no opsize is correct here PM }
-            exit;
-          A_OUT :
-            opsize:=operands[1].size;
-          else
-            opsize:=operands[2].size;
-        end;
-      end;
-    3 :
-      opsize:=operands[3].size;
-  end;
-end;
-
-
-procedure T386Instruction.CheckOperandSizes;
-var
-  sizeerr : boolean;
-  i : longint;
-begin
-  { Check only the most common opcodes here, the others are done in
-    the assembler pass }
-  case opcode of
-    A_PUSH,A_POP,A_DEC,A_INC,A_NOT,A_NEG,
-    A_CMP,A_MOV,
-    A_ADD,A_SUB,A_ADC,A_SBB,
-    A_AND,A_OR,A_TEST,A_XOR: ;
-  else
-    exit;
-  end;
-  { Handle the BW,BL,WL separatly }
-  sizeerr:=false;
-  { special push/pop selector case }
-  if ((opcode=A_PUSH) or
-      (opcode=A_POP)) and
-     (operands[1].opr.typ=OPR_REGISTER) and
-     ((operands[1].opr.reg>=firstsreg) and
-      (operands[1].opr.reg<=lastsreg)) then
-     exit;
-  if opsize in [S_BW,S_BL,S_WL] then
-   begin
-     if ops<>2 then
-      sizeerr:=true
-     else
-      begin
-        case opsize of
-          S_BW :
-            sizeerr:=(operands[1].size<>S_B) or (operands[2].size<>S_W);
-          S_BL :
-            sizeerr:=(operands[1].size<>S_B) or (operands[2].size<>S_L);
-          S_WL :
-            sizeerr:=(operands[1].size<>S_W) or (operands[2].size<>S_L);
-        end;
-      end;
-   end
-  else
-   begin
-     for i:=1 to ops do
-      begin
-        if (operands[i].opr.typ<>OPR_CONSTANT) and
-           (operands[i].size in [S_B,S_W,S_L]) and
-           (operands[i].size<>opsize) then
-         sizeerr:=true;
+      TPPCInstruction=class(TInstruction)
       end;
-   end;
-  if sizeerr then
-   begin
-     { if range checks are on then generate an error }
-     if (cs_compilesystem in aktmoduleswitches) or
-        not (cs_check_range in aktlocalswitches) then
-       Message(asmr_w_size_suffix_and_dest_dont_match)
-     else
-       Message(asmr_e_size_suffix_and_dest_dont_match);
-   end;
-end;
-
 
-{ This check must be done with the operand in ATT order
-  i.e.after swapping in the intel reader
-  but before swapping in the NASM and TASM writers PM }
-procedure T386Instruction.CheckNonCommutativeOpcodes;
-begin
-  if ((ops=2) and
-     (operands[1].opr.typ=OPR_REGISTER) and
-     (operands[2].opr.typ=OPR_REGISTER) and
-     { if the first is ST and the second is also a register
-       it is necessarily ST1 .. ST7 }
-     (operands[1].opr.reg=R_ST)) or
-      (ops=0)  then
-      if opcode=A_FSUBR then
-        opcode:=A_FSUB
-      else if opcode=A_FSUB then
-        opcode:=A_FSUBR
-      else if opcode=A_FDIVR then
-        opcode:=A_FDIV
-      else if opcode=A_FDIV then
-        opcode:=A_FDIVR
-      else if opcode=A_FSUBRP then
-        opcode:=A_FSUBP
-      else if opcode=A_FSUBP then
-        opcode:=A_FSUBRP
-      else if opcode=A_FDIVRP then
-        opcode:=A_FDIVP
-      else if opcode=A_FDIVP then
-        opcode:=A_FDIVRP;
-  if  ((ops=1) and
-      (operands[1].opr.typ=OPR_REGISTER) and
-      (operands[1].opr.reg in [R_ST1..R_ST7])) then
-      if opcode=A_FSUBRP then
-        opcode:=A_FSUBP
-      else if opcode=A_FSUBP then
-        opcode:=A_FSUBRP
-      else if opcode=A_FDIVRP then
-        opcode:=A_FDIVP
-      else if opcode=A_FDIVP then
-        opcode:=A_FDIVRP;
-end;
-
-{*****************************************************************************
-                              opcode Adding
-*****************************************************************************}
-
-procedure T386Instruction.ConcatInstruction(p : taasmoutput);
-var
-  siz  : topsize;
-  i,asize : longint;
-  ai   : taicpu;
-begin
-{ Get Opsize }
-  if (opsize<>S_NO) or (Ops=0) then
-   siz:=opsize
-  else
-   begin
-     if (Ops=2) and (operands[1].opr.typ=OPR_REGISTER) then
-      siz:=operands[1].size
-     else
-      siz:=operands[Ops].size;
-     { MOVD should be of size S_LQ or S_QL, but these do not exist PM }
-     if (ops=2) and (operands[1].size<>S_NO) and
-        (operands[2].size<>S_NO) and (operands[1].size<>operands[2].size) then
-       siz:=S_NO;
-   end;
-
-   if ((opcode=A_MOVD)or
-       (opcode=A_CVTSI2SS)) and
-      ((operands[1].size=S_NO) or
-       (operands[2].size=S_NO)) then
-     siz:=S_NO;
-   { NASM does not support FADD without args
-     as alias of FADDP
-     and GNU AS interprets FADD without operand differently
-     for version 2.9.1 and 2.9.5 !! }
-   if (ops=0) and
-      ((opcode=A_FADD) or
-       (opcode=A_FMUL) or
-       (opcode=A_FSUB) or
-       (opcode=A_FSUBR) or
-       (opcode=A_FDIV) or
-       (opcode=A_FDIVR)) then
-     begin
-       if opcode=A_FADD then
-         opcode:=A_FADDP
-       else if opcode=A_FMUL then
-         opcode:=A_FMULP
-       else if opcode=A_FSUB then
-         opcode:=A_FSUBP
-       else if opcode=A_FSUBR then
-         opcode:=A_FSUBRP
-       else if opcode=A_FDIV then
-         opcode:=A_FDIVP
-       else if opcode=A_FDIVR then
-         opcode:=A_FDIVRP;
-{$ifdef ATTOP}
-       message1(asmr_w_fadd_to_faddp,gas_op2str[opcode]);
-{$else}
-  {$ifdef INTELOP}
-       message1(asmr_w_fadd_to_faddp,std_op2str[opcode]);
-  {$else}
-       message1(asmr_w_fadd_to_faddp,'fXX');
-  {$endif INTELOP}
-{$endif ATTOP}
-     end;
-
-   { GNU AS interprets FDIV without operand differently
-     for version 2.9.1 and 2.10
-     we add explicit args to it !! }
-  if (ops=0) and
-     ((opcode=A_FSUBP) or
-      (opcode=A_FSUBRP) or
-      (opcode=A_FDIVP) or
-      (opcode=A_FDIVRP) or
-      (opcode=A_FSUB) or
-      (opcode=A_FSUBR) or
-      (opcode=A_FDIV) or
-      (opcode=A_FDIVR)) then
-     begin
-{$ifdef ATTOP}
-       message1(asmr_w_adding_explicit_args_fXX,gas_op2str[opcode]);
-{$else}
-  {$ifdef INTELOP}
-       message1(asmr_w_adding_explicit_args_fXX,std_op2str[opcode]);
-  {$else}
-       message1(asmr_w_adding_explicit_args_fXX,'fXX');
-  {$endif INTELOP}
-{$endif ATTOP}
-       ops:=2;
-       operands[1].opr.typ:=OPR_REGISTER;
-       operands[2].opr.typ:=OPR_REGISTER;
-       operands[1].opr.reg:=R_ST;
-       operands[2].opr.reg:=R_ST1;
-     end;
-  if (ops=1) and
-      ((operands[1].opr.typ=OPR_REGISTER) and
-      (operands[1].opr.reg in [R_ST1..R_ST7])) and
-      ((opcode=A_FSUBP) or
-      (opcode=A_FSUBRP) or
-      (opcode=A_FDIVP) or
-      (opcode=A_FDIVRP) or
-      (opcode=A_FADDP) or
-      (opcode=A_FMULP)) then
-     begin
-{$ifdef ATTOP}
-       message1(asmr_w_adding_explicit_first_arg_fXX,gas_op2str[opcode]);
-{$else}
-  {$ifdef INTELOP}
-       message1(asmr_w_adding_explicit_first_arg_fXX,std_op2str[opcode]);
-  {$else}
-       message1(asmr_w_adding_explicit_first_arg_fXX,'fXX');
-  {$endif INTELOP}
-{$endif ATTOP}
-       ops:=2;
-       operands[2].opr.typ:=OPR_REGISTER;
-       operands[2].opr.reg:=operands[1].opr.reg;
-       operands[1].opr.reg:=R_ST;
-     end;
-
-  if (ops=1) and
-      ((operands[1].opr.typ=OPR_REGISTER) and
-      (operands[1].opr.reg in [R_ST1..R_ST7])) and
-      ((opcode=A_FSUB) or
-      (opcode=A_FSUBR) or
-      (opcode=A_FDIV) or
-      (opcode=A_FDIVR) or
-      (opcode=A_FADD) or
-      (opcode=A_FMUL)) then
-     begin
-{$ifdef ATTOP}
-       message1(asmr_w_adding_explicit_second_arg_fXX,gas_op2str[opcode]);
-{$else}
-  {$ifdef INTELOP}
-       message1(asmr_w_adding_explicit_second_arg_fXX,std_op2str[opcode]);
-  {$else}
-       message1(asmr_w_adding_explicit_second_arg_fXX,'fXX');
-  {$endif INTELOP}
-{$endif ATTOP}
-       ops:=2;
-       operands[2].opr.typ:=OPR_REGISTER;
-       operands[2].opr.reg:=R_ST;
-     end;
-
-   { I tried to convince Linus Torwald to add
-     code to support ENTER instruction
-     (when raising a stack page fault)
-     but he replied that ENTER is a bad instruction and
-     Linux does not need to support it
-     So I think its at least a good idea to add a warning
-     if someone uses this in assembler code
-     FPC itself does not use it at all PM }
-   if (opcode=A_ENTER) and ((target_info.target=target_i386_linux) or
-        (target_info.target=target_i386_FreeBSD)) then
-     begin
-       message(asmr_w_enter_not_supported_by_linux);
-     end;
-
-  ai:=taicpu.op_none(opcode,siz);
-  ai.Ops:=Ops;
-  for i:=1to Ops do
-   begin
-     case operands[i].opr.typ of
-       OPR_CONSTANT :
-         ai.loadconst(i-1,aword(operands[i].opr.val));
-       OPR_REGISTER:
-         ai.loadreg(i-1,operands[i].opr.reg);
-       OPR_SYMBOL:
-         ai.loadsymbol(i-1,operands[i].opr.symbol,operands[i].opr.symofs);
-       OPR_REFERENCE:
-         begin
-           ai.loadref(i-1,operands[i].opr.ref);
-           if operands[i].size<>S_NO then
-             begin
-               asize:=0;
-               case operands[i].size of
-                   S_B :
-                     asize:=OT_BITS8;
-                   S_W, S_IS :
-                     asize:=OT_BITS16;
-                   S_L, S_IL, S_FS:
-                     asize:=OT_BITS32;
-                   S_Q, S_D, S_FL, S_FV :
-                     asize:=OT_BITS64;
-                   S_FX :
-                     asize:=OT_BITS80;
-                 end;
-               if asize<>0 then
-                 ai.oper[i-1].ot:=(ai.oper[i-1].ot and not OT_SIZE_MASK) or asize;
-             end;
-         end;
-     end;
-   end;
-
-  if (opcode=A_CALL) and (opsize=S_FAR) then
-    opcode:=A_LCALL;
-  if (opcode=A_JMP) and (opsize=S_FAR) then
-    opcode:=A_LJMP;
-  if (opcode=A_LCALL) or (opcode=A_LJMP) then
-    opsize:=S_FAR;
- { Condition ? }
-  if condition<>C_None then
-   ai.SetCondition(condition);
-
- { Concat the opcode or give an error }
-  if assigned(ai) then
-   begin
-     { Check the instruction if it's valid }
-{$ifndef NOAG386BIN}
-     ai.CheckIfValid;
-{$endif NOAG386BIN}
-     p.concat(ai);
-   end
-  else
-   Message(asmr_e_invalid_opcode_and_operand);
-end;
+  implementation
 
 end.
 {
   $Log$
-  Revision 1.2  2002-08-10 14:52:52  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.1  2002/07/28 20:45:23  florian
-    + added direct assembler reader for PowerPC
-
+  Revision 1.3  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
 }

compiler/powerpc/rappcgas.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-Unit rappcatt;
+Unit rappcgas;
 
 {$i fpcdefs.inc}
 
@@ -193,16 +193,16 @@ Unit rappcatt;
             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;
+              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));
+              inc(l,BuildConstExpression(true,false));
             case oper.opr.typ of
               OPR_LOCAL :
                 begin
@@ -364,6 +364,25 @@ Unit rappcatt;
                      begin
                        if oper.SetupVar(expr,false) then
                         begin
+                          { check for ...@ }
+                          if actasmtoken=AS_AT then
+                            begin
+                              if oper.opr.ref.symbol=nil then
+                                Message(asmr_e_invalid_reference_syntax);
+                              Consume(AS_AT);
+                              if actasmtoken=AS_ID then
+                                begin
+                                  if upper(actasmpattern)='L' then
+                                    oper.opr.ref.symaddr:=refs_l
+                                  else if upper(actasmpattern)='HA' then
+                                    oper.opr.ref.symaddr:=refs_ha
+                                  else
+                                    Message(asmr_e_invalid_reference_syntax);
+                                  Consume(AS_ID);
+                                end
+                              else
+                                Message(asmr_e_invalid_reference_syntax);
+                            end;
                         end
                        else
                         Begin
@@ -438,6 +457,20 @@ Unit rappcatt;
                   oper.opr.typ:=OPR_REGISTER;
                   oper.opr.reg:=tempreg;
                 end
+              else if is_condreg(tempreg) then
+                begin
+                  if actasmtoken=AS_STAR then
+                    begin
+                      consume(AS_STAR);
+                      if (actasmtoken=AS_INTNUM) and (actasmpattern='4') then
+                        begin
+                        end
+                      else
+                        Message(asmr_e_syn_operand);
+                    end
+                  else
+                    Message(asmr_e_syn_operand);
+                end
               else
                 Message(asmr_e_syn_operand);
             end;
@@ -602,6 +635,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.1  2003-11-06 20:48:02  florian
+  Revision 1.2  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.1  2003/11/06 20:48:02  florian
     * initial revision
 }

compiler/powerpc/rasm.pas

@@ -1,75 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by The Free Pascal Team
-
-    This unit does the parsing process for the 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 Rasm;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses
-  node;
-
-   {
-     This routine is called to parse the instructions in assembler
-     blocks. It returns a complete list of directive and instructions
-   }
-   function assemble: tnode;
-
-
-Implementation
-
-    uses
-       { common }
-       cutils,cclasses,
-       { global }
-       globtype,globals,verbose,
-       systems,
-       { aasm }
-       cpubase,aasmbase,aasmtai,aasmcpu,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner
-       // ,rautils
-       ;
-
-    function assemble : tnode;
-     begin
-     end;
-
-Begin
-end.
-{
-  $Log$
-  Revision 1.2  2002-08-11 06:14:41  florian
-    * fixed powerpc compilation problems
-
-  Revision 1.1  2002/08/10 14:52:52  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.
-}

compiler/pstatmnt.pas

@@ -56,18 +56,9 @@ implementation
        scanner,
        pbase,pexpr,
        { codegen }
-       procinfo,cgbase
-       ,radirect
-{$ifdef i386}
-  {$ifndef NoRa386Int}
-       ,ra386int
-  {$endif NoRa386Int}
-  {$ifndef NoRa386Att}
-       ,ra386att
-  {$endif NoRa386Att}
-{$else}
-       ,rasm
-{$endif i386}
+       procinfo,cgbase,
+       { assembler reader }
+       rabase
        ;
 
 
@@ -776,39 +767,28 @@ implementation
         asmstat : tasmnode;
         Marker  : tai;
         reg     : tregister;
+        asmreader : tbaseasmreader;
       begin
          Inside_asm_statement:=true;
-         case aktasmmode of
-           asmmode_none : ; { just be there to allow to compile a compiler without
-                              any assembler readers }
-{$ifdef i386}
-  {$ifndef NoRA386Att}
-           asmmode_i386_att:
-             asmstat:=tasmnode(ra386att.assemble);
-  {$endif NoRA386Att}
-  {$ifndef NoRA386Int}
-           asmmode_i386_intel:
-             asmstat:=tasmnode(ra386int.assemble);
-  {$endif NoRA386Int}
-{$else not i386}
-           asmmode_standard:
-             asmstat:=tasmnode(rasm.assemble);
-{$endif i386}
-           asmmode_direct:
-             begin
-               if not target_asm.allowdirect then
-                 Message(parser_f_direct_assembler_not_allowed);
-               if (current_procinfo.procdef.proccalloption=pocall_inline) then
-                 Begin
-                    Message1(parser_w_not_supported_for_inline,'direct asm');
-                    Message(parser_w_inlining_disabled);
-                    current_procinfo.procdef.proccalloption:=pocall_default;
-                 End;
-               asmstat:=tasmnode(radirect.assemble);
-             end;
+         if aktasmmode=asmmode_direct then
+           begin
+             if not target_asm.allowdirect then
+               Message(parser_f_direct_assembler_not_allowed);
+             if (current_procinfo.procdef.proccalloption=pocall_inline) then
+               Begin
+                  Message1(parser_w_not_supported_for_inline,'direct asm');
+                  Message(parser_w_inlining_disabled);
+                  current_procinfo.procdef.proccalloption:=pocall_default;
+               End;
+           end;
+         if assigned(asmmodeinfos[aktasmmode]) then
+           begin
+             asmreader:=asmmodeinfos[aktasmmode]^.casmreader.create;
+             asmstat:=casmnode.create(asmreader.assemble as taasmoutput);
+             asmreader.free;
+           end
          else
            Message(parser_f_assembler_reader_not_supported);
-         end;
 
          { Read first the _ASM statement }
          consume(_ASM);
@@ -1124,7 +1104,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.121  2003-11-11 21:10:12  peter
+  Revision 1.122  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.121  2003/11/11 21:10:12  peter
     * remove temporary stdcall hack
 
   Revision 1.120  2003/11/10 22:02:52  peter

compiler/ptconst.pas

@@ -221,14 +221,21 @@ implementation
                    curconstSegment.concat(Tai_real_64bit.Create(ts64real(value)));
                  s80real :
                    curconstSegment.concat(Tai_real_80bit.Create(value));
+
 {$ifdef ver1_0}
                  s64comp :
                    curconstSegment.concat(Tai_comp_64bit.Create(value));
+                 s64currency:
+                   curconstSegment.concat(Tai_comp_64bit.Create(value*10000));
 {$else ver1_0}
                  { the round is necessary for native compilers where comp isn't a float }
                  s64comp :
                    curconstSegment.concat(Tai_comp_64bit.Create(round(value)));
+                 s64currency:
+                   curconstSegment.concat(Tai_comp_64bit.Create(round(value*10000)));
 {$endif ver1_0}
+                 s128real:
+                   curconstSegment.concat(Tai_real_128bit.Create(value));
                  else
                    internalerror(18);
               end;
@@ -994,7 +1001,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.73  2003-11-08 10:23:35  florian
+  Revision 1.74  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.73  2003/11/08 10:23:35  florian
     * fixed parsing of typed widestring constants with length 1
 
   Revision 1.72  2003/10/21 18:16:13  peter

compiler/raatt.pas

@@ -0,0 +1,1430 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
+
+    Does the parsing for the GAS 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 raatt;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      { common }
+      cutils,cclasses,
+      { global }
+      globtype,
+      { aasm }
+      cpubase,cpuinfo,aasmbase,aasmtai,aasmcpu,
+      { assembler reader }
+      rabase,
+      rasm,
+      rautils,
+      { symtable }
+      symconst,
+      { cg }
+      cgbase,node;
+
+    type
+      tasmtoken = (
+        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,
+        {------------------ Assembler directives --------------------}
+        AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL,
+        AS_ALIGN,AS_BALIGN,AS_P2ALIGN,AS_ASCII,
+        AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,
+        AS_DATA,AS_TEXT,AS_END,
+        {------------------ Assembler Operators  --------------------}
+        AS_TYPE,AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR,AS_AT);
+
+        tasmkeyword = string[10];
+
+    const
+      { These tokens should be modified accordingly to the modifications }
+      { in the different enumerations.                                   }
+      firstdirective = AS_DB;
+      lastdirective  = AS_END;
+
+      token2str : array[tasmtoken] of tasmkeyword=(
+        '','Label','LLabel','string','integer',
+        'float',',','(',
+        ')',':','.','+','-','*',
+        ';','identifier','register','opcode','/','$',
+        '.byte','.word','.long','.quad','.globl',
+        '.align','.balign','.p2align','.ascii',
+        '.asciz','.lcomm','.comm','.single','.double','.tfloat',
+        '.data','.text','END',
+        'TYPE','%','<<','>>','!','&','|','^','~','@');
+
+    type
+       tattreader = class(tasmreader)
+         actasmtoken    : tasmtoken;
+         prevasmtoken   : tasmtoken;
+         procedure SetupTables;
+         procedure BuildConstant(maxvalue: longint);
+         procedure BuildConstantOperand(oper : toperand);
+         procedure BuildRealConstant(typ : tfloattype);
+         procedure BuildStringConstant(asciiz: boolean);
+         procedure BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
+         procedure BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:longint;var asmsym:string);
+         function BuildConstExpression(allowref,betweenbracket:boolean): longint;
+         function Assemble: tlinkedlist;override;
+         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_locallabel(const s: string):boolean;
+         procedure GetToken;
+         function consume(t : tasmtoken):boolean;
+         procedure RecoverConsume(allowcomma:boolean);
+         procedure handlepercent;virtual;
+       end;
+       tcattreader = class of tattreader;
+
+    var
+      cattreader : tcattreader;
+
+  implementation
+
+    uses
+      { globals }
+      verbose,systems,
+      { input }
+      scanner,
+      { symtable }
+      symbase,symtype,symsym,symtable,
+{$ifdef x86}
+      rax86,
+{$endif x86}
+      itcpugas;
+
+
+    procedure tattreader.SetupTables;
+      { creates uppercased symbol tables for speed access }
+      var
+        i : tasmop;
+        str2opentry: tstr2opentry;
+      Begin
+        { opcodes }
+        iasmops:=TDictionary.Create;
+        iasmops.delete_doubles:=true;
+        for i:=firstop to lastop do
+          begin
+            str2opentry:=tstr2opentry.createname(upper(gas_op2str[i]));
+            str2opentry.op:=i;
+            iasmops.insert(str2opentry);
+          end;
+      end;
+
+
+    function tattreader.is_asmdirective(const s: string):boolean;
+      var
+        i : tasmtoken;
+        hs : string;
+      Begin
+        { GNU as is also not casesensitive with this }
+        hs:=lower(s);
+        for i:=firstdirective to lastdirective do
+         if hs=token2str[i] then
+          begin
+            actasmtoken:=i;
+            is_asmdirective:=true;
+            exit;
+          end;
+        is_asmdirective:=false;
+      end;
+
+
+    function tattreader.is_register(const s:string):boolean;
+      begin
+        is_register:=false;
+        actasmregister:=gas_regnum_search(lower(s));
+        if actasmregister<>NR_NO then
+          begin
+            is_register:=true;
+            actasmtoken:=AS_REGISTER;
+          end;
+      end;
+
+
+    function tattreader.is_locallabel(const s: string):boolean;
+      begin
+        is_locallabel:=(length(s)>=2) and (s[1]='.') and (s[2]='L');
+      end;
+
+
+    procedure tattreader.handlepercent;
+      begin
+        actasmtoken:=AS_MOD;
+      end;
+
+
+    procedure tattreader.GetToken;
+      var
+        len : longint;
+        srsym : tsym;
+        srsymtable : tsymtable;
+      begin
+        { save old token and reset new token }
+        prevasmtoken:=actasmtoken;
+        actasmtoken:=AS_NONE;
+        { reset }
+        actasmpattern:='';
+        { while space and tab , continue scan... }
+        while c in [' ',#9] do
+         c:=current_scanner.asmgetchar;
+        { get token pos }
+        if not (c in [#10,#13,'{',';']) then
+          current_scanner.gettokenpos;
+        { Local Label, Label, Directive, Prefix or Opcode }
+        if firsttoken and not(c in [#10,#13,'{',';']) then
+         begin
+           firsttoken:=FALSE;
+           len:=0;
+           { directive or local label }
+           if c = '.' then
+            begin
+              inc(len);
+              actasmpattern[len]:=c;
+              { Let us point to the next character }
+              c:=current_scanner.asmgetchar;
+              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);
+              { this is a local label... }
+              if (c=':') and is_locallabel(actasmpattern) then
+               Begin
+                 { local variables are case sensitive }
+                 actasmtoken:=AS_LLABEL;
+                 c:=current_scanner.asmgetchar;
+                 firsttoken:=true;
+                 exit;
+               end
+              { must be a directive }
+              else
+               Begin
+                 { directives are case sensitive!! }
+                 if is_asmdirective(actasmpattern) then
+                  exit;
+                 Message1(asmr_e_not_directive_or_local_symbol,actasmpattern);
+               end;
+            end;
+           { only opcodes and global labels are allowed now. }
+           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);
+           { Label ? }
+           if c = ':' then
+            begin
+              actasmtoken:=AS_LABEL;
+              { let us point to the next character }
+              c:=current_scanner.asmgetchar;
+              firsttoken:=true;
+              exit;
+            end;
+{$ifdef POWERPC}
+           { some PowerPC instructions can have the prefix - or .
+             this code could be moved to is_asmopcode but I think
+             it's better to ifdef it here (FK)
+           }
+           if c='.' then
+             begin
+               actasmpattern:=actasmpattern+'.';
+               c:=current_scanner.asmgetchar;
+             end
+           else if c='-' then
+             begin
+               actasmpattern:=actasmpattern+'-';
+               c:=current_scanner.asmgetchar;
+             end;
+{$endif POWERPC}
+           { Opcode ? }
+           If is_asmopcode(upper(actasmpattern)) then
+            Begin
+              uppervar(actasmpattern);
+              exit;
+            end;
+           { End of assemblerblock ? }
+           if upper(actasmpattern) = 'END' then
+            begin
+              actasmtoken:=AS_END;
+              exit;
+            end;
+           message1(asmr_e_unknown_opcode,actasmpattern);
+           actasmtoken:=AS_NONE;
+         end
+        else { else firsttoken }
+        { Here we must handle all possible cases }
+         begin
+           case c of
+             '.' :  { possiblities : - local label reference , such as in jmp @local1 }
+                    {               - field of object/record                         }
+                    {               - directive.                                     }
+               begin
+                 if (prevasmtoken in [AS_ID,AS_RPAREN]) then
+                  begin
+                    c:=current_scanner.asmgetchar;
+                    actasmtoken:=AS_DOT;
+                    exit;
+                  end;
+                 actasmpattern:=c;
+                 c:=current_scanner.asmgetchar;
+                 while c in  ['A'..'Z','a'..'z','0'..'9','_','$'] do
+                  begin
+                    actasmpattern:=actasmpattern + c;
+                    c:=current_scanner.asmgetchar;
+                  end;
+                 if is_asmdirective(actasmpattern) then
+                  exit;
+                 { local label references and directives }
+                 { are case sensitive                    }
+                 actasmtoken:=AS_ID;
+                 exit;
+               end;
+
+          { identifier, register, prefix or directive }
+             '_','A'..'Z','a'..'z':
+               begin
+                 len:=0;
+                 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);
+{$ifdef x86}
+                 { only x86 architectures have instruction prefixes }
+
+                 { Opcode, can only be when the previous was a prefix }
+                 If is_prefix(actopcode) and is_asmopcode(actasmpattern) then
+                  Begin
+                    uppervar(actasmpattern);
+                    exit;
+                  end;
+{$endif x86}
+                 { check for end which is a reserved word unlike the opcodes }
+                 if actasmpattern = 'END' then
+                  Begin
+                    actasmtoken:=AS_END;
+                    exit;
+                  end;
+                 if actasmpattern = 'TYPE' then
+                  Begin
+                    actasmtoken:=AS_TYPE;
+                    exit;
+                  end;
+                 if is_register(actasmpattern) then
+                   begin
+                     actasmtoken:=AS_REGISTER;
+                     exit;
+                   end;
+                 { if next is a '.' and this is a unitsym then we also need to
+                   parse the identifier }
+                 if (c='.') then
+                  begin
+                    searchsym(actasmpattern,srsym,srsymtable);
+                    if assigned(srsym) and
+                       (srsym.typ=unitsym) and
+                       (srsym.owner.unitid=0) then
+                     begin
+                       actasmpattern:=actasmpattern+c;
+                       c:=current_scanner.asmgetchar;
+                       while c in  ['A'..'Z','a'..'z','0'..'9','_','$'] do
+                        begin
+                          actasmpattern:=actasmpattern + upcase(c);
+                          c:=current_scanner.asmgetchar;
+                        end;
+                     end;
+                  end;
+                 actasmtoken:=AS_ID;
+                 exit;
+               end;
+
+             '%' : { register or modulo }
+               handlepercent;
+
+             '1'..'9': { integer number }
+               begin
+                 len:=0;
+                 while c in ['0'..'9'] do
+                  Begin
+                    inc(len);
+                    actasmpattern[len]:=c;
+                    c:=current_scanner.asmgetchar;
+                  end;
+                 actasmpattern[0]:=chr(len);
+                 actasmpattern:=tostr(ValDecimal(actasmpattern));
+                 actasmtoken:=AS_INTNUM;
+                 exit;
+               end;
+             '0' : { octal,hexa,real or binary number. }
+               begin
+                 actasmpattern:=c;
+                 c:=current_scanner.asmgetchar;
+                 case upcase(c) of
+                   'B': { binary }
+                     Begin
+                       c:=current_scanner.asmgetchar;
+                       while c in ['0','1'] do
+                        Begin
+                          actasmpattern:=actasmpattern + c;
+                          c:=current_scanner.asmgetchar;
+                        end;
+                       actasmpattern:=tostr(ValBinary(actasmpattern));
+                       actasmtoken:=AS_INTNUM;
+                       exit;
+                     end;
+                   'D': { real }
+                     Begin
+                       c:=current_scanner.asmgetchar;
+                       { get ridd of the 0d }
+                       if (c in ['+','-']) then
+                        begin
+                          actasmpattern:=c;
+                          c:=current_scanner.asmgetchar;
+                        end
+                       else
+                        actasmpattern:='';
+                       while c in ['0'..'9'] do
+                        Begin
+                          actasmpattern:=actasmpattern + c;
+                          c:=current_scanner.asmgetchar;
+                        end;
+                       if c='.' then
+                        begin
+                          actasmpattern:=actasmpattern + c;
+                          c:=current_scanner.asmgetchar;
+                          while c in ['0'..'9'] do
+                           Begin
+                             actasmpattern:=actasmpattern + c;
+                             c:=current_scanner.asmgetchar;
+                           end;
+                          if upcase(c) = 'E' then
+                           begin
+                             actasmpattern:=actasmpattern + c;
+                             c:=current_scanner.asmgetchar;
+                             if (c in ['+','-']) then
+                              begin
+                                actasmpattern:=actasmpattern + c;
+                                c:=current_scanner.asmgetchar;
+                              end;
+                             while c in ['0'..'9'] do
+                              Begin
+                                actasmpattern:=actasmpattern + c;
+                                c:=current_scanner.asmgetchar;
+                              end;
+                           end;
+                          actasmtoken:=AS_REALNUM;
+                          exit;
+                        end
+                       else
+                        begin
+                          Message1(asmr_e_invalid_float_const,actasmpattern+c);
+                          actasmtoken:=AS_NONE;
+                        end;
+                     end;
+                   'X': { hexadecimal }
+                     Begin
+                       c:=current_scanner.asmgetchar;
+                       while c in ['0'..'9','a'..'f','A'..'F'] do
+                        Begin
+                          actasmpattern:=actasmpattern + c;
+                          c:=current_scanner.asmgetchar;
+                        end;
+                       actasmpattern:=tostr(ValHexaDecimal(actasmpattern));
+                       actasmtoken:=AS_INTNUM;
+                       exit;
+                     end;
+                   '1'..'7': { octal }
+                     begin
+                       actasmpattern:=actasmpattern + c;
+                       while c in ['0'..'7'] do
+                        Begin
+                          actasmpattern:=actasmpattern + c;
+                          c:=current_scanner.asmgetchar;
+                        end;
+                       actasmpattern:=tostr(ValOctal(actasmpattern));
+                       actasmtoken:=AS_INTNUM;
+                       exit;
+                     end;
+                   else { octal number zero value...}
+                     Begin
+                       actasmpattern:=tostr(ValOctal(actasmpattern));
+                       actasmtoken:=AS_INTNUM;
+                       exit;
+                     end;
+                 end; { end case }
+               end;
+
+             '&' :
+               begin
+                 c:=current_scanner.asmgetchar;
+                 actasmtoken:=AS_AND;
+               end;
+
+             '''' : { char }
+               begin
+                 current_scanner.in_asm_string:=true;
+                 actasmpattern:='';
+                 repeat
+                   c:=current_scanner.asmgetchar;
+                   case c of
+                     '\' :
+                       begin
+                         { copy also the next char so \" is parsed correctly }
+                         actasmpattern:=actasmpattern+c;
+                         c:=current_scanner.asmgetchar;
+                         actasmpattern:=actasmpattern+c;
+                       end;
+                     '''' :
+                       begin
+                         c:=current_scanner.asmgetchar;
+                         break;
+                       end;
+                     #10,#13:
+                       Message(scan_f_string_exceeds_line);
+                     else
+                       actasmpattern:=actasmpattern+c;
+                   end;
+                 until false;
+                 actasmpattern:=EscapeToPascal(actasmpattern);
+                 actasmtoken:=AS_STRING;
+                 current_scanner.in_asm_string:=false;
+                 exit;
+               end;
+
+             '"' : { string }
+               begin
+                 current_scanner.in_asm_string:=true;
+                 actasmpattern:='';
+                 repeat
+                   c:=current_scanner.asmgetchar;
+                   case c of
+                     '\' :
+                       begin
+                         { copy also the next char so \" is parsed correctly }
+                         actasmpattern:=actasmpattern+c;
+                         c:=current_scanner.asmgetchar;
+                         actasmpattern:=actasmpattern+c;
+                       end;
+                     '"' :
+                       begin
+                         c:=current_scanner.asmgetchar;
+                         break;
+                       end;
+                     #10,#13:
+                       Message(scan_f_string_exceeds_line);
+                     else
+                       actasmpattern:=actasmpattern+c;
+                   end;
+                 until false;
+                 actasmpattern:=EscapeToPascal(actasmpattern);
+                 actasmtoken:=AS_STRING;
+                 current_scanner.in_asm_string:=false;
+                 exit;
+               end;
+
+             '$' :
+               begin
+                 actasmtoken:=AS_DOLLAR;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             ',' :
+               begin
+                 actasmtoken:=AS_COMMA;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '<' :
+               begin
+                 actasmtoken:=AS_SHL;
+                 c:=current_scanner.asmgetchar;
+                 if c = '<' then
+                  c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '>' :
+               begin
+                 actasmtoken:=AS_SHL;
+                 c:=current_scanner.asmgetchar;
+                 if c = '>' then
+                  c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '|' :
+               begin
+                 actasmtoken:=AS_OR;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '^' :
+               begin
+                 actasmtoken:=AS_XOR;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+
+             '(' :
+               begin
+                 actasmtoken:=AS_LPAREN;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             ')' :
+               begin
+                 actasmtoken:=AS_RPAREN;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             ':' :
+               begin
+                 actasmtoken:=AS_COLON;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '+' :
+               begin
+                 actasmtoken:=AS_PLUS;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '-' :
+               begin
+                 actasmtoken:=AS_MINUS;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '*' :
+               begin
+                 actasmtoken:=AS_STAR;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '/' :
+               begin
+                 actasmtoken:=AS_SLASH;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '@' :
+               begin
+                 actasmtoken:=AS_AT;
+                 c:=current_scanner.asmgetchar;
+                 exit;
+               end;
+
+             '{',#13,#10,';' :
+               begin
+                 { the comment is read by asmgetchar }
+                 c:=current_scanner.asmgetchar;
+                 firsttoken:=TRUE;
+                 actasmtoken:=AS_SEPARATOR;
+                 exit;
+               end;
+
+             else
+               current_scanner.illegal_char(c);
+           end;
+         end;
+      end;
+
+
+    function tattreader.consume(t : tasmtoken):boolean;
+      begin
+        Consume:=true;
+        if t<>actasmtoken then
+         begin
+           Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]);
+           Consume:=false;
+         end;
+        repeat
+          gettoken;
+        until actasmtoken<>AS_NONE;
+      end;
+
+
+    procedure tattreader.RecoverConsume(allowcomma:boolean);
+      begin
+        While not (actasmtoken in [AS_SEPARATOR,AS_END]) do
+         begin
+           if allowcomma and (actasmtoken=AS_COMMA) then
+            break;
+           Consume(actasmtoken);
+         end;
+      end;
+
+
+    Procedure tattreader.BuildConstant(maxvalue: longint);
+      var
+       asmsym,
+       expr: string;
+       value : longint;
+      Begin
+        Repeat
+          Case actasmtoken of
+            AS_STRING:
+              Begin
+                expr:=actasmpattern;
+                if length(expr) > 1 then
+                 Message(asmr_e_string_not_allowed_as_const);
+                Consume(AS_STRING);
+                Case actasmtoken of
+                  AS_COMMA: Consume(AS_COMMA);
+                  AS_END,
+                  AS_SEPARATOR: ;
+                else
+                  Message(asmr_e_invalid_string_expression);
+                end; { end case }
+                ConcatString(curlist,expr);
+              end;
+            AS_INTNUM,
+            AS_PLUS,
+            AS_MINUS,
+            AS_LPAREN,
+            AS_NOT,
+            AS_ID :
+              Begin
+                BuildConstSymbolExpression(false,false,false,value,asmsym);
+                if asmsym<>'' then
+                 begin
+                   if maxvalue<>longint($ffffffff) then
+                    Message(asmr_w_32bit_const_for_address);
+                   ConcatConstSymbol(curlist,asmsym,value)
+                 end
+                else
+                 ConcatConstant(curlist,value,maxvalue);
+              end;
+            AS_COMMA:
+              Consume(AS_COMMA);
+            AS_END,
+            AS_SEPARATOR:
+              break;
+            else
+              begin
+                Message(asmr_e_syn_constant);
+                RecoverConsume(false);
+              end
+         end; { end case }
+       Until false;
+      end;
+
+
+    Procedure tattreader.BuildRealConstant(typ : tfloattype);
+      var
+        expr : string;
+        r : bestreal;
+        code : integer;
+        negativ : boolean;
+        errorflag: boolean;
+      Begin
+        errorflag:=FALSE;
+        Repeat
+          negativ:=false;
+          expr:='';
+          if actasmtoken=AS_PLUS then
+            Consume(AS_PLUS)
+          else
+           if actasmtoken=AS_MINUS then
+            begin
+              negativ:=true;
+              consume(AS_MINUS);
+            end;
+          Case actasmtoken of
+            AS_INTNUM:
+              Begin
+                expr:=actasmpattern;
+                Consume(AS_INTNUM);
+                if negativ then
+                 expr:='-'+expr;
+                val(expr,r,code);
+                if code<>0 then
+                 Begin
+                   r:=0;
+                   Message(asmr_e_invalid_float_expr);
+                 End;
+                ConcatRealConstant(curlist,r,typ);
+              end;
+            AS_REALNUM:
+              Begin
+                expr:=actasmpattern;
+                Consume(AS_REALNUM);
+                { in ATT syntax you have 0d in front of the real }
+                { should this be forced ?  yes i think so, as to }
+                { conform to gas as much as possible.            }
+                if (expr[1]='0') and (upper(expr[2])='D') then
+                 Delete(expr,1,2);
+                if negativ then
+                 expr:='-'+expr;
+                val(expr,r,code);
+                if code<>0 then
+                 Begin
+                   r:=0;
+                   Message(asmr_e_invalid_float_expr);
+                 End;
+                ConcatRealConstant(curlist,r,typ);
+              end;
+            AS_COMMA:
+              begin
+                Consume(AS_COMMA);
+              end;
+            AS_END,
+            AS_SEPARATOR:
+              begin
+                break;
+              end;
+         else
+           Begin
+             Consume(actasmtoken);
+             if not errorflag then
+              Message(asmr_e_invalid_float_expr);
+             errorflag:=TRUE;
+           end;
+         end;
+       Until false;
+      end;
+
+
+    Procedure tattreader.BuildStringConstant(asciiz: boolean);
+      var
+        expr: string;
+        errorflag : boolean;
+      Begin
+        errorflag:=FALSE;
+        Repeat
+          Case actasmtoken of
+            AS_STRING:
+              Begin
+                expr:=actasmpattern;
+                if asciiz then
+                  expr:=expr+#0;
+                ConcatPasString(curlist,expr);
+                Consume(AS_STRING);
+              end;
+            AS_COMMA:
+              begin
+                Consume(AS_COMMA);
+              end;
+            AS_END,
+            AS_SEPARATOR:
+              begin
+                break;
+              end;
+         else
+           Begin
+             Consume(actasmtoken);
+             if not errorflag then
+              Message(asmr_e_invalid_string_expression);
+             errorflag:=TRUE;
+           end;
+         end;
+       Until false;
+      end;
+
+
+   Function tattreader.Assemble: tlinkedlist;
+     Var
+       hl         : tasmlabel;
+       commname   : string;
+       lasTSec    : TSection;
+       l1,l2      : longint;
+     Begin
+       Message1(asmr_d_start_reading,'GNU AS');
+       firsttoken:=TRUE;
+       { sets up all opcode and register tables in uppercase }
+       if not _asmsorted then
+        Begin
+          SetupTables;
+          _asmsorted:=TRUE;
+        end;
+       curlist:=TAAsmoutput.Create;
+       lasTSec:=sec_code;
+       { setup label linked list }
+       LocalLabelList:=TLocalLabelList.Create;
+       { start tokenizer }
+       c:=current_scanner.asmgetcharstart;
+       gettoken;
+       { main loop }
+       repeat
+         case actasmtoken of
+           AS_LLABEL:
+             Begin
+               if CreateLocalLabel(actasmpattern,hl,true) then
+                 ConcatLabel(curlist,hl);
+               Consume(AS_LLABEL);
+             end;
+
+           AS_LABEL:
+             Begin
+               if SearchLabel(upper(actasmpattern),hl,true) then
+                ConcatLabel(curlist,hl)
+               else
+                Message1(asmr_e_unknown_label_identifier,actasmpattern);
+               Consume(AS_LABEL);
+             end;
+
+           AS_DW:
+             Begin
+               Consume(AS_DW);
+               BuildConstant($ffff);
+             end;
+
+           AS_DATA:
+             Begin
+               curList.Concat(Tai_section.Create(sec_data));
+               lasTSec:=sec_data;
+               Consume(AS_DATA);
+             end;
+
+           AS_TEXT:
+             Begin
+               curList.Concat(Tai_section.Create(sec_code));
+               lasTSec:=sec_code;
+               Consume(AS_TEXT);
+             end;
+
+           AS_DB:
+             Begin
+               Consume(AS_DB);
+               BuildConstant($ff);
+             end;
+
+           AS_DD:
+             Begin
+               Consume(AS_DD);
+               BuildConstant(longint($ffffffff));
+             end;
+
+           AS_DQ:
+             Begin
+               Consume(AS_DQ);
+               BuildRealConstant(s64comp);
+             end;
+
+           AS_SINGLE:
+             Begin
+               Consume(AS_SINGLE);
+               BuildRealConstant(s32real);
+             end;
+
+           AS_DOUBLE:
+             Begin
+               Consume(AS_DOUBLE);
+               BuildRealConstant(s64real);
+             end;
+
+           AS_EXTENDED:
+             Begin
+               Consume(AS_EXTENDED);
+               BuildRealConstant(s80real);
+             end;
+
+           AS_GLOBAL:
+             Begin
+               Consume(AS_GLOBAL);
+               if actasmtoken=AS_ID then
+                 ConcatPublic(curlist,actasmpattern);
+               Consume(AS_ID);
+               if actasmtoken<>AS_SEPARATOR then
+                Consume(AS_SEPARATOR);
+             end;
+
+           AS_ALIGN:
+             Begin
+               Consume(AS_ALIGN);
+               l1:=BuildConstExpression(false,false);
+               if (target_info.system in [system_i386_GO32V2]) then
+                 begin
+                    l2:=1;
+                    if (l1>=0) and (l1<=16) then
+                      while (l1>0) do
+                        begin
+                          l2:=2*l2;
+                          dec(l1);
+                        end;
+                    l1:=l2;
+                 end;
+               ConcatAlign(curlist,l1);
+               Message(asmr_n_align_is_target_specific);
+               if actasmtoken<>AS_SEPARATOR then
+                Consume(AS_SEPARATOR);
+             end;
+
+           AS_BALIGN:
+             Begin
+               Consume(AS_BALIGN);
+               ConcatAlign(curlist,BuildConstExpression(false,false));
+               if actasmtoken<>AS_SEPARATOR then
+                Consume(AS_SEPARATOR);
+             end;
+
+           AS_P2ALIGN:
+             Begin
+               Consume(AS_P2ALIGN);
+               l1:=BuildConstExpression(false,false);
+               l2:=1;
+               if (l1>=0) and (l1<=16) then
+                 while (l1>0) do
+                   begin
+                      l2:=2*l2;
+                      dec(l1);
+                   end;
+               l1:=l2;
+               ConcatAlign(curlist,l1);
+               if actasmtoken<>AS_SEPARATOR then
+                Consume(AS_SEPARATOR);
+             end;
+
+           AS_ASCIIZ:
+             Begin
+               Consume(AS_ASCIIZ);
+               BuildStringConstant(TRUE);
+             end;
+
+           AS_ASCII:
+             Begin
+               Consume(AS_ASCII);
+               BuildStringConstant(FALSE);
+             end;
+
+           AS_LCOMM:
+             Begin
+               Consume(AS_LCOMM);
+               commname:=actasmpattern;
+               Consume(AS_ID);
+               Consume(AS_COMMA);
+               ConcatLocalBss(commname,BuildConstExpression(false,false));
+               if actasmtoken<>AS_SEPARATOR then
+                Consume(AS_SEPARATOR);
+             end;
+
+           AS_COMM:
+             Begin
+               Consume(AS_COMM);
+               commname:=actasmpattern;
+               Consume(AS_ID);
+               Consume(AS_COMMA);
+               ConcatGlobalBss(commname,BuildConstExpression(false,false));
+               if actasmtoken<>AS_SEPARATOR then
+                Consume(AS_SEPARATOR);
+             end;
+
+           AS_OPCODE:
+             Begin
+               HandleOpCode;
+             end;
+
+           AS_SEPARATOR:
+             Begin
+               Consume(AS_SEPARATOR);
+             end;
+
+           AS_END:
+             begin
+               break; { end assembly block }
+             end;
+
+           else
+             Begin
+               Message(asmr_e_syntax_error);
+               RecoverConsume(false);
+             end;
+         end;
+       until false;
+       { Check LocalLabelList }
+       LocalLabelList.CheckEmitted;
+       LocalLabelList.Free;
+       { are we back in the code section? }
+       if lasTSec<>sec_code then
+        begin
+          Message(asmr_w_assembler_code_not_returned_to_text);
+          curList.Concat(Tai_section.Create(sec_code));
+        end;
+       { Return the list in an asmnode }
+       assemble:=curlist;
+       Message1(asmr_d_finish_reading,'GNU AS');
+     end;
+
+
+{*****************************************************************************
+                               Parsing Helpers
+*****************************************************************************}
+
+    Procedure tattreader.BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
+      { Description: This routine builds up a record offset after a AS_DOT }
+      { token is encountered.                                              }
+      { On entry actasmtoken should be equal to AS_DOT                     }
+      var
+        s : string;
+      Begin
+        offset:=0;
+        size:=0;
+        s:=expr;
+        while (actasmtoken=AS_DOT) do
+         begin
+           Consume(AS_DOT);
+           if actasmtoken=AS_ID then
+            s:=s+'.'+actasmpattern;
+           if not Consume(AS_ID) then
+            begin
+              RecoverConsume(true);
+              break;
+            end;
+         end;
+        if not GetRecordOffsetSize(s,offset,size) then
+         Message(asmr_e_building_record_offset);
+      end;
+
+
+    procedure tattreader.BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:longint;var asmsym:string);
+      var
+        hs,tempstr,expr : string;
+        parenlevel,l,k : longint;
+        errorflag : boolean;
+        prevtok : tasmtoken;
+        sym : tsym;
+        srsymtable : tsymtable;
+        hl  : tasmlabel;
+      Begin
+        asmsym:='';
+        value:=0;
+        errorflag:=FALSE;
+        tempstr:='';
+        expr:='';
+        parenlevel:=0;
+        Repeat
+          Case actasmtoken of
+            AS_LPAREN:
+              Begin
+                { Exit if ref? }
+                if allowref and (prevasmtoken in [AS_INTNUM,AS_ID]) then
+                 break;
+                Consume(AS_LPAREN);
+                expr:=expr + '(';
+                inc(parenlevel);
+              end;
+            AS_RPAREN:
+              Begin
+                { end of ref ? }
+                if (parenlevel=0) and betweenbracket then
+                 break;
+                Consume(AS_RPAREN);
+                expr:=expr + ')';
+                dec(parenlevel);
+              end;
+            AS_SHL:
+              Begin
+                Consume(AS_SHL);
+                expr:=expr + '<';
+              end;
+            AS_SHR:
+              Begin
+                Consume(AS_SHR);
+                expr:=expr + '>';
+              end;
+            AS_SLASH:
+              Begin
+                Consume(AS_SLASH);
+                expr:=expr + '/';
+              end;
+            AS_MOD:
+              Begin
+                Consume(AS_MOD);
+                expr:=expr + '%';
+              end;
+            AS_STAR:
+              Begin
+                Consume(AS_STAR);
+                expr:=expr + '*';
+              end;
+            AS_PLUS:
+              Begin
+                Consume(AS_PLUS);
+                expr:=expr + '+';
+              end;
+            AS_MINUS:
+              Begin
+                Consume(AS_MINUS);
+                expr:=expr + '-';
+              end;
+            AS_AND:
+              Begin
+                Consume(AS_AND);
+                expr:=expr + '&';
+              end;
+            AS_NOT:
+              Begin
+                Consume(AS_NOT);
+                expr:=expr + '~';
+              end;
+            AS_XOR:
+              Begin
+                Consume(AS_XOR);
+                expr:=expr + '^';
+              end;
+            AS_OR:
+              Begin
+                Consume(AS_OR);
+                expr:=expr + '|';
+              end;
+            AS_INTNUM:
+              Begin
+                expr:=expr + actasmpattern;
+                Consume(AS_INTNUM);
+              end;
+            AS_DOLLAR:
+              begin
+                Consume(AS_DOLLAR);
+                if actasmtoken<>AS_ID then
+                 Message(asmr_e_dollar_without_identifier);
+              end;
+            AS_STRING:
+              Begin
+                l:=0;
+                case Length(actasmpattern) of
+                 1 :
+                  l:=ord(actasmpattern[1]);
+                 2 :
+                  l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8;
+                 3 :
+                  l:=ord(actasmpattern[3]) +
+                     Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16;
+                 4 :
+                  l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 +
+                     Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24;
+                else
+                  Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern);
+                end;
+                str(l, tempstr);
+                expr:=expr + tempstr;
+                Consume(AS_STRING);
+              end;
+            AS_TYPE:
+              begin
+                l:=0;
+                Consume(AS_TYPE);
+                if actasmtoken<>AS_ID then
+                 Message(asmr_e_type_without_identifier)
+                else
+                 begin
+                   tempstr:=actasmpattern;
+                   Consume(AS_ID);
+                   if actasmtoken=AS_DOT then
+                    BuildRecordOffsetSize(tempstr,k,l)
+                   else
+                    begin
+                      searchsym(tempstr,sym,srsymtable);
+                      if assigned(sym) then
+                       begin
+                         case sym.typ of
+                           varsym :
+                             l:=tvarsym(sym).getsize;
+                           typedconstsym :
+                             l:=ttypedconstsym(sym).getsize;
+                           typesym :
+                             l:=ttypesym(sym).restype.def.size;
+                           else
+                             Message(asmr_e_wrong_sym_type);
+                         end;
+                       end
+                      else
+                       Message1(sym_e_unknown_id,tempstr);
+                    end;
+                 end;
+                str(l, tempstr);
+                expr:=expr + tempstr;
+              end;
+            AS_ID:
+              Begin
+                hs:='';
+                tempstr:=actasmpattern;
+                prevtok:=prevasmtoken;
+                consume(AS_ID);
+                if SearchIConstant(tempstr,l) then
+                 begin
+                   str(l, tempstr);
+                   expr:=expr + tempstr;
+                 end
+                else
+                 begin
+                   if is_locallabel(tempstr) then
+                    begin
+                      CreateLocalLabel(tempstr,hl,false);
+                      hs:=hl.name
+                    end
+                   else
+                    if SearchLabel(tempstr,hl,false) then
+                     hs:=hl.name
+                   else
+                    begin
+                      searchsym(tempstr,sym,srsymtable);
+                      if assigned(sym) then
+                       begin
+                         case sym.typ of
+                           varsym :
+                             begin
+                               if sym.owner.symtabletype in [localsymtable,parasymtable] then
+                                Message(asmr_e_no_local_or_para_allowed);
+                               hs:=tvarsym(sym).mangledname;
+                             end;
+                           typedconstsym :
+                             hs:=ttypedconstsym(sym).mangledname;
+                           procsym :
+                             begin
+                               if Tprocsym(sym).procdef_count>1 then
+                                Message(asmr_w_calling_overload_func);
+                               hs:=tprocsym(sym).first_procdef.mangledname;
+                             end;
+                           typesym :
+                             begin
+                               if not(ttypesym(sym).restype.def.deftype in [recorddef,objectdef]) then
+                                Message(asmr_e_wrong_sym_type);
+                             end;
+                           else
+                             Message(asmr_e_wrong_sym_type);
+                         end;
+                       end
+                      else
+                       Message1(sym_e_unknown_id,tempstr);
+                    end;
+                   { symbol found? }
+                   if hs<>'' then
+                    begin
+                      if needofs and (prevtok<>AS_DOLLAR) then
+                       Message(asmr_e_need_dollar);
+                      if asmsym='' then
+                       asmsym:=hs
+                      else
+                       Message(asmr_e_cant_have_multiple_relocatable_symbols);
+                      if (expr='') or (expr[length(expr)]='+') then
+                       begin
+                         { don't remove the + if there could be a record field }
+                         if actasmtoken<>AS_DOT then
+                          delete(expr,length(expr),1);
+                       end
+                      else
+                       Message(asmr_e_only_add_relocatable_symbol);
+                    end;
+                   if actasmtoken=AS_DOT then
+                    begin
+                      BuildRecordOffsetSize(tempstr,l,k);
+                      str(l, tempstr);
+                      expr:=expr + tempstr;
+                    end
+                   else
+                    begin
+                      if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then
+                       delete(expr,length(expr),1);
+                    end;
+                 end;
+                { check if there are wrong operator used like / or mod etc. }
+                if (hs<>'') and not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_LPAREN,AS_END]) then
+                 Message(asmr_e_only_add_relocatable_symbol);
+              end;
+            AS_END,
+            AS_SEPARATOR,
+            AS_COMMA:
+              Begin
+                break;
+              end;
+          else
+            Begin
+              { write error only once. }
+              if not errorflag then
+                Message(asmr_e_invalid_constant_expression);
+              { consume tokens until we find COMMA or SEPARATOR }
+              Consume(actasmtoken);
+              errorflag:=TRUE;
+            end;
+          end;
+        Until false;
+        { calculate expression }
+        if not ErrorFlag then
+          value:=CalculateExpression(expr)
+        else
+          value:=0;
+      end;
+
+
+    function tattreader.BuildConstExpression(allowref,betweenbracket:boolean): longint;
+      var
+        l : longint;
+        hs : string;
+      begin
+        BuildConstSymbolExpression(allowref,betweenbracket,false,l,hs);
+        if hs<>'' then
+         Message(asmr_e_relocatable_symbol_not_allowed);
+        BuildConstExpression:=l;
+      end;
+
+
+    Procedure tattreader.BuildConstantOperand(oper : toperand);
+      var
+        l : longint;
+        tempstr : string;
+      begin
+        BuildConstSymbolExpression(false,false,true,l,tempstr);
+        if tempstr<>'' then
+         begin
+           oper.opr.typ:=OPR_SYMBOL;
+           oper.opr.symofs:=l;
+           oper.opr.symbol:=objectlibrary.newasmsymbol(tempstr);
+         end
+        else
+         begin
+           oper.opr.typ:=OPR_CONSTANT;
+           oper.opr.val:=l;
+         end;
+      end;
+
+end.
+
+{
+  $Log$
+  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/rabase.pas

@@ -0,0 +1,115 @@
+{
+    $Id$
+    Copyright (c) 1998-2003 by Peter Vreman, Florian Klaempfl and Carl Eric Codere
+
+    Basic stuff for assembler readers
+
+    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 rabase;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      cclasses,
+      systems;
+
+    type
+       tbaseasmreader = class
+         constructor create;virtual;
+         { the real return type is taasmoutput, but this would introduce too much unit circles }
+         function Assemble: tlinkedlist;virtual;abstract;
+       end;
+       tcbaseasmreader = class of tbaseasmreader;
+
+       pasmmodeinfo = ^tasmmodeinfo;
+       tasmmodeinfo = packed record
+          id    : tasmmode;
+          idtxt : string[8];
+          casmreader : tcbaseasmreader;
+       end;
+
+    var
+      asmmodeinfos  : array[tasmmode] of pasmmodeinfo;
+
+    function SetAsmReadMode(const s:string;var t:tasmmode):boolean;
+    procedure RegisterAsmMode(const r:tasmmodeinfo);
+
+  implementation
+
+    uses
+      cutils;
+
+
+    procedure RegisterAsmmode(const r:tasmmodeinfo);
+      var
+        t : tasmmode;
+      begin
+        t:=r.id;
+        if assigned(asmmodeinfos[t]) then
+          writeln('Warning: Asmmode is already registered!')
+        else
+          Getmem(asmmodeinfos[t],sizeof(tasmmodeinfo));
+        asmmodeinfos[t]^:=r;
+      end;
+
+
+    function SetAsmReadMode(const s:string;var t:tasmmode):boolean;
+      var
+        hs : string;
+        ht : tasmmode;
+      begin
+        result:=false;
+        { this should be case insensitive !! PM }
+        hs:=upper(s);
+        for ht:=low(tasmmode) to high(tasmmode) do
+         if assigned(asmmodeinfos[ht]) and
+            (asmmodeinfos[ht]^.idtxt=hs) then
+          begin
+            t:=asmmodeinfos[ht]^.id;
+            result:=true;
+          end;
+      end;
+
+
+    constructor tbaseasmreader.create;
+      begin
+        inherited create;
+      end;
+
+var
+  asmmode : tasmmode;
+
+initialization
+  fillchar(asmmode,sizeof(asminfos),0);
+finalization
+  for asmmode:=low(tasmmode) to high(tasmmode) do
+   if assigned(asmmodeinfos[asmmode]) then
+    begin
+      freemem(asmmodeinfos[asmmode],sizeof(tasmmodeinfo));
+      asmmodeinfos[asmmode]:=nil;
+    end;
+end.
+{
+  $Log$
+  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/rasm.pas

@@ -0,0 +1,76 @@
+{
+    $Id$
+    Copyright (c) 1998-2003 by Peter Vreman, Florian Klaempfl and Carl Eric Codere
+
+    Basic stuff for assembler readers
+
+    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 rasm;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      cclasses,
+      rabase,
+      aasmtai,
+      systems,
+      cpubase,
+      cgbase;
+
+    type
+       tasmreader = class(tbaseasmreader)
+         firsttoken     : boolean;
+         _asmsorted     : boolean;
+         curlist        : TAAsmoutput;
+         c              : char;
+         actasmpattern  : string;
+         actopcode      : tasmop;
+         actasmregister : tregister;
+         actcondition   : tasmcond;
+         iasmops        : tdictionary;
+         constructor create;override;
+         destructor destroy;override;
+       end;
+
+  implementation
+
+    constructor tasmreader.create;
+      begin
+        inherited create;
+        firsttoken:=true;
+      end;
+
+
+    destructor tasmreader.destroy;
+      begin
+        if assigned(iasmops) then
+          iasmops.Free;
+        inherited destroy;
+      end;
+
+
+end.
+{
+  $Log$
+  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/rautils.pas

@@ -35,8 +35,6 @@ Const
   RPNMax = 10;             { I think you only need 4, but just to be safe }
   OpMax  = 25;
 
-
-
 {---------------------------------------------------------------------
                        Local Label Management
 ---------------------------------------------------------------------}
@@ -68,7 +66,7 @@ Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean;
 
 type
   TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_LOCAL,
-            OPR_REFERENCE,OPR_REGISTER,OPR_REGLIST);
+            OPR_REFERENCE,OPR_REGISTER,OPR_REGLIST,OPR_COND);
 
   TOprRec = record
     case typ:TOprType of
@@ -80,8 +78,9 @@ type
       OPR_REGISTER  : (reg:tregister);
 {$ifdef m68k}
       OPR_REGLIST   : (reglist:Tsupregset);
-{$else not m68k}
-      OPR_REGLIST   : ();
+{$endif m68k}
+{$ifdef powerpc}
+      OPR_COND      : (cond : tasmcond);
 {$endif m68k}
   end;
 
@@ -90,9 +89,8 @@ type
     hasvar : boolean; { if the operand is loaded with a variable }
     size   : TCGSize;
     opr    : TOprRec;
-    constructor create;
+    constructor create;virtual;
     destructor  destroy;override;
-    Procedure BuildOperand;virtual;
     Procedure SetSize(_size:longint;force:boolean);virtual;
     Procedure SetCorrectSize(opcode:tasmop);virtual;
     Function  SetupResult:boolean;virtual;
@@ -102,6 +100,7 @@ type
     Function  SetupDirectVar(const hs:string): Boolean;
     Procedure InitRef;
   end;
+  TCOperand = class of TOperand;
 
   TInstruction = class
     opcode    : tasmop;
@@ -109,14 +108,16 @@ type
     ops       : byte;
     labeled   : boolean;
     operands  : array[1..max_operands] of toperand;
-    constructor create;
+    constructor create(optype : tcoperand);virtual;
     destructor  destroy;override;
-    Procedure InitOperands;virtual;
-    Procedure BuildOpcode;virtual;
+    Procedure BuildOpcode;virtual;abstract;
     procedure ConcatInstruction(p:TAAsmoutput);virtual;
     Procedure Swapoperands;
   end;
 
+  tstr2opentry = class(Tnamedindexitem)
+    op: TAsmOp;
+  end;
 
   {---------------------------------------------------------------------}
   {                   Expression parser types                           }
@@ -1047,44 +1048,34 @@ Begin
 end;
 
 
-procedure TOperand.BuildOperand;
-begin
-  abstract;
-end;
-
-
 {****************************************************************************
                                  TInstruction
 ****************************************************************************}
 
-constructor TInstruction.create;
-Begin
-  Opcode:=A_NONE;
-  Condition:=C_NONE;
-  Ops:=0;
-  InitOperands;
-  Labeled:=false;
-end;
+constructor TInstruction.create(optype : tcoperand);
+  var
+    i : longint;
+  Begin
+    { these field are set to 0 anyways by the constructor helper (FK)
+    Opcode:=A_NONE;
+    Condition:=C_NONE;
+    Ops:=0;
+    }
+    for i:=1 to max_operands do
+      Operands[i]:=optype.create;
+    Labeled:=false;
+  end;
 
 
 destructor TInstruction.destroy;
 var
   i : longint;
 Begin
-  for i:=1 to 3 do
+  for i:=1 to max_operands do
    Operands[i].free;
 end;
 
 
-procedure TInstruction.InitOperands;
-var
-  i : longint;
-begin
-  for i:=1 to 3 do
-   Operands[i].create;
-end;
-
-
 Procedure TInstruction.Swapoperands;
 Var
   p : toperand;
@@ -1106,16 +1097,38 @@ Begin
 end;
 
 
-procedure TInstruction.ConcatInstruction(p:TAAsmOutput);
-begin
-  abstract;
-end;
-
+  procedure TInstruction.ConcatInstruction(p:TAAsmoutput);
+    var
+      ai   : taicpu;
+      i : longint;
+    begin
+      ai:=taicpu.op_none(opcode);
+      ai.Ops:=Ops;
+      ai.Allocate_oper(Ops);
+      for i:=1 to Ops do
+       begin
+         case operands[i].opr.typ of
+           OPR_CONSTANT :
+             ai.loadconst(i-1,aword(operands[i].opr.val));
+           OPR_REGISTER:
+             ai.loadreg(i-1,operands[i].opr.reg);
+           OPR_SYMBOL:
+             ai.loadsymbol(i-1,operands[i].opr.symbol,operands[i].opr.symofs);
+           OPR_LOCAL :
+             ai.loadlocal(i-1,operands[i].opr.localsym,operands[i].opr.localsymofs,operands[i].opr.localindexreg,
+                          operands[i].opr.localscale,operands[i].opr.localgetoffset);
+           OPR_REFERENCE:
+             ai.loadref(i-1,operands[i].opr.ref);
+         end;
+       end;
+     ai.SetCondition(condition);
 
-procedure TInstruction.BuildOpcode;
-begin
-  abstract;
-end;
+     { Concat the opcode or give an error }
+      if assigned(ai) then
+         p.concat(ai)
+      else
+       Message(asmr_e_invalid_opcode_and_operand);
+    end;
 
 
 {***************************************************************************
@@ -1603,7 +1616,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.76  2003-10-30 19:59:00  peter
+  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
+
+  Revision 1.76  2003/10/30 19:59:00  peter
     * support scalefactor for opr_local
     * support reference with opr_local set, fixes tw2631
 
@@ -1850,5 +1868,4 @@ end.
   Revision 1.26  2002/01/24 18:25:50  peter
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
-
 }

compiler/scandir.pas

@@ -36,7 +36,8 @@ implementation
       globtype,globals,systems,widestr,
       verbose,comphook,
       scanner,switches,
-      fmodule;
+      fmodule,
+      rabase;
 
 
 {*****************************************************************************
@@ -151,8 +152,8 @@ implementation
         if s='DEFAULT' then
          aktasmmode:=initasmmode
         else
-         if not set_asmmode_by_string(s,aktasmmode) then
-          Message1(scan_w_unsupported_asmmode_specifier,s);
+         if not SetAsmReadMode(s,aktasmmode) then
+           Message1(scan_e_illegal_asmmode_specifier,s);
       end;
 
 {$ifdef m68k}
@@ -987,7 +988,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2003-11-07 15:58:32  florian
+  Revision 1.28  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.27  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/sparc/rasm.pas

@@ -1,85 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by The Free Pascal Team
-
-    This unit does the parsing process for the 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 Rasm;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses
-  node;
-
-   {
-     This routine is called to parse the instructions in assembler
-     blocks. It returns a complete list of directive and instructions
-   }
-   function assemble: tnode;
-
-
-Implementation
-
-    uses
-       { common }
-       cutils,cclasses,
-       { global }
-       globtype,globals,verbose,
-       systems,
-       { aasm }
-       cpubase,aasmbase,aasmtai,aasmcpu,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner
-       // ,rautils
-       ;
-
-    function assemble : tnode;
-     begin
-       result:=nil;
-     end;
-
-Begin
-end.
-{
-  $Log$
-  Revision 1.2  2003-09-03 15:55:01  peter
-    * NEWRA branch merged
-
-  Revision 1.1.2.1  2003/09/01 21:02:55  peter
-    * sparc updates for new tregister
-
-  Revision 1.1  2002/08/23 10:08:28  mazen
-  *** empty log message ***
-
-  Revision 1.2  2002/08/11 06:14:41  florian
-    * fixed powerpc compilation problems
-
-  Revision 1.1  2002/08/10 14:52:52  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.
-}

compiler/systems.pas

@@ -282,22 +282,15 @@ interface
           abi : tabi;
        end;
 
-       pasmmodeinfo = ^tasmmodeinfo;
-       tasmmodeinfo = packed record
-          id    : tasmmode;
-          idtxt : string[8];
-       end;
-
     const
        { alias for supported_target field in tasminfo }
        system_any = system_none;
 
     var
        targetinfos   : array[tsystem] of psysteminfo;
-       asminfos      : array[tasm] of pasminfo;
        arinfos       : array[tar] of parinfo;
        resinfos      : array[tres] of presinfo;
-       asmmodeinfos  : array[tasmmode] of pasmmodeinfo;
+       asminfos      : array[tasm] of pasminfo;
 
        source_info : tsysteminfo;
        target_cpu  : tsystemcpu;
@@ -314,14 +307,12 @@ interface
 
     function set_target_by_string(const s : string) : boolean;
     function set_target_asm_by_string(const s : string) : boolean;
-    function set_asmmode_by_string(const s:string;var t:tasmmode):boolean;
 
     procedure set_source_info(const ti : tsysteminfo);
 
     procedure UpdateAlignment(var d:talignmentinfo;const s:talignmentinfo);
 
     procedure RegisterTarget(const r:tsysteminfo);
-    procedure RegisterAsmMode(const r:tasmmodeinfo);
     procedure RegisterRes(const r:tresinfo);
     procedure RegisterAr(const r:tarinfo);
     { Register the external linker. This routine is called to setup the
@@ -442,24 +433,6 @@ begin
 end;
 
 
-function set_asmmode_by_string(const s:string;var t:tasmmode):boolean;
-var
-  hs : string;
-  ht : tasmmode;
-begin
-  set_asmmode_by_string:=false;
-  { this should be case insensitive !! PM }
-  hs:=upper(s);
-  for ht:=low(tasmmode) to high(tasmmode) do
-   if assigned(asmmodeinfos[ht]) and
-      (asmmodeinfos[ht]^.idtxt=hs) then
-    begin
-      t:=asmmodeinfos[ht]^.id;
-      set_asmmode_by_string:=true;
-    end;
-end;
-
-
 procedure UpdateAlignment(var d:talignmentinfo;const s:talignmentinfo);
 begin
   with d do
@@ -517,19 +490,6 @@ begin
 end;
 
 
-procedure RegisterAsmmode(const r:tasmmodeinfo);
-var
-  t : tasmmode;
-begin
-  t:=r.id;
-  if assigned(asmmodeinfos[t]) then
-    writeln('Warning: Asmmode is already registered!')
-  else
-    Getmem(asmmodeinfos[t],sizeof(tasmmodeinfo));
-  asmmodeinfos[t]^:=r;
-end;
-
-
 procedure RegisterRes(const r:tresinfo);
 var
   t : tres;
@@ -572,7 +532,6 @@ var
   assem   : tasm;
   target  : tsystem;
   ar      : tar;
-  asmmode : tasmmode;
   res     : tres;
 begin
   for target:=low(tsystem) to high(tsystem) do
@@ -599,12 +558,6 @@ begin
       freemem(resinfos[res],sizeof(tresinfo));
       resinfos[res]:=nil;
     end;
-  for asmmode:=low(tasmmode) to high(tasmmode) do
-   if assigned(asmmodeinfos[asmmode]) then
-    begin
-      freemem(asmmodeinfos[asmmode],sizeof(tasmmodeinfo));
-      asmmodeinfos[asmmode]:=nil;
-    end;
 end;
 
 
@@ -693,7 +646,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.71  2003-10-18 09:04:11  hajny
+  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
+
+  Revision 1.71  2003/10/18 09:04:11  hajny
     * Watcom target name didn't fit in name field length
 
   Revision 1.70  2003/10/03 22:00:33  peter

compiler/x86/aasmcpu.pas

@@ -153,6 +153,7 @@ interface
 
       taicpu = class(taicpu_abstract)
          opsize    : topsize;
+         constructor op_none(op : tasmop);
          constructor op_none(op : tasmop;_size : topsize);
 
          constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister);
@@ -237,7 +238,7 @@ implementation
 
      uses
        cutils,
-       itx86att;
+       itcpugas;
 
 {*****************************************************************************
                               Instruction table
@@ -435,6 +436,13 @@ implementation
       end;
 
 
+    constructor taicpu.op_none(op : tasmop);
+      begin
+         inherited create(op);
+         init(S_NO);
+      end;
+
+
     constructor taicpu.op_none(op : tasmop;_size : topsize);
       begin
          inherited create(op);
@@ -2334,7 +2342,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  2003-10-30 19:59:00  peter
+  Revision 1.38  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.37  2003/10/30 19:59:00  peter
     * support scalefactor for opr_local
     * support reference with opr_local set, fixes tw2631
 

compiler/x86/agx86att.pas

@@ -49,7 +49,7 @@ interface
     uses
       cutils,systems,
       verbose,
-      itx86att,
+      itcpugas,
       cgbase,
       aasmcpu;
 
@@ -293,7 +293,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.10  2003-10-28 18:46:49  peter
+  Revision 1.11  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.10  2003/10/28 18:46:49  peter
     * fix crash with ops=0
 
   Revision 1.9  2003/10/21 15:15:36  peter

compiler/x86/itx86att.pas → compiler/x86/itcpugas.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-unit itx86att;
+unit itcpugas;
 
 {$i fpcdefs.inc}
 
@@ -133,7 +133,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2003-10-01 20:34:51  peter
+  Revision 1.1  2003-11-12 16:05:40  florian
+    * assembler readers OOPed
+    + typed currency constants
+    + typed 128 bit float constants if the CPU supports it
+
+  Revision 1.6  2003/10/01 20:34:51  peter
     * procinfo unit contains tprocinfo
     * cginfo renamed to cgbase
     * moved cgmessage to verbose

compiler/x86/rax86.pas

@@ -50,7 +50,7 @@ type
   T386Instruction=class(TInstruction)
     OpOrder : TOperandOrder;
     opsize  : topsize;
-    constructor Create;
+    constructor Create(optype : tcoperand);override;
     { Operand sizes }
     procedure AddReferenceSizes;
     procedure SetInstructionOpsize;
@@ -61,10 +61,6 @@ type
     procedure ConcatInstruction(p : taasmoutput);override;
   end;
 
-  tstr2opentry = class(Tnamedindexitem)
-    op: TAsmOp;
-  end;
-
 const
   AsmPrefixes = 6;
   AsmPrefix : array[0..AsmPrefixes-1] of TasmOP =(
@@ -89,7 +85,7 @@ implementation
 uses
   globtype,globals,systems,verbose,
   cpuinfo,cgbase,
-  itx86att,cgx86;
+  itcpugas,cgx86;
 
 {$define ATTOP}
 {$define INTELOP}
@@ -233,9 +229,9 @@ end;
                               T386Instruction
 *****************************************************************************}
 
-constructor T386Instruction.Create;
+constructor T386Instruction.Create(optype : tcoperand);
 begin
-  inherited Create;
+  inherited Create(optype);
   Opsize:=S_NO;
 end;
 
@@ -664,7 +660,7 @@ begin
   ai.SetOperandOrder(OpOrder);
   ai.Ops:=Ops;
   ai.Allocate_oper(Ops);
-  for i:=1to Ops do
+  for i:=1 to Ops do
    begin
      case operands[i].opr.typ of
        OPR_CONSTANT :
@@ -736,7 +732,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.13  2003-10-30 19:59:00  peter
+  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
+
+  Revision 1.13  2003/10/30 19:59:00  peter
     * support scalefactor for opr_local
     * support reference with opr_local set, fixes tw2631
 

compiler/x86_64/rasm.pas

@@ -1,76 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2002 by The Free Pascal Team
-
-    This unit does the parsing process for the 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 Rasm;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses
-  node;
-
-   {
-     This routine is called to parse the instructions in assembler
-     blocks. It returns a complete list of directive and instructions
-   }
-   function assemble: tnode;
-
-
-Implementation
-
-    uses
-       { common }
-       cutils,cclasses,
-       { global }
-       globtype,globals,verbose,
-       systems,
-       { aasm }
-       cpubase,aasmbase,aasmtai,aasmcpu,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner,
-       rautils
-       ;
-
-    function assemble : tnode;
-     begin
-     end;
-
-Begin
-end.
-{
-  $Log$
-  Revision 1.2  2002-09-07 15:25:15  peter
-    * old logs removed and tabs fixed
-
-  Revision 1.1  2002/08/10 14:53:38  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.
-
-}